image of READY prompt

Wang2200.org

Listing of file='ACPA020A' on disk='vmedia/701-2654C.wvd.zip'

# Sector 75, program filename = 'ACPA020A'
0010 REM ACPA020A, RELEASE 2.3, (12/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT
      OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0020 REM ---------------------------------------------------------------
0030 REM SYSTEM & MODULE   =  GBS/MVP ACCOUNTS PAYABLE SYSTEM
                                     OPEN ITEM FILE MAINTENANCE
0040 REM PROGRAM FUNCTION  =  TO ALLOW FOR MAINTENANCE OF A/P OPEN ITEMS
0060 REM LAST REVISION     =  11/21/80 MAF
0065 REM THIS PROGRAM UPGRADED TO 2.3 BY ERRATA 1177
0070 REM ---------------------------------------------------------------
0170      DIM B6(4),B6$(6),D9$15,C6$Q4,C7$Q6
0198      GOTO 4000
3996 REM ******************************
3997 REM ! OPEN ITEM FILE MAINTENANCE !
3998 REM ******************************
3999 REM
4000     SELECT @PARTS0$
4005     PRINT HEX(03);TAB(19);"A/P OPEN ITEM MAINTENANCE"
4010     B6=24
   : REM LONGEST ALPHA FIELD - LEFT SIDE
4015     C6=08
   : REM LONGEST NUMERIC FIELD - LEFT SIDE
4030     G0=1
4035     D8=VAL(Q0$(6))
   : REM LENGTH OF INVOICE NO.
4038     I9=7
   : REM NO. OF FIELDS
4040 REM CHECK AUDIT FILE SPACE
4070     LIMITS T#3,S$(3),Q6,Q7,Q8
4080     Q9=(Q8-2)/(Q7-Q6-1)
4090     IF Q9>.8 THEN PRINT AT(3,0);"Maintenance audit file is more than";INT
     (Q9*100);"% full."
4100     IF Q9<.95 THEN 4140
4110     GOSUB '254
4120     GOSUB '31
4130 REM ENTER VENDOR ID (KEY FIELD)
4140     GOSUB '238(2)
4150     GOSUB '100(" ",HEX(7F),Q0,0,"ENTER VENDOR ID. (OR END)",2)
4160     IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end"THEN GOSUB '31
4170     IF Q6$=" " THEN 4140
4180     GOSUB '96(4)
   : REM CONSTRUCT VENDOR ID
4181     C6$=Q6$
4182     PRINT AT(4,0,);TAB(5);"VENDOR ID - ";C6$
4183     GOSUB '232(2,0,C6$)
   : REM FINDOLD TO VERIFY VENDOR ID
4184     GOSUB '91
   : REM CONVERT KFAM ERROR TO NUMERIC
4185     IF J0=0 OR J0=7 THEN 4203
   : REM BRANCH IF ID IS VALID
4188     PRINT AT(3,0,80);HEX(07);"Illegal vendor ID, re-enter"
4190     GOTO 4140
4201 REM ENTER INVOICE NUMBER
4203     GOSUB '100(" ",HEX(7F),8,0,"ENTER INVOICE NUMBER (OR END)",2)
4204     IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end"THEN GOSUB '31
4205     IF Q6$=" " THEN 4203
4206     GOSUB '96(6)
   : REM CONSTRUCT INVOICE ID
4207     C7$=Q6$
4220 REM BUILD A/P OPEN ITEM KEY
4230     C9$=STR(C6$,,VAL(Q0$(4)))&C7$
4250     GOSUB '232(1,0,C9$)
   : REM DUMMY FINDOLD (NO ID WITH "  ")
4260     GOSUB '237(1,1)
   : REM FINDNEXT
4270     J$(1)=" "
   : REM SUPPRESS END OF FILE ERROR MSG
4280     GOSUB '91
   : REM CONVERT ERROR CODES TO NUMERICS
4290     IF J0=1 THEN T7$=ALL(FF)
   : REM FOR END OF FILE
4300     IF J0=7 THEN 4140
   : REM NEXT ID IF RECORD BUSY
4310     IF J0<2 THEN 4350
   : REM CONTINUE IF J0= 0 OR 1
4320     PRINT AT(1,0,80); "PROGRAM WILL BE TERMINATED"
4330     PRINT AT(3,16,64);Q7$
4340     GOTO 4830
   : REM GO TO PROGRAM END
4350     IF STR(T7$,1,Q0+D8)=STR(C9$,1,Q0+D8) THEN 4480
4360     PRINT AT(3,0,80);HEX(07);"Record not found"
4370     GOTO 4140
4480     GOSUB '71(2,Q)
   : REM READ A/P OPEN ITEM RECORD
4515 REM CHANGE A/P OPEN ITEM RECORD
4517     C7$=C1$(Q)
4520     GOSUB '37
   : REM SCREEN DISPLAY
4540     GOSUB '33
   : REM ITEM NO. CORRECTION ROUTINE
4550     DBACKSPACE #2,1S
4560     GOSUB '61(2,Q)
   : REM REWRITE A/P OPEN ITEM RECORD
4563 REM CHECK FOR OTHER RECORDS WITH SAME INVOICE # AND VENDOR #
4565     GOSUB '238(1)
4567     GOSUB '237(1,1)
   : REM FIND THE NEXT RECORD
4569     J$(1)=" "
   : REM SUPPRESS E0F ERROR MSG
4571     GOSUB '91
4573     IF J0=1 OR J0=7 THEN 4140
   : REM FOR EOF OR BUSY RECORD
4575     IF J0<>0 THEN 4320
   : REM TERMINATE PROGRAM IF OTHER ERRORS
4577     IF STR(T7$,1,Q0)<>STR(C9$,1,Q0) THEN 4140
   : REM IF #'s NOT THE SAME
4579     C9$=T7$
4581     GOSUB '100("Y,N","YyY Nn",1,1,"NEXT INVOICE FOR THIS VENDOR?  (Y OR N
     )",2)
4585     IF Q6$="N" THEN 4140
   : REM FOR NEXT VENDOR ID
4587     GOTO 4480
   : REM GET THE NEXT RECORD
4720 REM %BUILD & WRITE AUDIT FILE DATA
4750     G0$(G0)="@" & C9$
   : REM ALL TRANS TYPES - BUILD RECORD ID
4760     G1$(G0)="C"
4770     G0=G0+1
4780     IF G0<4 THEN RETURN
4790     GOSUB '49(3)
   : REM WRITE TO AUDIT FILE
4800     G0=1
4810     G0$()=ALL(FF)
4820     IF Q9<.95 THEN RETURN
4830     GOSUB '254
4840 REM %END OF PROGRAM
4850     DEFFN'31
4860     IF G0>1 THEN GOSUB '49(3)
   : REM WRITE REMAINING AUDIT RECORDS
4870     LOAD T M$
6000 REM %^SUBROUTINES
6050 REM %DISPLAY ENTIRE RECORD
6060     DEFFN'37
6061     Q9=POS(" CEPX"=C3$(Q))
6062     IF Q9>5 OR Q9<1 THEN Q9=1
6063     Q6$="INVOICE  CR MEMO  E-PAYMENTP-PAYMENTX-PAYMENT"
6064     Q7$=STR(Q6$,Q9*9-8,9)
6065     PRINT AT(4,25);"INVOICE NUMBER - ";C7$
6067     PRINT AT(4,50,30);"***";Q7$;"***"
6070     PRINT AT(5,0,)
6080     G7=0
6100     FOR I=1TO I9
6110        GOSUB '35
   : REM DISPLAY EACH FIELD
6120     NEXT I
6130     RETURN
6140 REM %ITEM NO. SELECT ROUTINE
6150     DEFFN'33
6160     CONVERT I9TO Q7$,(##)
6170     PRINT AT(1,0,80);"ENTER ITEM NO.(0=END, -1=VOID)";
6180     GOSUB '100("-1",Q7$,2,0," ",1)
6190     IF Q6$ = HEX(1F) THEN GOSUB '31
6200     I,J9=Q9
6210     IF I=-1 THEN 6290
   : REM VOID OPTION?
6217     IF I=0 THEN RETURN
   : REM END OF CORRECTIONS?
6220 REM ALLOW ONLY VALID REQUESTS FOR EACH TRANSACTION TYPE
6221     IF C3$(Q)= " " AND I=7 THEN 6271
6222     IF C3$(Q)= "C" THEN ON I GOTO ,6271,6271,6271,,6271,6271
6223     IF C3$(Q)= "E" OR C3$(Q)= "X" OR C3$(Q)= "P" THEN ON I GOTO ,6271,627
     1,,,,6271
6237 REM DATA ENTRY ROUTINE
6239     Q7$=" "
6240     G7=G7+1
6250     GOSUB '35
6260     GOSUB 4750
   : REM WRITE AUDIT TRAIL
6270     GOTO 6150
6271     PRINT AT(3,0,80);"Illegal field selection, re-enter.";HEX(07)
6272     INIT(20)Q$()
   : GOTO 6150
6280 REM VOID OPTION
6290     RETURN  CLEAR
6300     IF G7=0 THEN 4140
6310     CONVERT MIN(G7,99) TO Q6$,(##)
6320     G2$(G0)=Q6$&" previous edits for"
6330     G3$(G0)="this open item are void."
6335     G5$(G0)=" "
6340     GOSUB 4750
6350     GOTO 4140
6440 REM %GENERAL DATA ENTRY SUBROUTINE
6450     DEFFN'34(Q6$,Q9,G5$(G0),Q7$,Q$(1),Q$(2),Q3,Q4,Q5)
6460     IF G7>0THEN PRINT AT(1,0,80);"ENTER ";G5$(G0);Q7$
6470     IF Q5<2 THEN GOSUB 6650
   : REM AUDIT FILE FORMAT-NUMERICS
6480     G2$(G0)=Q6$
   : REM SAVE OLD VALUE-AUDIT FILE
6490     IF Q6$>" " AND Q5=2 THEN Q5=3
   : REM DEFAULT ALPHA IF NON-BLANK
6495     IF Q9<>0 AND Q5=1 THEN Q5=0
   : REM DEFAULT FOR NUMERICS
6500     IF G7>0 THEN GOSUB '100(Q$(1),Q$(2),Q3,Q4," ",Q5)
6510     IF Q6$=HEX(1F) THEN GOSUB '31
6520     IF Q5<2THEN GOSUB 6650
   : REM AUDIT FILE FORMAT-NUMERICS
6530     G3$(G0)=Q6$
   : REM SAVE NEW VALUE-ALPHA
6535     Q8=50
6550     PRINT AT(I+5,0,Q8);
6555     PRINTUSING "##) ";I;
6560     B8=Q8-B6-2
6565     IF Q5<2 THEN B8=B8+C6-Q3
   : REM NUMERIC?
6595     PRINT G5$(G0);TAB(B8);Q6$
   : REM PRINT LABEL, VALUE
6600     RETURN
6640 REM PUT NUMERIC VALUES INTO AUDIT FILE FORMAT
6650     Q6$=ALL("#")
6660     Q7$=STR(Q6$,,Q3)
   : REM PRINTUSING MASK-ALPHA
6670     IF Q4>0THEN Q7$=Q7$&"."&STR(Q6$,,Q4)
   : REM ANY DIGITS AFTER DECIMAL?
6675     Q7$=Q7$&"-"
6680     Q6$=ALL(00)
6690     PRINTUSING TO Q6$,Q7$,Q9
6700     Q6$=STR(Q6$,3,LEN(Q7$))
6710     RETURN
6720 REM BRANCH TO THE APPROPRIATE SUBROUTINE FOR EACH FIELD
6730     DEFFN'35
6740     Q$=" "
6750     ON I GOSUB 6800,6830,6860,6890,6920,6945,6980
6760     IF Q$>" "THEN 6730
6770     RETURN
6800     GOSUB '34(C4$(Q),0,"P. O. NUMBER"," "," ",HEX(7F),D8,0,2)
6802     C4$(Q)=Q6$
6804     RETURN
6830     GOSUB '34(" ",B0(Q),"DISCOUNT %"," ","0","100.00",2,8,1)
6832     B0(Q)=Q9
6834     RETURN
6860     GOSUB '34(" ",B1(Q),"PARTIAL PAYMENT"," ","0","9999999.99",7,2,1)
6862     IF Q9<B(Q) THEN 6870
6864     PRINT AT(3,0,80);HEX(07);"Partial payment amount must be less than gr
     oss amount, re-enter."
6866     GOTO 6860
6870     B1(Q)=Q9
6872     RETURN
6890     GOSUB '34(" ",B2(Q),"CHECK NUMBER"," ","0","99999999",8,0,1)
6892     B2(Q)=Q9
6894     RETURN
6920     Q7$= " MM/DD/YY"
6921     IF C3$(Q)=" " THEN Q7$= Q7$ & " (OR " & HEX(22) & "HOLD" & HEX(2229)

6922     IF B4(Q)=99999 THEN U9$="HOLD"
   : ELSE GOSUB '123(B4(Q))
6925     GOSUB '34(U9$,0,"DUE DATE"," "," ",HEX(7F),8,0,2)
6927     IF Q6$="HOLD" AND C3$(Q)<> " " THEN 6939
6930     IF Q6$="HOLD" THEN U9=99999
   : ELSE GOSUB 6959
6933     B4(Q)=U9
6934     U9=0
6936     RETURN
6939     PRINT AT(3,0,80);"Holds may be placed on invoices only, re-enter"
6942     GOTO 6920
6945     GOSUB '123(B5(Q))
6948     GOSUB '34(U9$,0,"DATE PAID","  MM/DD/YY"," ",HEX(7F),8,0,2)
6951     GOSUB 6959
6954     B5(Q)=U9
6955     U9=0
6957     RETURN
6959     IF G7=0 THEN RETURN
   : REM U9 IS AS IS WAS
6960     GOSUB '121(Q6$)
6961     IF Q6$<>"E" THEN 6965
6962     PRINT AT(3,0,80);"Illegal date, re-enter."
6963     GOTO 6973
6965     IF U9>=B3(Q) THEN RETURN
6970     GOSUB '123(B3(Q))
6971     Q6$="Date must equal or exceed " & U9$ & ", re-enter."
6973     RETURN  CLEAR
6975     IF I=5 THEN 6920
   : ELSE GOTO 6945
6980     GOSUB '34(" ",B(Q),"GROSS AMOUNT"," ","0","99999999.99",8,2,1)
6982     B(Q)=Q9
6983     RETURN
9000 REM %^VARIABLES
9010 REM    B6 = LONGEST ALPHA FIELD, LEFT SIDE OF SCREEN
9012 REM    B7 = LONGEST ALPHA FIELD, RIGHT SIDE OF SCREEN
9014 REM    B8 = SCREEN COLUMN NO.
9016 REM    C6 = LONGEST NUMERIC FIELD, LEFT SIDE (DIGITS LEFT OF DECIMAL)
9018 REM    C7 = LONGEST NUMERIC FIELD, RIGHT SIDE (DIGITS LEFT OF DECIMAL)
9022 REM    G0 = COUNTER FOR AUDIT FILE - RECORDS IN A SECTOR
9024 REM    G7 = 0 MEANS DISPLAY MODE, > 0 GIVES A COUNT OF CHANGES MADE
9028 REM    I9 = NUMBER OF FIELDS
9030 REM   Z0$ = KEY FIELD
9040 REM   Z2$ = NAME/DESCRIPTION TO IDENTIFY ADDED/DELETED RECORDS
9070 REM    Z0 = SUBSCRIPT FOR Q0$()
9100 REM    Z9 = NUMBER OF FIELDS
9101 REM   C9$ = FILE KEY
9102 REM    A6 = RECORD NUMBER WITHIN DATA RECORD
9110 REM $
9998 DEFFN'29"Q$=";HEX(22);"ACPA020A";HEX(22);":SCRATCH TQ$:SAVE T$()Q$";HEX(0
     D)
9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
     "GBS/MVP - A/P OPEN ITEM MAINTENANCE";HEX(22);":SELECT#15<I0$>:$OPEN#15:S
     ELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX(7A):$C
     LOSE#15:SELECTLIST005(80)";HEX(0D)