Directory of image this file is from
This file as a plain text file
10 START ;ACC08S - DIBOL PROGRAM FOR FIELD SERVICE ACCEPTANCE 20 ;THIS PROGRAM UPDATES A MASTER FILE OF STOCK RECORDS, WITH A 30 ;TRANSACTION FILE OF RECIVALS AND WITHDRAWALS. 40 ;A NEW MASTER FILE AND REPORT ARE PRODUCED. 50 60 70 RECORD MASTI ;MASTER INPUT RECORD 80 MIPART, D9 ;PART NUMBER 90 MICOST, D10 ;UNIT COST 100 MIQTY, D10 ;QUANTITY ON HAND 110 MIRDAT, D6 ;DATE OF LAST RECEIVAL 120 MIWDAT, D6 ;DATE OF LAST WITHDRAWAL 130 BLOCK,X ;REDEFINE THAT RECORD 140 MIWHOL, A41 150 160 RECORD MASTO ;MASTER OUTPUT RECORD 170 MOPART, D9 180 MOCOST, D10 190 MOQTY, D10 200 MORDAT, D6 210 MOWDAT, D6 220 BLOCK,X 230 MOWHOL, A41 240 250 RECORD TRAN ;TRANSACTION RECORD 260 TYPE, A1 ;TYPE (R=RECEIVAL, W=WITHDRAWAL) 270 TPART, D9 ;PART NUMBER 280 TQTY, D7 ;QUANTITY 290 TDATE, D6 ;DATE (MMDDYY) 300 310 RECORD REPLIN ;MAIN REPORT LINE 320 RLFLAG, A3 ;ERROR FLAG 330 , A2 ;FILLER 340 RLPART, A11 ;PART NUMBER (XX XXXXX XX) 350 , A2 360 RLCOST, A14 ;UNIT COST (XX,XXX,XXX.XX-) 370 , A3 380 RLDATE, A8 ;DATE (MM/DD/YY) 390 , A2 400 RLBEGB, A14 ;BEGIN BALANCE (X,XXX,XXX,XXX-) 410 , A1 420 RLTYPE, A1 ;TRANSACTION TYPE 430 , A2 440 RLEXT, A14 ;EXTENDED COST (XX,XXX,XXX.XX-) 450 , A3 460 470 RECORD,X 480 , A49 ;FILLER 490 RLQTY, A10 ;TRANS QTY (X,XXX,XXX-) 500 , A1 510 RSTAR1, A2 ;FOR STARS ON PART TOTALS 520 , A16 530 RSTAR2, A2 540 550 RECORD,X ;USED TO CLEAR THE LINE 560 REPCLR, A80 570 580 BLOCK HDR1 ;FIRST HEADER LINE 590 , A9 600 , A4, 'PART' 610 , A14 620 , A4, 'UNIT' 630 640 BLOCK HDR2 ;SECOND HEADER LINE 650 , A8 660 , A6, 'NUMBER' 670 , A13 680 , A4, 'COST' 690 , A6 700 , A4, 'DATE' 710 , A14 720 , A3, 'QTY' 730 , A13 740 , A5, 'VALUE' 750 760 770 BLOCK ;WORK AREA 780 OLDTP, D9 ;PREVIOUS TRANS PART NUMBER 790 OLDMP, D9 ;PREVIOUS MASTER PART NUMBER 800 GQTY, D10 ;GRAND QTY TOTAL 810 GEXT, D10 ;GRAND VALUE 820 TMPEXT, D10 ;TEMP TO HOLD EXTENSION 830 TRANSW, A1,'Y' 840 LINES, D2 ;NUMBER OF LINES LEFT ON PRINTED PAGE 850 INFILE, A6,'ACC07F' 860 870 BLOCK ;CONSTANT AREA 880 SPC11, A11, ' ' 890 SPC14, A14, ' ' 900 ZER14, A14, ' 0 ' 910 HIVAL, D9, 999999999 920 PEDIT, A11, 'XX XXXXX XX' ;EDIT FORMAT FOR PART NUMBER 930 940 BLOCK ERROR1 ;'TRAN OUT OF ORDER' 950 , A6, '?TRAN ' 960 ERR1P1, A11 970 , A7, ' AFTER ' 980 ERR1P2, A11 990 1000 BLOCK ERROR2 ;'MASTER OUT OF ORDER' 1010 , A8, '?MASTER ' 1020 ERR2P1, A11 1030 , A7, ' AFTER ' 1040 ERR2P2, A11 1050 PROC 3 ;ACC08S 1060 1070 BEGIN, INIT( 1,IN,INFILE,8) 1080 IF (TRANSW .EQ. 'N') GO TO BEGIN1 ;IF WE HAVE TRANSACTIONS, 1090 INIT (2,OUT,'ACC08F',9) 1100 INIT (3,IN,'ACC03F',4) 1110 BEGIN1, INIT (4,LPT) ;INIT PRINTER 1120 INIT (5,TTY) ;INIT TTY FOR ERRORS 1130 1140 OLDTP= ;CLEAR 1150 OLDMP= ; SOME 1160 GQTY= ; SCRATCH 1170 GEXT= ; AREA 1180 LINES= ;PRETEND PAGE IS FULL 1190 1200 CALL GETM ;READ FIRST OLD MASTER 1210 IF (TRANSW .EQ. 'N') GO TO BEGIN2 ;IF THERE ARE TRANS, 1220 CALL GETT ; READ FIRST TRANS 1230 GO TO SETOUT 1240 1250 BEGIN2, TPART = HIVAL ;NO TRANS: SET TO HIVAL 1260 GO TO SETOUT 1270 1280 ;START OF MAIN LOOP 1290 1300 COMPAR, IF (TPART .NE. MOPART) GO TO NOTEQ ;DOES TRANS MATCH MASTER? 1310 1320 IF (TYPE .EQ. 'R') GO TO RECEIV ;YES: IS IT RECEIVAL? 1330 MOQTY=MOQTY-TQTY ;NO: DEDUCT FROM BALANCE 1340 MOWDAT=TDATE ;RESET DATE 1350 GO TO RCV1 1360 1370 RECEIV, MOQTY=MOQTY+TQTY ;RECEIVAL: ADD TO BALANCE 1380 MORDAT=TDATE 1390 1400 RCV1, CALL OUTLIN ;WRITE PREVIOUS PRINT LINE 1410 REPCLR= ;CLEAR PRINT 1420 RLDATE=TDATE,'XX/XX/XX' ;SET 1430 RLQTY =TQTY,'X,XXX,XXX-' ; UP 1440 RLEXT =TQTY*MOCOST,'XX,XXX,XXX.XX-' ; PRINT 1450 RLTYPE=TYPE ; LINE 1460 1470 IF (MOQTY .GE. 0) GO TO RCV2 ;SET ERROR FLAG IF 1480 RLFLAG = '***' ; NEGATIVE BALANCE 1490 1500 RCV2, CALL GETT ;GET NEXT TRANSACTION 1510 GO TO COMPAR ;LOOP 1520 1530 ;TRANSACTION NOT EQUAL TO CURRENT MASTER 1540 1550 NOTEQ, CALL OUTLIN ;WRITE PREVIOUS LINE 1560 IF (RLPART .NE. SPC11) GO TO NOTE0A ;WAS THAT THE ONLY LINE? 1570 REPCLR= ;NO: CLEAR LINE 1580 RLDATE=' END BAL' ;PUT 1590 RLBEGB=MOQTY,'X,XXX,XXX,XXX-' ; OUT 1600 TMPEXT=MOQTY*MOCOST ; ENDING 1610 RLEXT=TMPEXT,'XX,XXX,XXX.XX-' ; BALANCE 1620 GEXT=GEXT+TMPEXT ;ADD TO GROSS VALUE 1630 GQTY=GQTY+MOQTY ; AND GROSS QTY 1640 IF (RLBEGB .NE. SPC14) GO TO NOTEQ0 1650 RLBEGB=ZER14 1660 NOTEQ0, RSTAR1='**' 1670 RSTAR2='**' 1680 XMIT (4,REPLIN) ;PRINT THE LINE 1690 LINES=LINES-1 1700 GO TO NOTEQ1 1710 1720 NOTE0A, GQTY=GQTY+MOQTY 1730 GEXT=MOQTY*MOCOST+GEXT 1740 1750 NOTEQ1, REPCLR= 1760 IF (LINES .LT. 04) GO TO NOTEQ2 ;NEAR BOTTOM OF PAGE? 1770 FORMS (4,1) ;NO: PUT OUT BLANK LINE 1780 LINES=LINES-1 1790 GO TO NOTEQ3 1800 1810 NOTEQ2, LINES= ;PRETEND PAGE IS FULL 1820 NOTEQ3, IF (TRANSW .EQ. 'N') GO TO SETOUT ;IF THERE ARE ANY TRANS, 1830 XMIT (2,MASTO) ; WRITE NEW MASTER 1840 1850 1860 ;CREATE NEW MASTER OUTPUT RECORD 1870 1880 SETOUT, IF (MIPART .GT. TPART) GO TO SET02 ;IS OLD MASTER GREATER? 1890 IF (MIPART .EQ. HIVAL) GO TO ENDIT ;NO: ARE WE DONE? 1900 MOWHOL=MIWHOL ;NO: COPY OLD TO NEW 1910 CALL GETM ;GET NEXT NEW MASTER 1920 1930 SET01, RLPART=MOPART,PEDIT ;SET 1940 RLCOST=MOCOST,'XX,XXX,XXX.XX-' ; UP 1950 RLBEGB=MOQTY,'X,XXX,XXX,XXX-' ; FIRST 1960 RLEXT=MOQTY*MOCOST,'XX,XXX,XXX.XX-' ; PRINT 1970 RLDATE=' BEG BAL' ; LINE 1980 IF (RLBEGB .NE. SPC14) GO TO COMPAR 1990 RLBEGB=ZER14 2000 GO TO COMPAR 2010 2020 ;NO OLD MASTER FOR THIS TRANSACTION: BALANCE IS ZERO 2030 2040 SET02, MOPART=TPART 2050 MOCOST= 2060 MOQTY= 2070 MORDAT= 2080 MIRDAT= 2090 GO TO SET01 2100 2110 2120 ;ALL DONE 2130 2140 ENDIT, FORMS (4,1) ;PUT OUT BLANK LINE 2150 RLDATE='TOTALS ' 2160 RLQTY=GQTY,'X,XXX,XXX,XXX-' 2170 RLEXT=GEXT,'XX,XXX,XXX.XX-' 2180 XMIT (4,REPLIN) 2190 2200 FINI (1) 2210 IF (TRANSW .EQ. 'N') GO TO ENDIT1 2220 FINI (2) 2230 FINI (3) 2240 ENDIT1, FINI (4) 2250 FINI (5) 2260 2270 STOP 2280 2290 ;READ A TRANSACTION RECORD 2300 2310 GETT, XMIT (3,TRAN,GETT9) 2320 IF (TPART .LT. OLDTP) GO TO GETT2 2330 OLDTP=TPART 2340 RETURN 2350 2360 ;ERROR - TRANSACTIONS OUT OF ORDER 2370 2380 GETT2, ERR1P1=TPART,PEDIT 2390 ERR1P2=OLDTP,PEDIT 2400 XMIT (5,ERROR1) 2410 GO TO GETT 2420 2430 ;NO MORE TRANSACTIONS 2440 2450 GETT9, TPART=HIVAL 2460 RETURN 2470 2480 2490 ;READ A MASTER RECORD 2500 2510 GETM, XMIT (1,MASTI,GETM9) 2520 IF (MIPART .LE. OLDMP) GO TO GETM2 2530 OLDMP=MIPART 2540 RETURN 2550 2560 ;ERROR - MASTER FILE OUT OF ORDER OR PART DUPLICATED 2570 2580 GETM2, ERR2P1=MIPART,PEDIT 2590 ERR2P2=OLDMP,PEDIT 2600 XMIT (5,ERROR2) 2610 GO TO GETM 2620 2630 ;NO MORE MASTER RECORDS 2640 2650 GETM9, MIPART=HIVAL 2660 RETURN 2670 2680 2690 ;PUT OUT A PRINT LINE AFTER CHECKING TO SEE IF PAGE IS FULL 2700 2710 OUTLIN, IF (LINES .GT. 00) GO TO OUTL1 ;PAGE FULL? 2720 FORMS (4,0) ;YES: GO TO TOP-OF-FORM 2730 XMIT (4,HDR1) ;PUT OUT 2740 XMIT (4,HDR2) ; HEADER LINES 2750 FORMS (4,1) ; FOLLOWED BY BLANK LINE 2760 LINES=56 ;PAGE IS NOW EMPTY 2770 2780 OUTL1, XMIT (4,REPLIN) ;PUT OUT REPORT LINE 2790 LINES=LINES-1 2800 RETURN 2810 2820 2830 END