Recommended Reading

Sample PL/I code


JCFO1: PROC OPTIONS (MAIN);
//SKIP(3);
DCL IJFF FILE RECORD INPUT;
DCL IDAF FILE RECORD INPUT;
DCL OJFF FILE RECORD OUTPUT;
DCL JCFO1A FILE RECORD OUTPUT ENV(CTLASA);
DCL JCFO1B FILE RECORD OUTPUT ENV(CTLASA);
/* LAYOUT OF PARAMETER RECORD PASSED */
//SKIP;
  DCL 1 JCFO1O1 PARM,
        3 RECTYP     CHAR(1)      INIT(' '),
        3 VIN        CHAR(14),
        3 INVNO      CHAR(8),
        3 DEAL       CHAR(5),
        3 ZONE       CHAR(1),
        3 ADEAL      CHAR(5);
//SKIP;
  DCL 1 CONTROLS,
        3 JFF IN     FIXED DEC(9) INIT(0),
        3 JFF_OUT    FIXED DEC(9) INIT(0),
        3 DEAF IN    FIXED DEC(9) INIT(0),
        3 COD_ALLOC1 FIXED DEC(9) INIT(0),
        3 COD_ALLOC2 FIXED DEC(9) INIT(0),
        3 FD_JFF     FIXED DEC(9) INIT(0),
        3 FD_DEAF    FIXED DEC(9) INIT(0),
        3 FD_ACARD   FIXED DEC(9) INIT(0);
//SKIP;
  DCL 1 HEAD1,
        3 H1ASA      CHAR(1)      INIT(1),
        3 H1TTL1     CHAR(56)     INIT('ITDOCTORS FINANCIAL SERVICES'),
        3 H1TITL2    CHAR(44)     INIT('AUDIT INTERFACE'),
        3 H1TTL3     CHAR(5)      INIT('DATE'),
        3 H1DATE     PIC'Z9/99/99',
        3 H1SP1      CHAR(7)      INIT(' '),
        3 H1TTL4     CHAR(5)      INIT('PAGE'),
        3 H1PAGE     PIC'ZZZ9'    INIT(0),
        3 H1SP2      CHAR(3)      INIT(' ');
//SKIP;
  DCL 1 HEAD2,
        3 H2ASA      CHAR(1)      INIT('0'),
        3 H2TTL1     CHAR(60)     INIT('REPORT JCFO1A'),
        3 H2TPL2     CHAR(72)     INIT('CONTROL REPORT');
//SKIP;
  DCL 1 DET1,
        3 D1ASA      CHAR(1)      INIT('0'),
        3 D1TTL1     CHAR(30),
        3 D1TTL2     CHAR(26),
        3 D1TTL3     CHAR(3)      INIT(':'),
        3 D1TOT      PIC'ZZZZZZZZ9',
        3 D1SP       CHAR(34)     INIT(' ');
//SKIP;
  DCL 1 DET2,
        3 D2ASA      CHAR(31)     INIT(' '),
        3 D2TTL1     CHAR(102)    INIT('FREE DAY OVERRIDES :');
//SKIP;
  DCL 1 DET3,
        3 D3ASA      CHAR(2)      INIT('-'),
        3 D3TTL1     CHAR(9)      INIT('A-CARD :'),
        3 D3ACARD    CHAR(122);
//SKIP;
 DCL 1 TOT1,
       3 T1ASA      CHAR(90)     INIT(' '),
       3 T1TOT      PIC'Z(8)9',
       3 T1SP       CHAR(34)     INIT(' ');
//SKIP;
 DCL 1 DASH,
       3 DAASA      CHAR(90)     INIT(' '),
       3 DATTL      CHAR(9)      INIT('---------'),
       3 DASP       CHAR(34)     INIT(' ');
//SKIP;
//DCL END_LINE      CHAR(133)    INIT('-END OF REPORT JCFO1A');
//SKIP;
//DCL BLANK         CHAR(133)    INIT(' ');
//PAGE;
   DCL 1 DEAFREC,
   //INCLUDE FWDEAF1;
//PAGE;
   DCL 1 IJFFREC,
   //INCLUDE FWJAGFL;
//PAGE;
   DCL 1 OJFFREC,
   //INCLUDE FWJAGFL;
   DCL OJFF_FREE_DAY PIC'9999' DEF OJFFREC.FREE DAY;
   DCL OJFFNOFDAYS   PIC'9999' DEF OJFFREC.DAYS_DESP;
//PAGE;
/*********************************************************************/*
/* MISC DECLARATIONS, COUNTS ETC:
/*********************************************************************/*
//SKIP;
DCL (DATE,ADDR,PLIDUMP,TRANSLATE,ABS,STRING,HIGH) BUILTIN;
DCL JCFO1O1 ENTRY(PTR);
DCL JCFO1O2 ENTRY(PTR);
//SKIP(2);
DCL STORE DEALER CHAR(5);
DCL (EOF7FF,EOFDAF)               BIT(1) INIT('O'B);
DCL (MORE_JFF_RECS,MORE_DAY_RECS) BIT(1) INIT('1'B);
//SKIP(2);
   //INCLUDE JCFLED;
   //INCLUDE ABSDATE;
   ON ERROR SNAP
      BEGIN;
         ON ERROR SNAP;
         DISPLAY('JCFO1: AEOJ');
         CALL PLIDUMP('SHFTB');
      END;

   ON ENDFILE(IJFF)
      BEGIN;
         IJFFREC.DEALER = HIGH(5);
         EOF_JFF = '1'B;
         MORE_JFF_RECS = '0'B;
      END;

   ON ENDFILE(IDAF)
      BEGIN;
         DEAFREC.DEALER = HIGH(5);
         EOFDAF = '1'B;
         MORE_DAF_RECS = '0'B;
      END;
/*********************************************************************/
/* END OF JCFO1 DECLARATIONS                                         */
/*********************************************************************/
/*( JCFO1 - */
 OPEN FILE(IJFF),
      FILE(IDAF),
      FILE (OJFF),
      FILE(JCFO1A);
 READ FILE(IJFF)  INTO(IJFFREC);
 READ FILE (IDAF) INTO(DEAFREC);
/*( MATCH BODY - */
P1005:
IF EOF JFF AND EOFDAF THEN GOTO P2005;
/*( DEALER - */
STORE DEALER = IJFFREC.DEALER;
/*( DEALER BODY - */
SELECT;
   WHEN (IJFFREC.DEALER = DEAFREC.DEALER)
      DO;
         /*( MATCHED -  */
         /*( MODEL BODY - */
         P1010:
         IF IJFFREC.DEALER = STORE_DEALER OR EOF_JFF THEN
            GOTO P2010;
         JFF_IN = JFF_IN + 1;
         OJFFREC = '';
         OJFFREC = IJFFREC, BY NAME;
         IF IJFFREC.FREE_DAY = '    ' THEN
            DO;
               IF DEAFREC.FREE_DAY = '    ' THEN
                  DO;
                     OJFF_FREE_DAY = PCARD.PDELDAYS;
                     FD_ACARD = FD_ACARD + 1;
                  END;
               ELSE
                  DO;
                     IJFFREC.FREE_DAY = DEAFREC.FREE_DAY;
                     FD_DEAF = FD_DEAF + 1;
                  END;
            END;
         /*( ZONE BODY - */
         IF VERIFY(DEAFREC.ZONE,'123456789ABCD') NE 0 THEN
            /*( ZONE (DAF) NOT VALID - */
            OJFFREC.ZONE = '0';
            /* - ZONE (DAF) NOT VALID ) */
         ELSE
            /*( ZONE (DAF) VALID - */
            OJFFREC.ZONE = DEAFREC.ZONE;
            /* - ZONE (DAY) VALID ) */
         /* - ZONE BODY ) */
         OJFF_NOFDAYS = ABS(ABSDATY(PWEEKSRT) -
         ABSDATY(IJFFREC.DESPATCH));
         /*( ACCOUNT FLAG BODY - */
         IF PSYSFLAG GT DEAFREC.TAKE_ON_FLAG THEN
            /*( OSF (A-CARD) GT TOF - */
            OJFFREC.LIVE_IND = '1';
            /*- OSF (A-CARD) GT TOF ) */
         ELSE
            /*( OSF LE TOF - */
            OJFFREC.LIVE_IND = '0';
            /* - OSF LE TOF ) */
            /* - ACCOUNT FLAG BODY ) */
            WRITE FILE(OJFF) FROM(OJFFREC);
            JFFOUT =JFFOUT + 1;
            READ FILE(IJFF) INTO(IJFFREC);
            /* - VIN ) */
            GOTO P1010;
            P2010:
            /* - MODEL BODY ) */
            DEAF_IN =DEAF_IN + 1;
            READ FILE(IDAF) INTO(DEAFREC);
         /* - MATCHED ) */
      END;
         /* - DEALER BODY ) */
   WHEN (IJFFREC.DEALER LT DEAFREC.DEALER)
      DO;
      /*( ITD ONLY - */
         P1070:
         IF IJFFREC.DEALER = STORE_DEALER OR EOF_JFF THEN
            GOTO P1005;
         JFF_IN = JFF_IN + 1;
         OJFFREC = '';
         OJFFREC = IJFFREC, BY NAME;
         SELECT(IJFFREC.ZONE);
            WHEN ('0')
               DO;
                  OJFFREC.DEALER = 'K2057';
                  OJFFREC.ZONE = '0';
                  COD_ALLOC1 = COD_ALLOC1 + 1;
               END;
            WHEN ('1')
               DO;
                  OJFFREC.DEALER = 'K2065';
                  OJFFREC.ZONE = '1';
                  COD_ALLOC1 = COD_ALLOC1 + 1;
               END;
            WHEN ('2')
               DO;
                  OJFFREC.DEALER = 'K2073';
                  OJFFREC.ZONE = '2';
                  COD_ALLOC1 = COD ALLOC1 + 1;
               END;
            WHEN ('3')
               DO;
                  OJFFREC.DEALER = 'K2081';
                  OJFFREC.ZONE = '3';
                  COD_ALLOC1 = COD ALLOC1 + 1;
               END;
            WHEN ('4')
               DO;
                  OJFFREC.DEALER = 'K2090';
                  OJFFREC.ZONE = '4';
                  COD_ALLOC1= COD_ALLOC1 + 1;
               END;
            WHEN ('5')
               DO;
                  OJFFREC.DEALER = 'K2101';
                  OJFFREC.ZONE = '5';
                  COD_ALLOC1 = COD_ALLOC1 + 1;
               END;
            WHEN ('6')
               DO;
                  OJFFREC.DEALER = 'K2111';
                  OJFFREC.ZONE = '6';
                  COD_ALLOC1 = COD_ALLOC1 + 1;
               END;
            WHEN ('7')
               DO;
                  OJFFREC.DEALER = 'K2128';
                  OJFFREC.ZONE = '7';
                  COD_ALLOC1 = COD_ALLOC1 + 1;
               END;
            WHEN ('8')
               DO;
                  OJFFREC.DEALER = 'K2136';
                  OJFFREC.ZONE = '8';
                  COD_ALLOC1 = COD_ALLOC1 + 1
               END;
            WHEN ('9')
               DO;
                  OJFFREC.DEALER = 'K2144';
                  OJFFREC.ZONE = '9';
                  COD_ALLOC1 = COD_ALLOC1 + 1
               END;
            WHEN('A','B','C','D')
               DO;
                  OJFFREC.DEALER = 'K2057';
                  OJFFREC.ZONE = '0';
                  COD_ALLOC2 = COD_ALLOC2 + 1
               END;
            OTHERWISE
               DO;
                  OJFFREC.DEALER = 'K2057';
                  OJFFREC.ZONE = '0';
                  COD_ALLOC1 = COD_ALLOC1 + 1;
               END;
            END;
            IF IJFFREC.FREE_DAY = '    ' THEN
               DO;
                  OJFF_FREE_DAY = PCARD.PDELDAYS;
                  FD_ACARD = FD_ACARD + 1;
               END;
            OJFF_NOFDAYS = ABS(ABSDATY(PWEEKSRT) -
            ABSDSTY(IJFFREC.DESPATCH));
            OJFFREC.LIVE_IND = '0';
            /*( REPORT BODY - */
            IF IJFFREC.ZONE LT 'A' OR IJFFREC.ZONE GT 'D' THEN
               DO;
                  /*( zONE NOT A-D - */
                  JCFO1O1_PARM.VIN   = IJFFREC.VIN;
                  JCFO1O1_PARM.INVNO = IJFFREC.INV_NO;
                  JCFO1O1_PARM.DEAL  = IJFFREC.DEALER;
                  JCFO1O1_PARM.ZONE  = IJFFREC.ZONE;
                  JCFO1O1_PARM.ADEAL = OJFFREC.DEALER;
                  CALL JCFO1O1(ADDR(JCFO1O1_PARN));
                  /* - ZONE NOT A-D ) */
               END;
            /* REPORT BODY - */
            WRITE FILE(OJFF) FROM(OJFFREC);
            JFFOUT = JFFOUT + 1;
            READ FILE(IJFF) INTO(IJFFREC);
            /* - VIN ) */
            GOTO P1070;
            /* - ITD ONLY ) */
         END;
      /* DEALER BODY - */
      OTHERWISE /* IJFFREC.DEALER GT DEAFREC.DEALER */
         DO;
            /*( DAY ONLY - */
            OJFFREC= '';
            OJFFREC.ZONE = DEAFREC.ZONE;
            OJFFREC.DEALER = DEAFREC.DEALER;
            OJFFREC.VIN = '99999999999999';
            /*( ACCOUNT FLAG BODY - */
            SELECT;
               WHEN (PSYSFLAG GT DEAFREC.TAKE_ON_FLAG)
                  DO;
                     /*( OSF (A-CARD) GT TOF - */
                     OJFFREC.LIVE IND = '1';
                     /* - OSF (A-CARD) GT TOF ) */
                  END;
               /* ACCOUNT FLAG BODY - */
               OTHERWISE
                  DO;
                     /*( OSF LE TOF - */
                     OJFFREC.LIVE IND = '0';
                     /* - OSF LE TOF ) */
                  END;
               /* - ACCOUNT FLAG BODY ) */
            END;
            OJFFREC.AGREED_TD   = DEAFREC.AGREED_TD;
            OJFFREC.CREDIT_LIM  = DEAFREC.CREDIT_LIM;
            OJFFREC.TD100_ FLAG = DEAFREC.TD100_FLAG;
            WRITE FILE(OJFF) FROM(OJFFREC);
            JFF_OUT = JFF_OUT + 1;
            DEAF_IN = DEAF_IN + 1;
            READ FILE(IDAF) INTO(DEAFREC);
         /* - DAF ONLY ) */
         END;
      /* - DEALER BODY ) */
END;
/* - DEALER ) */
GOTO P1005;
P2005:
/* - MATCH BODY ) */
/*( CONTROL REPORT - */
/*( HEADING - */
HEAD1.H1DATE = TRANSLATE('123456',DATE, '563412');
HEAD1.H1PAGE = 1;
WRITE FILE(JCFO1A) FROM(HEAD1);
WRITE FILE(JCFO1A) FROM(HEAD2);
WRITE FILE(JCFO1A) FROM(BLANK);
/* - HEADING) */
/*( DETAIL - */
DET1.D1TTL1 = 'NUMBER OF RECORDS INPUT ON ITD';
DET1.D1TTL2 = 'OCTORS FINANCE FILE      ';
DET1.D1TOT  = CONTROLS.JFF_IN;
WRITE FILE(JCFO1A) FROM(DET1);
DET1 . D1TTL1 = 'NUMBER OF RECORDS INPUT ON DEA';
DET1.D1TTL2   = 'LER ACCOUNT FILE       ';
DET1.D1TOT    = CONTROLS.DEAF_IN;
WRITE FILE(JCFO1A) FROM(DET1);
*/ - DETAIL) */
JCFO1O2_PARM.A_CARD = STRING(PCARD);
/*( - CONTROL REPORT ) */
JCFO1O1_PARM.RECTYP = 'E';
CALL JCFO1O1(ADDR(JCFO1O1_PARM));
CLOSE FILE(IJFF),
      FILE(IDAF),
      FILE(OJFF),
      FILE(JCFO1A);
/* - JCFO1 ) */
END;

Back to sample list



© Copyright IT Doctors.co.uk. 2002