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