1 COM Q$[55] 7 REM EBAP09 7/17/74 10 Q$="$EBAP09" 20 CHAIN "$EBAU11",100 100 REM PROGRAM TO PAY/CANCEL PURCHASE ORDERS 200 DIM E[6],T[2,2],O[40],P[40],Q[40],R[40],S[40] 210 DIM U$[39],V$[39],W$[39],P$[7] 220 DIM T$[72],X$[12],Y$[10],Z$[72] 230 Y$="0123456789" 240 ENTER #J9 250 READ C0,C1,C2,C3,C4,C5,C6,C7,C8,C9 260 DATA 0,1,2,3,4,5,6,7,8,9 300 FILES *,*,* 310 PRINT LIN(C1),"ENTER VENDOR FILE NAME" 320 INPUT X$ 330 ASSIGN X$,C1,Z0,Q$[20,25] 340 IF Z0 <= C2 THEN 370 350 PRINT LIN(C1),"REQUESTED FILE NON-EXISTENT" 360 GOTO 310 370 IF TYP(C1)#C2 THEN 400 380 READ #C1;T$ 390 IF T$="VENDOR" THEN 420 400 PRINT LIN(C1),"INVALID VENDOR FILE" 410 GOTO 310 420 READ #C1;Q1,Q2,Q3,Q4,D9 430 IF D9=C0 THEN 460 440 PRINT LIN(C1),"DIRTY BIT SET IN VENDOR FILE" 450 STOP  460 PRINT LIN(C1),"ENTER PURCHASE ORDER FILE NAME" 470 INPUT X$ 480 ASSIGN X$,C2,Z0,Q$[38,43] 490 IF Z0=C0 THEN 520 500 PRINT LIN(C1),"REQUESTED FILE UNAVAILABLE OR NON-EXISTENT" 510 GOTO 460 520 IF TYP(C2)#C2 THEN 550 530 READ #C2;T$ 540 IF T$="PURCHASE ORDER" THEN 570 550 PRINT LIN(C1),"INVALID PURCHASE ORDER FILE" 560 GOTO 460 570 READ #C2;W1,W2,D9 580 IF D9=C0 THEN 610 590 PRINT LIN(C1),"DIRTY BIT SET IN PURCHASE ORDER FILE" 600 STOP  610 PRINT LIN(C1),"ENTER ENCUMBRANCE FILE NAME" 620 INPUT X$ 630 ASSIGN X$,C3,Z0,Q$[44,49] 640 IF Z0=C0 THEN 670 650 PRINT LIN(C1),"REQUESTED FILE UNAVAILABLE OR NON-EXISTENT" 660 GOTO 610 670 IF TYP(C3)#C2 THEN 700 680 READ #C3;T$ 690 IF T$="ENCUMBRANCE" THEN 720 700 PRINT LIN(C1),"INVALID ENCUMBRANCE FILE" 710 GOTO 610 720 READ #C3;E1,E2,D9 730 IF D9=C0 THEN 1000 740 PRINT LIN(C1),"DIRTY BIT SET IN ENCUMBRANCE FILE" 750 STOP  1000 REM MAIN DRIVER 1010 PRINT LIN(C1),"ENTER NEXT PURCHASE ORDER TO BE PAID" 1020 E[C1]=C0 1030 ENTER 255,Z0,T$ 1040 IF Z0=-256 THEN 1350 1050 Z0=C2 1060 GOSUB 4000 1070 IF E[C1]=C0 THEN 1100 1080 GOSUB 4300 1090 GOTO 1010 1100 GOSUB 2000 1110 IF E[C1]#C0 THEN 1080 1120 IF T0=C2 THEN 1360 1130 GOSUB 3300 1140 IF E[C1]#C0 THEN 1080 1150 GOSUB 3000 1160 IF E[C1]#C0 THEN 1080 1170 GOSUB 3800 1180 IF E[C1]#C0 THEN 1350 1190 PRINT LIN(C1),"CORRECT PURCHASE ORDER?"; 1200 ENTER 255,Z0,T$ 1210 IF Z0=-256 THEN 1350 1220 IF T$[C1,C1]#"Y" THEN 1010 1230 W$[18,18]="9" 1240 IF E1+W3 <= E2 THEN 1270 1250 PRINT LIN(C1),"PROGRAM TERMINATED, ENCUMBRANCE FILE IS FULL" 1260 STOP  1270 GOSUB 2900 1280 GOSUB 3600 1290 GOSUB 3200 1300 GOSUB 2950 1310 PRINT  1320 PRINT USING 1340;W$[C1,C4],W$[C5,11] 1330 GOTO 1010 1340 IMAGE "PURCHASE ORDER",X4A,",",7AX,"PAID" 1350 PRINT LIN(C1),"PROGRAM TERMINATED BECAUSE OF LACK OF RESPONSE" 1360 STOP  2000 REM EDT TRANS 2005 T0=C1 2010 IF T[C1,C1]=C0 THEN 2045 2015 IF T$[T[C1,C1],T[C1,C2]]#"END" THEN 2030 2020 T0=C2 2025 RETURN  2030 Z$=T$[T[C1,C1],T[C1,C2]] 2035 Z0=LEN(Z$) 2040 IF Z0= Q2 THEN 3345 3310 I=INT((Q0+11)/C6) 3315 Z0=(Q0+12)-C6*I 3320 READ #C1,I 3325 FOR I=C1 TO Z0 3330 READ #C1;U$,V$ 3335 NEXT I 3340 IF U$[C1,C1]="0" THEN 3355 3345 E0=C5 3350 GOSUB 3550 3355 RETURN  3500 REM DOL FMT 3502 Z$[C1,13]=" " 3504 FOR I=C1 TO 10 3506 IF X$[I,I]#"0" THEN 3512 3508 NEXT I 3510 RETURN  3512 Z$[11,11]="." 3514 Z$[12,13]=X$[C9,10] 3516 IF I>C8 THEN 3510 3518 I0=C8-I 3520 Z$[10-I0,10]=X$[C8-I0,C8] 3522 IF I>C5 THEN 3510 3524 Z$[C7,C7]="," 3526 I0=C5-I 3528 Z$[C6-I0,C6]=X$[C5-I0,C5] 3530 IF I>C2 THEN 3510 3532 Z$[C3,C3]="," 3534 I0=C2-I 3536 Z$[C2-I0,C2]=X$[C2-I0,C2] 3538 RETURN  3550 REM MARK ERR 3555 E[C1]=E[C1]+C1 3560 E[E[C1]+C1]=E0 3565 RETURN  3600 REM OUT ENCUMBS 3605 I=INT((E1+34)/17) 3610 Z0=E1+34-17*I 3615 READ #C3,I 3620 IF Z0#C0 THEN 3640 3625 IF I=C2 THEN 3655 3630 READ #C3,I-C1 3635 Z0=17 3640 FOR I=C1 TO Z0 3645 READ #C3;Z$ 3650 NEXT I 3655 T$="30" 3660 IF W$[19,19]="0" THEN 3670 3665 T$="40" 3670 FOR S0=C1 TO W3 3675 Z0=C6 3680 Z=O[S0] 3685 GOSUB 5200 3690 T$[C3,C8]=Z$ 3695 Z=P[S0] 3700 GOSUB 5200 3705 T$[C9,14]=Z$ 3710 Z0=C4 3715 Z=Q[S0] 3720 GOSUB 5200 3725 T$[15,18]=Z$ 3730 X1=R[S0] 3735 X2=S[S0] 3740 GOSUB 5500 3745 T$[19,28]=X$ 3750 PRINT #C3;T$ 3755 NEXT S0 3760 E1=E1+W3 3765 READ #C3,C1 3770 RETURN  3800 REM DSPY PO 3802 PRINT  3804 PRINT USING 3872;W$,P$ 3806 PRINT USING 3874;U$[C8],V$,V$[19],V$[33],V$[35] 3808 X$=W$[20,29] 3810 GOSUB 3500 3812 PRINT USING 3870;W$[12,13],W$[14,15],W$[16,17],Z$[C1,13] 3814 S1=C1 3816 S2=W3 3818 IF S2<15 THEN 3822 3820 S2=14 3822 GOSUB 3900 3824 IF W3<15 THEN 3864 3826 PRINT LIN(C1),"DO YOU WISH TO SEE REMAINING CHARGES?"; 3828 ENTER 255,Z0,T$ 3830 PRINT  3832 IF Z0=-256 THEN 3866 3834 IF T$[C1,C1]#"Y" THEN 3864 3836 S1=15 3838 S2=W3 3840 IF S2<31 THEN 3844 3842 S2=30 3844 GOSUB 3900 3846 IF W3<31 THEN 3864 3848 PRINT LIN(C1),"DO YOU WISH TO SEE REMAINING CHARGES?"; 3850 ENTER 255,Z0,T$ 3852 PRINT  3854 IF Z0=-256 THEN 3866 3856 IF T$[C1,C1]#"Y" THEN 3864 3858 S1=31 3860 S2=W3 3862 GOSUB 3900 3864 RETURN  3866 E[C1]=C1 3868 RETURN  3870 IMAGE "PO DATE",X2A,"/",2A,"/",2A2X,"PO AMOUNT",X13A 3872 IMAGE "PURCHASE ORDER",X4A,",",7A/ 3874 IMAGE "VENDOR",2X24A/8X18A/8X14A,X2A,X5A/ 3900 REM DSPY CHGS 3902 PRINT USING 3946 3904 FOR S0=S1 TO S2 3906 Z0=C6 3908 Z=O[S0] 3910 GOSUB 5200 3912 X$[C1,C6]=Z$ 3914 Z=P[S0] 3916 GOSUB 5200 3918 X$[C7,12]=Z$ 3920 Z0=C4 3922 Z=Q[S0] 3924 GOSUB 5200 3926 PRINT USING 3942;S0,X$,X$[C3],X$[C7],Z$ 3928 X1=R[S0] 3930 X2=S[S0] 3932 GOSUB 5500 3934 GOSUB 3500 3936 PRINT USING 3944;Z$[C1,13] 3938 NEXT S0 3940 RETURN  3942 IMAGE #,XDD,2X2A,"-",4A,"-",6A,"-",4A 3944 IMAGE X13A 3946 IMAGE "CHG ACCOUNT CODE AMOUNT" 4000 MAT T=ZER 4010 Z1=C1 4020 Y3=C0 4030 FOR Z2=C1 TO LEN(T$) 4040 IF Y3#C0 THEN 4100 4050 IF T$[Z2,Z2]=" " THEN 4150 4060 IF T$[Z2,Z2]="," THEN 4110 4070 T[Z1,C1]=Z2 4080 Y3=C1 4090 GOTO 4150 4100 IF T$[Z2,Z2]#"," THEN 4150 4110 T[Z1,C2]=Z2-C1 4120 Z1=Z1+C1 4130 IF Z1>Z0 THEN 4180 4140 Y3=C0 4150 NEXT Z2 4160 T[Z1,C2]=Z2-C1 4170 RETURN  4180 IF Z2=LEN(T$) THEN 4170 4190 E0=C1 4200 GOSUB 3550 4210 RETURN  4300 PRINT  4310 FOR Z0=C2 TO E[C1]+C1 4315 GOTO E[Z0] OF 4325,4330,4335,4340,4345 4325 PRINT "TRANSACTION CONTAINS TOO MANY INPUT FIELDS" 4328 GOTO 4475 4330 PRINT "INVALID VENDOR NUMBER" 4333 GOTO 4475 4335 PRINT "INVALID PURCHASE ORDER NUMBER" 4338 GOTO 4475 4340 PRINT "SPECIFIED PURCHASE ORDER DOES NOT EXIST" 4343 GOTO 4475 4345 PRINT "SPECIFIED VENDOR DOES NOT EXIST" 4475 NEXT Z0 4480 RETURN  5000 Z=Z2=C0 5010 FOR Z4=Z0 TO C1 STEP -C1 5020 IF Z$[Z4,Z4]>"4" THEN 5060 5030 FOR Y3=C0 TO C4 5040 IF Z$[Z4,Z4]=Y$[Y3+C1,Y3+C1] THEN 5090 5050 NEXT Y3 5060 FOR Y3=C5 TO C9 5070 IF Z$[Z4,Z4]=Y$[Y3+C1,Y3+C1] THEN 5090 5080 NEXT Y3 5090 Z=Z+Y3*10^Z2 5100 Z2=Z2+C1 5110 NEXT Z4 5120 RETURN  5200 Z2=Z3=Z4=C0 5210 FOR Z1=Z0 TO C1 STEP -C1 5220 Z3=Z3+C1 5230 Z2=INT(Z/(10^(Z1-C1)))-10*Z4 5240 Z4=(10*Z4)+Z2 5250 Z$[Z3,Z3]=Y$[Z2+C1,Z2+C1] 5260 NEXT Z1 5270 RETURN  5400 Z0=C5 5410 Z$=X$[C1,C5] 5420 GOSUB 5000 5430 X1=Z 5440 Z$=X$[C6,10] 5450 GOSUB 5000 5460 X2=Z 5470 RETURN  5500 Z0=C5 5510 Z=X1 5520 GOSUB 5200 5530 X$[C1,C5]=Z$[C1,C5] 5540 Z=X2 5550 GOSUB 5200 5560 X$[C6,10]=Z$[C1,C5] 5570 RETURN  5800 Z=C1 5810 FOR Z1=C1 TO Z0 5820 IF Z$[Z1,Z1]<"0" THEN 5860 5830 IF Z$[Z1,Z1]>"9" THEN 5860 5840 NEXT Z1 5850 Z=C0 5860 RETURN  6000 END