*$ COMMIT      *CHG
IDENTIFICATION DIVISION.

PROGRAM-ID. PRTAQ021.
*--------------------------------------------------------------*
*               PROGETTO RETTIFICHE                            *
*               -------------------                            *
* AUTORE       : FRANCO D'AMICO  C.O.DI MARSALA                *
*                                                              *
* FUNZIONE     : RISTAMPA SC3                                  *
* PGM CHIAMANTI : PRTMN01                                      *
* PGM CHIAMATI  : PRTST01                                      *
* MAPPE         : MRTAQ011                                     *
* AREA DI INPUT : CRTMN01 -                                    *
*--------------------------------------------------------------*

ENVIRONMENT DIVISION.
SOURCE-COMPUTER. AS400.
OBJECT-COMPUTER. AS400.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VIDEO   ASSIGN  TO WORKSTATION-MRTAQ01
ORGANIZATION     IS TRANSACTION
ACCESS           IS SEQUENTIAL
FILE STATUS      IS F-STATUS.
DATA DIVISION.
FILE SECTION.
FD   VIDEO
LABEL RECORD IS OMITTED.
01   REC-VIDEO.
COPY DDS-ALL-FORMAT OF MRTAQ01.

WORKING-STORAGE SECTION.
EXEC SQL
INCLUDE SQLCA
END-EXEC.
01 AREA-VIDEO.
03 WSC3       PIC 9(8).
03 WSC3N      PIC 9(2).
03 WMSG       PIC X(40).
01 F-STATUS      PIC XX.
01 IND-ON        PIC 1 VALUE B"1".
01 IND-OFF       PIC 1 VALUE B"0".
01 WFINE         PIC 9.
01 WUTIL         PIC S9.
01 WSTAMPA       PIC S9.
01 WWSC3         PIC S9(8).
01 WWSC3N        PIC S9(2).
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAQ01.
****************************************************************
*        AREA DI COLLOQUIO COL PGM CHIAMANTE                   *
****************************************************************
LINKAGE SECTION.
BPINFO* CVR2019 Found explicit reference to library or file DCBCPY;
BPINFO*         manual handling may be required
BPCHCK COPY CRTMN01 OF DCBCPY.
*****************************************************************
*            P R O C E D U R E      D I V I S I O N             *
*****************************************************************
BPEURO PROCEDURE DIVISION USING AREA-MN01.
BPINFO* CVG1011 In field AREA-MN01 found the following classes:
BPINFO* CVG1010 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field CM1-IMPA contains class AMOUNT.
MAIN.
PERFORM APRI THRU EX-APRI.
MOVE LOW-VALUE TO AREA-VIDEO.
MOVE IND-OFF TO IN12 OF MA02-I-INDIC.
IF F-STATUS = "00"
PERFORM SEQUENZA THRU EX-SEQUENZA
UNTIL IN12 OF MA02-I-INDIC = IND-ON
END-IF.

FINE.
CLOSE VIDEO.
GOBACK.


APRI.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAQ01" TO CM1-ERRFILE
MOVE "PRTAQ02" TO CM1-ERRPGM
MOVE 1         TO CM1-RETCOD
BPEURO        CALL "PRTUT02" USING AREA-MN01
BPINFO* CVG1011 In field AREA-MN01 found the following classes:
BPINFO* CVG1010 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field CM1-IMPA contains class AMOUNT.
END-IF.
EX-APRI.
EXIT.

SEQUENZA.
BPDSPF       MOVE AREA-VIDEO TO REC-VIDEO.
BPINFO* CVG1011 In field REC-VIDEO found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
BPDSPF       WRITE REC-VIDEO FORMAT "MA02".
BPINFO* CVG1011 In field REC-VIDEO found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
BPDSPF       READ VIDEO FORMAT "MA02"
INDICATORS ARE AREA-INDIC.
BPINFO* CVG1011 In field VIDEO found the following classes:
BPINFO* CVG1010 Field MA0IMPPA contains class AMOUNT.
IF IN12  OF MA02-I-INDIC = IND-ON
GO TO EX-SEQUENZA
END-IF.
IF MASC3 OF MA02-I IS NOT NUMERIC
OR MASC3 OF MA02-I  IS = 0
MOVE "DIGITA IL N° SC3 DA RISTAMPARE" TO WMSG
GO TO EX-SEQUENZA
END-IF.
IF MASC3N OF MA02-I IS NOT NUMERIC
OR MASC3N OF MA02-I  IS = 0
MOVE "DIGITA IL PROGR.SC3 DA RISTAMPARE" TO WMSG
GO TO EX-SEQUENZA
END-IF.
MOVE LOW-VALUE TO AREA-VIDEO.
MOVE SPACES TO  CM1-MSG.
MOVE MASC3 OF MA02-I  TO  CM1-SC3 WSC3 WWSC3.
MOVE MASC3N OF MA02-I TO  CM1-SC3PR WSC3N WWSC3N.
EXEC SQL
SELECT  RDEUFLUTIL, RDEUSTSC3 INTO :WUTIL,:WSTAMPA
FROM ARTDEU
WHERE RDEUDTSC3 = :WWSC3
AND RDEUPRSC3 = :WWSC3N
AND RDEUNSC3 = 1
END-EXEC.
IF WUTIL IS NOT = 0 AND WSTAMPA = 1
BPEURO         CALL "PRTST01" USING AREA-MN01
BPINFO* CVG1011 In field AREA-MN01 found the following classes:
BPINFO* CVG1010 Field CM1-IMPDA contains class AMOUNT.
BPINFO* CVG1010 Field CM1-IMPA contains class AMOUNT.
END-IF.
IF WSTAMPA = 1 AND WUTIL = 0
MOVE "BCFC VALIDATO - IMPOSSIBILE RISTAMPA"
TO CM1-MSG
END-IF.
IF WSTAMPA = 0 AND WUTIL = 3
MOVE "SC3 ANCORA IN ACQUISIZIONE"
TO CM1-MSG
END-IF.
MOVE CM1-MSG TO WMSG.
MOVE SPACES TO CM1-MSG.
EX-SEQUENZA.
EXIT.

 

Legetøj og BørnetøjTurtle