- Dettagli
- Visite: 783
IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAQ001.
*--------------------------------------------------------------*
* PROGETTO RETTIFICHE *
* ------------------- *
* AUTORE : FRANCO D'AMICO C.O.DI MARSALA *
* *
* FUNZIONE : SUBFILE CON SC3 IN ACQUISIZIONE - SCELTA *
* PGM CHIAMANTI : PRTMN01 *
* PGM CHIAMATI : PRTAQ01-PRTUT02 *
* MAPPE : MRTAQ001 *
* AREA DI INPUT : CRTMN01 - *
* ARCHIVI : LRTDEU2 *
*--------------------------------------------------------------*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. AS400.
OBJECT-COMPUTER. AS400.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VIDEO ASSIGN TO WORKSTATION-MRTAQ00
ORGANIZATION IS TRANSACTION
ACCESS IS DYNAMIC
RELATIVE KEY IS CONTSUBF
FILE STATUS IS F-STATUS.
SELECT LRTDEU2 ASSIGN TO DATABASE-LRTDEU2
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
WITH DUPLICATES
FILE STATUS IS F-STATUS.
DATA DIVISION.
FILE SECTION.
FD VIDEO
LABEL RECORD IS OMITTED.
01 REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAQ00.
FD LRTDEU2
LABEL RECORD IS OMITTED.
01 REC-LRTDEU2.
COPY DDS-ALL-FORMAT OF LRTDEU2.
************************************************
WORKING-STORAGE SECTION.
************************************************
EXEC SQL
INCLUDE SQLCA
END-EXEC.
01 SQLERR PIC 9(5).
01 F-STATUS PIC XX.
01 CONTSUBF PIC 9(4).
01 IND-ON PIC 1 VALUE B"1".
01 IND-OFF PIC 1 VALUE B"0".
01 WFINE PIC 9.
01 WCEDOLE PIC S9(4).
01 WIMPORTO PIC S9(13)V9(002).
01 WSUBAREA.
03 WSCELTA PIC X.
03 WSC3M PIC 9(8).
03 WPROG PIC 99.
03 WPAG PIC 9(6).
03 WIMP PIC 9(15).
01 WQUANTI PIC 9(5).
01 WSC3 PIC S9(8).
01 WSC3N PIC S99.
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ00.
****************************************************************
* AREA DI COLLOQUIO COL PGM CHIAMANTE *
****************************************************************
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
*****************************************************************
* P R O C E D U R E D I V I S I O N *
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01.
MAIN.
MOVE 0 TO CONTSUBF WQUANTI.
PERFORM APRI THRU EX-APRI.
MOVE IND-OFF TO IN12 OF MA07CTL-I-INDIC.
MOVE IND-OFF TO IN11 OF MA07CTL-I-INDIC.
IF F-STATUS = "00"
PERFORM RIEMPI-MAPPA THRU EX-RIEMPI-MAPPA
IF WQUANTI > 0
PERFORM SCRIVI-LEGGI THRU EX-SCRIVI-LEGGI
UNTIL IN12 OF MA07CTL-I-INDIC = IND-ON
OR IN11 OF MA07CTL-I-INDIC = IND-ON
END-IF
END-IF.
FINE.
IF WQUANTI = 0
MOVE CM1-DATAG TO CM1-SC3
MOVE 0 TO CM1-SC3PR
MOVE 0 TO CM1-ACONTO
CALL "PRTAQ01" USING AREA-MN01
END-IF.
CLOSE VIDEO LRTDEU2
GOBACK.
APRI.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ00" TO CM1-ERRFILE
MOVE "PRTAQ00" TO CM1-ERRPGM
MOVE 1 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
OPEN INPUT LRTDEU2.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "LRTDEU2" TO CM1-ERRFILE
MOVE "PRTAQ00" TO CM1-ERRPGM
MOVE 2 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
MOVE 0 TO RDEUDTSC3 RDEUPRSC3.
MOVE 1 TO RDEUNSC3.
BPEURO START LRTDEU2 KEY IS > EXTERNALLY-DESCRIBED-KEY
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "10"
AND F-STATUS NOT = "23"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "LRTDEU2" TO CM1-ERRFILE
MOVE "PRTAQ00" TO CM1-ERRPGM
MOVE 3 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
IF F-STATUS = "10" OR F-STATUS = "23"
GO TO EX-APRI
END-IF
BPEURO READ LRTDEU2 NEXT.
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "10"
AND F-STATUS NOT = "23"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "LRTDEU2" TO CM1-ERRFILE
MOVE "PRTAQ00" TO CM1-ERRPGM
MOVE 4 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-APRI.
EXIT.
RIEMPI-MAPPA.
MOVE IND-OFF TO IN12 OF MA07CTL-I-INDIC.
MOVE 0 TO WQUANTI CONTSUBF.
PERFORM UNTIL F-STATUS NOT = "00"
IF RDEUNSC3 = 1 AND RDEUFLUTIL = 3
IF RDEUSTSC3 = 0
MOVE "ACQ. IN CORSO" TO MASIT OF MA07-O
MOVE IND-OFF TO IN90 OF MA07-O-INDIC
END-IF
IF RDEUSTSC3 = 1
MOVE "DA VALIDARE " TO MASIT OF MA07-O
MOVE IND-ON TO IN90 OF MA07-O-INDIC
END-IF
ADD 1 TO CONTSUBF WQUANTI
MOVE RDEUDTSC3 TO MSC3 OF MA07-O WSC3
MOVE RDEUPRSC3 TO MSC3N OF MA07-O WSC3N
EXEC SQL
SELECT MAX(RDEUNSC3) INTO :WCEDOLE
FROM LRTDEU2
WHERE RDEUDTSC3 = :WSC3 AND RDEUPRSC3 = :WSC3N
END-EXEC
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.1 PGM PRTAQ00"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF
EXEC SQL
BPEURO SELECT SUM(AIMPORPAG) INTO :WIMPORTO
FROM LRTDEU2
WHERE RDEUDTSC3 = :WSC3 AND RDEUPRSC3 = :WSC3N
END-EXEC
IF SQLCODE NOT = 0 AND SQLCODE NOT = 100
MOVE SQLCODE TO SQLERR
STRING "ERR.SQL(" SQLERR ")-P.2 PGM PRTAQ00"
DELIMITED BY SIZE INTO CM1-MSG
GO TO FINE
END-IF
MOVE WCEDOLE TO MPAG OF MA07-O
BPDSPF MOVE WIMPORTO TO MAIMP OF MA07-O
BPDSPF WRITE SUBFILE REC-VIDEO FORMAT "MA07"
INDICATORS ARE MA07-O-INDIC
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ00" TO CM1-ERRFILE
MOVE "PRTAQ00" TO CM1-ERRPGM
MOVE 5 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
END-IF
BPEURO READ LRTDEU2 NEXT
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "10"
AND F-STATUS NOT = "23"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "LRTDEU2I" TO CM1-ERRFILE
MOVE "PRTAQ00" TO CM1-ERRPGM
MOVE 6 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF
END-PERFORM.
MOVE 1 TO CONTSUBF.
EX-RIEMPI-MAPPA.
EXIT.
SCRIVI-LEGGI.
BPDSPF WRITE REC-VIDEO FORMAT "MACODA".
MOVE CONTSUBF TO MD011NREC OF MA07CTL-I
BPDSPF WRITE REC-VIDEO FORMAT "MA07CTL".
BPDSPF READ VIDEO FORMAT "MA07CTL"
INDICATORS ARE MA07CTL-I-INDIC.
IF F-STATUS NOT EQUAL "00" AND F-STATUS NOT = "9K"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ00" TO CM1-ERRFILE
MOVE "PRTAQ00" TO CM1-ERRPGM
MOVE 7 TO CM1-RETCOD
BPEURO CALL "PRTUT02" USING AREA-MN01
END-IF.
BPDSPF READ SUBFILE VIDEO MODIFIED INTO WSUBAREA FORMAT "MA07"
AT END
MOVE 0 TO WFINE
NOT AT END
MOVE 1 TO WFINE.
IF WFINE = 1
MOVE SPACES TO MSCEL OF MA07-O
BPDSPF REWRITE SUBFILE REC-VIDEO FORMAT IS "MA07"
MOVE MSC3 OF MA07-O TO CM1-SC3
MOVE MSC3N OF MA07-O TO CM1-SC3PR
MOVE MPAG OF MA07-O TO CM1-ACONTO
BPEURO CALL "PRTAQ01" USING AREA-MN01
MOVE IND-ON TO IN12 OF MA07CTL-I-INDIC
END-IF.
IF IN11 OF MA07CTL-I-INDIC = IND-ON
MOVE 0 TO WQUANTI
END-IF.
MOVE IND-ON TO IN12 OF MA07CTL-I-INDIC.
EX-SCRIVI-LEGGI.
EXIT.
