image of READY prompt

Wang2200.org

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

# Sector 354, program filename = 'ACPA080A'
0010 REM ACPA080A, RELEASE 2.1, (06/23/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,
                                     VENDOR MASTER FILE MAINTENANCE MODULE
0040 REM PROGRAM FUNCTION  =  MAINTAIN RECORDS IN THE VENDOR MASTER FILE
0060 REM LAST REVISION     =  06/23/80
0070 REM ---------------------------------------------------------------
0170     DIM I9$1
0197     DIM D9$19,D6$6
0198     GOTO 4000
3996 REM **********************************
3997 REM ! VENDOR MASTER FILE MAINTENANCE !
3998 REM **********************************
3999 REM
4000     SELECT @PARTS0$
4002     PRINT HEX(03);TAB(16);"VENDOR MASTER FILE MAINTENANCE"
4010     B6=21
   : REM LONGEST ALPHA FIELD - LEFT SIDE
4015     C6=8
   : REM LONGEST NUMERIC FIELD - LEFT SIDE
4030     G0=1
4035     C9=5
   : REM NUMBER OF FIELDS ON THE LEFT SIDE
4036     C8=41
   : REM START COLUMN - RIGHT SIDE
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(1)
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
4190     A$=Q6$
4200     PRINT AT(4,0,);TAB(10);"VENDOR ID - ";A$
4210 REM TRANSACTION TYPE (ADD, CHANGE, DELETE)
4220     GOSUB '100("A,C,D","AaCcDdC ",1,1,"ENTER TRANSACTION TYPE (A,C, OR D)
     ",2)
4230     IF Q6$=HEX(1F) THEN GOSUB '31
4240     I9$=Q6$
4250     Q6$="Add   ChangeDelete"
4252     D6$=STR(Q6$,Q9*6-5,6)
4260     PRINT AT(4,0);D6$
4270     IF I9$<>"A" THEN 4450
4280 REM %ADD A NEW VENDOR
4290     GOSUB '232(1,0,A$)
   : REM IS VENDOR ALREADY ON FILE?
4300     IF Q$="N" THEN 4330
4310     PRINT AT(3,0,80);HEX(07);"VENDOR ID is already in the vendor master f
     ile"
4320     GOTO 4140
4330     GOSUB '36
   : REM CLEAR VENDOR FILE VARIABLES
4340     GOSUB '37
   : REM DISPLAY ENTIRE RECORD
4350     GOSUB '32
   : REM DATA ENTRY FOR ENTIRE RECORD
4360     GOSUB '33
   : REM ITEM NO. CORRECTION ROUTINE
4370     GOSUB '233(1,1,A$,0)
   : REM FINDNEW
4380     GOSUB '91
   : REM KFAM RETURN CODE CHECK
4390     IF J0>0 THEN 4140
4400     GOSUB '60(2)
   : REM WRITE VENDOR RECORD
4410     G5$(G0)="New vendor"
4420     GOSUB 4730
   : REM WRITE AUDIT TRAIL
4430     GOTO 4140
   : REM NEXT VENDOR
4440 REM %CHANGE/DELETE VENDOR INFORMATION
4450     GOSUB '232(1,1,A$)
4460     GOSUB '91
4470     IF J0>0 THEN 4140
4480     GOSUB '70(2)
   : REM READ VENDOR RECORD
4490     IF T7$=A$ THEN 4520
4500     PRINT AT(3,0,80);HEX(07);"Record ID in key file does not match the re
     cord ID from the master file"
4510     GOTO 4140
4520     GOSUB '37
   : REM SCREEN DISPLAY
4530     IF I9$ = "D" THEN 4590
4540     GOSUB '33
   : REM ITEM NO. CORRECTION ROUTINE
4550     DBACKSPACE #2,1S
4560     GOSUB '60(2)
   : REM REWRITE VENDOR RECORD
4570     GOTO 4140
4580 REM %DELETE A RECORD
4590     IF A2=0 THEN 4620
4600     PRINT AT(3,0,80);HEX(07);"Vendor cannot be deleted, balance is not ze
     ro"
4610     GOTO 4140
4620     GOSUB '100("Y,N","YyNn",1,1,"DELETE (Y OR N)",2)
4630     IF Q6$<>"Y"THEN 4140
4640     GOSUB '231(1,0,A$)
   : REM DELETE RECORD
4650     GOSUB '91
4660     IF J0>0 THEN 4140
4662     G5$(G0)="Deleted vendor"
4665     GOSUB 4730
   : REM WRITE AUDIT TRAIL
4670     A$=HEX(FF)
4680     GOSUB '60(2)
   : REM REWRITE VENDOR RECORD
4710     GOTO 4140
4720 REM %BUILD & WRITE AUDIT FILE DATA
4730     G2$(G0)=" "
4740     G3$(G0)=A$
   : REM SOMETHING TO IDENTIFY ADDS/DELETES
4750     G0$(G0)="8" & A$
   : REM ALL TRANS TYPES - BUILD RECORD ID
4760     G1$(G0)=I9$
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
6010 REM %INITIALIZE FILE VARIABLES
6020     DEFFN'36
6032     A1$,A2$,A3$,A4$,A5$,B4$,B1$()= " "
6034     A,A1,A2,A3,A0=0
6035     MAT A4 = ZER
6040     RETURN
6050 REM %DISPLAY ENTIRE RECORD
6060     DEFFN'37
6062     PRINT AT(4,0,80);TAB(5);"VENDOR ID. -   ";A$;TAB(30);D6$;TAB(C8+6);"D
     IST ACCT";TAB(C8+22);" % DIST"
6070     PRINT AT(5,0,)
6080     G7=0
6090     I9=11
   : REM NO. OF FIELDS
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 LINE NO. TO CORRECT (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?
6220     IF I=0 THEN 6271
   : REM END OF CORRECTIONS?
6239     Q7$=" "
6240     G7=G7+1
6250     GOSUB '35
6260    GOSUB 4750
   : REM WRITE AUDIT TRAIL
6270     GOTO 6150
6271     S6=0
6272     FOR I=1 TO 6
6273         S6 = S6 + A4(I)
   : REM SUM PERCENTAGES
6274     NEXT I
6275     IF S6=100 OR S6=0 THEN RETURN
   : REM NEXT RECORD IF SUM IS 100
6276     PRINT AT(3,0,80); "The sum of G/L account percentages is not 100.  Re
     -enter."
   : REM IF NOT THEN PRINT ERROR MESSAGE
6278     GOTO 6150
6280 REM VOID OPTION
6290     RETURN  CLEAR
6300     IF I9$="A" OR G7=0 THEN 4140
6310     CONVERT MIN(G7,99) TO Q6$,(##)
6320     G2$(G0)=Q6$&" previous edits for"
6330     G3$(G0)="this vendor are void."
6340     GOSUB 4750
6350     GOTO 4140
6360 REM DATA ENTRY FOR NEW VENDOR
6370     DEFFN'32
6380     G7=1
6390     FOR I= 1 TO I9
6400         Q7$=" "
6410         GOSUB '35
6415     IF I>D9 AND B1$(D9)=" " THEN RETURN
   : REM EASY EXIT FROM ACCT.NO'S.
6420         NEXT I
6430     RETURN
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
6515     IF I>C9 AND D8=0 THEN GOSUB '96(5)
6520     IF Q5<2THEN GOSUB 6650
   : REM AUDIT FILE FORMAT-NUMERICS
6530     G3$(G0)=Q6$
   : REM SAVE NEW VALUE-ALPHA
6545     IF I>C9 THEN 6575
   : REM RIGHT SIDE OF SCREEN?
6550     PRINT AT(I+5,0,C8);
6555     PRINTUSING "##) ";I;
6560     B8=C8-B6-2
6565     IF Q5<2 THEN B8=B8+C6-Q3
   : REM NUMERIC?
6570     PRINT G5$(G0);TAB(B8+2);Q6$
6572     RETURN
6575     PRINT AT(I+5-C9,C8);
6580     PRINTUSING "##) ";I;
6582     IF Q9=0 AND D8=1 AND I9$="A" THEN RETURN
   : REM INITIAL SCREEN BLANK
6584     IF D8=1 AND B1$(D9)=" " THEN Q6$=" "
6585     IF D8=0 THEN PRINT AT(I+5-C9,C8+6,9); STR(Q6$,,9)
   : ELSE PRINT AT(I+5-C9,C8+22,7); STR(Q6$,,7)
   : REM PRINT EITHER ACC. # OR %
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,6810,6820,6830,6840,6850,6850,6850,6850,6850,6850
6760     IF Q$>" "THEN 6730
6770     RETURN
6780 REM %ACCEPT, VALIDATE, AND DISPLAY FILE VARIABLES
6790 REM   MAKE '34 CALLS HERE
6800     GOSUB '34(A1$,0,"VENDOR NAME"," "," ",HEX(7F),21,0,2)
6801     A1$=Q6$
   : RETURN
6810     GOSUB '34(A2$,0,"ADDRESS LINE 1"," "," ",HEX(7F),20,0,2)
6811     A2$=Q6$
   : RETURN
6820     GOSUB '34(A3$,0,"ADDRESS LINE 2"," "," ",HEX(7F),20,0,2)
6821     A3$=Q6$
   : RETURN
6830     GOSUB '34(A4$,0,"CITY/STATE"," "," ",HEX(7F),16,0,2)
6831     A4$=Q6$
   : RETURN
6840     GOSUB '34(A5$,0,"ZIP CODE"," "," ",HEX(7F),5,0,2)
6841     A5$=Q6$
   : RETURN
6849 REM ASK FOR CHART OF ACCT. ID
6850     D9=I-C9
   : REM SUBSCRIPT FOR G/L ACCOUNT ITEMS
6851     D8=0
   : REM SET D8 FOR '34
6853     CONVERT D9 TO STR(D9$,1,1),(#)
   : REM BUILD PROMPT
6854     Q6$="stndrdththth"
6855     STR(D9$,2,2)=STR(Q6$,2*D9-1,2)
6856     STR(D9$,4,16)=" DIST. ACCT. NO."
   : REM COMPLETE PROMPT
6859     GOSUB '34(B1$(D9),0,D9$," "," ",HEX(7F),VAL(Q0$(5)),0,2)
6860     IF G7=0 THEN 6891
   : REM IF DISPLAY ONLY, SKIP VERIFICATION
6861     B1$(D9)=Q6$
6862     IF STR(B1$(D9),,1)<>" " THEN 6873
   : REM TEST FOR BLANK ACCT. NO.
6863     A4(D9)=0
   : REM SET PERCENTAGE TO 0 FOR BLANK ID
6864     PRINT AT(I+5-C9,C8+22,7)
   : REM CLEAR PERCENTAGE DISPLAY
6865     RETURN
6873     GOSUB '232(2,0,B1$(D9))
   : REM FINDOLD FOR THE ACCT. ID
6875     GOSUB '91
   : REM CONVERT KFAM ERROR CODE TO NUMERIC
6877     IF J0<>0 THEN 6881
   : REM ERROR MESSAGE IF KFAM ERROR
6878     GOSUB '75(5)
   : REM GET RECORD FROM CHART OF ACCT. FILE
6880     IF O1$="2" AND O3$<>"M" THEN 6891
   : REM IF VALID ACCT, INPUT %
6881     PRINT AT(3,0,80);HEX(07);"Illegal account no., re-enter"
6882     B1$(D9)=" "
   : REM RESET ID TO BLANK
6884     GOTO 6859
6890 REM ASK FOR DIST. %
6891     D8=1
   : REM SET SWITCH FOR '34
6893     STR(D9$,4,16)=" DISTRIBUTION % "
6894     GOSUB '34(" ",A4(D9),D9$," ","0","100.00",3,2,1)
6895     A4(D9)=Q9
6896     D8=0
6897     RETURN
8999 REM
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   A$ = KEY FIELD
9040 REM   "VENDOR"& A$ = NAME/DESCRIPTION TO IDENTIFY ADDED/DELETED RECORDS
9070 REM    4 = SUBSCRIPT FOR Q0$()
9110 REM    D9 = SUBSCRIPT FOR THE G/L ACCOUNT ITEMS; B4$( ) AND D4( )
9115 REM    D8 = SWITCH FOR G/L ACCOUNT ITEM;      0 FOR ACCOUNT NUMBER
                                                          1 FOR ACCOUNT PERCEN
     TAGE
9120 REM    D9$ = PROMPT FOR G/L ACCOUNT ITEMS
9200 REM $
9992 DEFFN'29"Q$=";HEX(22);"ACPA080A";HEX(22);":SCRATCH  T Q$:SAVE T ()Q$";HEX
     (0D)
9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
     "GBS/MVP - MAINTAIN VENDOR MASTER FILE";HEX(22);":SELECT#15<I0$>:$OPEN#15
     :SELECTLIST<I0$>(80): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX(7A):$
     CLOSE#15:SELECTLIST005(80)";HEX(0D)