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