• Stampa

Dettagli

Visite: 862

IDENTIFICATION DIVISION.
PROGRAM-ID. PRTAN011.
*--------------------------------------------------------------*
*               PROGETTO RETTIFICHE                            *
*               -------------------                            *
* AUTORE       : FRANCO D'AMICO  C.O.DI MARSALA                *
*                                                              *
* FUNZIONE     :                          SCELTA OPZIONI       *
* PGM CHIAMANTI : PRTMN01                                      *
* PGM CHIAMATI  :                                              *
* MAPPE         : MRTAN01                                      *
*                                                              *
*                                                              *
*--------------------------------------------------------------*

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA
REQUESTOR IS WORK-STATION.

INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VIDEO ASSIGN  TO WORKSTATION-MRTAN01
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 MRTAN01.

*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
01  IND-ON          PIC 1 VALUE B"1".
01  IND-OFF         PIC 1 VALUE B"0".
01 AREA-INDIC.
COPY DDS-ALL-FORMATS-INDIC OF MRTAN01.
01  F-STATUS        PIC XX.
01  SI-MAPPA        PIC 9.
01  WPERI.
03 WANNO         PIC 9(4).
03 WMESE         PIC 99.
LINKAGE SECTION.
COPY CRTMN01 OF DCBCPY.
*****************************************************************
PROCEDURE DIVISION USING AREA-MN01.
MAIN.
MOVE SPACES TO CM1-MSG
PERFORM APRI THRU EX-APRI.
MOVE IND-OFF TO IN12 OF MANN2-I-INDIC.
MOVE 0 TO MSCEL OF MANN-O SI-MAPPA.
PERFORM OPZ1 THRU EX-OPZ1
UNTIL MSCEL OF MANN-O = 9.
FINE.
CLOSE VIDEO.
GOBACK.


APRI.
OPEN I-O VIDEO.
IF F-STATUS NOT EQUAL "00"
MOVE F-STATUS TO CM1-FSTATUS
MOVE "MRTAN01" TO CM1-ERRFILE
MOVE "PRTAN01" TO CM1-ERRPGM
MOVE 1         TO CM1-RETCOD
CALL "PRTUT02" USING AREA-MN01
END-IF.
EX-APRI. EXIT.


OPZ1.
CLOSE VIDEO
OPEN I-O VIDEO.
MOVE 0 TO MSCEL OF MANN-O.
IF SI-MAPPA = 1
WRITE REC-VIDEO FORMAT "MFONDO"
END-IF.
WRITE REC-VIDEO FORMAT "MANN"
READ VIDEO FORMAT "MANN"
IF MSCEL OF MANN-O  = 1
PERFORM OPZ  THRU EX-OPZ
GO TO EX-OPZ1
END-IF.
IF MSCEL OF MANN-O = 2
MOVE IND-OFF TO IN12 OF MANN2-I-INDIC
PERFORM OPZ2 THRU EX-OPZ2
UNTIL IN12 OF MANN2-I-INDIC = IND-ON
END-IF.
*      IF MSCEL OF MANN-O = 3
*        WRITE REC-VIDEO FORMAT "AVVISO"
*        READ VIDEO FORMAT "AVVISO"
*        MOVE SPACES TO MMSG OF MANN-O
*      END-IF.
EX-OPZ1. EXIT.

OPZ2.
CLOSE VIDEO
OPEN I-O VIDEO.
MOVE CM1-MSG TO MMSG2
MOVE 0 TO MSCEL2 OF MANN2-I.
IF SI-MAPPA = 1
WRITE REC-VIDEO FORMAT "MFONDO"
END-IF.
WRITE REC-VIDEO FORMAT "MANN2"
READ VIDEO FORMAT "MANN2"
INDICATORS ARE MANN2-I-INDIC
IF IN12 OF MANN2-I-INDIC = IND-ON
GO TO EX-OPZ2
END-IF
EVALUATE MSCEL2 OF MANN2-I
WHEN 1
CALL "PRTAN04" USING AREA-MN01
MOVE SPACES TO CM1-MSG
MOVE 1 TO SI-MAPPA
WHEN 2
IF CM1-SRLVL < 5
STRING "LIVELLO AUTORIZZAZIONE INSUFFICIENTE"
" PER OPZ.2" DELIMITED BY SIZE
INTO CM1-MSG
ELSE
CALL "PRTAN08" USING AREA-MN01
MOVE SPACES TO CM1-MSG
END-IF
WHEN 3
CALL "PRTAN07" USING AREA-MN01
WRITE REC-VIDEO FORMAT "MFONDO"
WHEN 4
CALL "PRTAN05" USING AREA-MN01
MOVE SPACES TO CM1-MSG
WRITE REC-VIDEO FORMAT "MFONDO"
WHEN 5
IF CM1-SRLVL < 5
STRING "LIVELLO AUTORIZZAZIONE INSUFFICIENTE"
" PER OPZ.5" DELIMITED BY SIZE
INTO CM1-MSG
ELSE
CALL "PRTAN06" USING AREA-MN01
MOVE SPACES TO CM1-MSG
WRITE REC-VIDEO FORMAT "MFONDO"
END-IF
END-EVALUATE.
EX-OPZ2. EXIT.

OPZ.
MOVE 0 TO CM1-TIPOCAL
CALL "PRTAN02" USING AREA-MN01.
EX-OPZ. EXIT.