Listing of file='SAC110AA' on disk='vmedia/701-2003.wvd.zip'
# Sector 325, program filename = 'SAC110AA' 0010 REM PROGRAM NAME = SAC110AA, VERSION = 01 0020 REM SYSTEM NAME = BAS1A 0030 REM PROGRAM FUNCTION = POSTING 0040 REM MODULE NAME = CUSTOMER SALES ANALYSIS CONTROL REPORT 0050 REM THIS PROGRAM IS PART OF A GENERALIZED APPLICATION 0060 REM SYSTEM COPYWRIGHT, WANG LABS, INC. 1973 0070 REM DATE WRITTEN = 10/73 0080 REM REVISION DATE = 5/74 0090 REM REVISION DATE = MM/YY 0100 REM CURRENT WANG LIBRARY # = 0110 REM THIS PROGRAM OUTPUTS A CUSTOMER SALES ANALYSIS CONTROL REPORT. 0120 REM A. FILES USED = 0130 REM B. FUNCTIONS PERFORMED = 0140 DIM R1$2,C1$5,N1$21,D9$1,D9$(3)6,D9(3),A1$(4)2,C1$(4)5,P$(4)12,Q(4),G(4), D(4) 0150 DIM R$2,C$5,N$18,T(12),L(12),R2$2,T2(12),K1$(3)2,D3$8,M1$2,T1$2 0160 REM FN KEY 00 IS THE POSTING PROGRAM INITIATOR 0170 REM 0180 K1$(1)="CR" 0190 GOTO 1860 0200 REM THIS SUBROUTINE GETS AND TESTS RECDS. FROM CUST. S.A. M/F 0210 REM BEGINS ON PAGE 3 BLOCK G1 OF PROGRAM FLOWCHART 0220 REM 0230 DEFFN'100 0240 REM GOSUB'110 IS ACTUAL GET SUBROUTINE 0250 GOSUB '110 0260 REM CHECK IS MADE TO SEE IF LAST CUST. I.D. IS REACHED 0270 IF C$="ZZZZZ" THEN 310 0280 GOTO 340 0290 REM M1$="ON" SETS A FLAG DENOTING END OF CUST. S.A. M/F 0300 REM 0310 M1$="ON" 0320 REM K IS SET UP AS A RECORDS READ COUNTER 0330 REM 0340 K=K+1 0350 REM T1 SUMS ALL PREVIOUS YTD TOTALS 0360 FOR U=1TO V3 0370 T1=T1+T(U) 0380 NEXT U 0390 RETURN 0400 REM THIS SUBROUTINE ACTUALLY OPENS + GETS RCDS. FROM CUST. S.A. M/F 0410 REM BEGINS ON PAGE 4 BLOCK C1 OF PROGRAM FLOWCHART 0420 REM 0430 DEFFN'110 0440 REM B IS BLOCK COUNTER 0450 IF B<>0 THEN 510 0460 REM GOSUB'250 - UTILITY ROUTINE - OPENS INPUT FILE 0470 GOSUB '250(2,"SAC1F010",1) 0480 B=1 0490 REM DATA IS LOADED FROM DATA FILE 0500 REM 0510 DATA LOAD DC #2,R$,C$,N$,S,T(),L() 0520 REM CHECK FOR A3 OR B3 TYPE RECORD 0530 IF STR(R$,2,1)="3" THEN 590 0540 REM BLOCK COUNTER IS NOW STEPPED 0550 B=B+1 0560 RETURN 0570 REM GOSUB'251 - UTILITY ROUTINE - CLOSES INPUT FILE 0580 REM 0590 GOSUB '251(2) 0600 REM CHECK FOR EOF(F) OR EOR(R) 0610 IF Q5$="F" THEN 660 0620 GOTO 480 0630 REM END OF FILE (EOF) DETECTED 0640 REM GOSUB'248 - UTILITY ROUTINE - POSITIONS CURSOR 0650 REM 0660 GOSUB '248(3,0,1) 0670 PRINT "FILE SAC1F010 IS MISSING NORMAL ENDING FORMAT, " 0680 PRINT "RECREATE FILE PROPERLY." 0690 END 0700 REM THIS SUBROUTINE OPENS AND GETS RCDS. FROM INVC. TRANS. FILE 0710 REM BEGINS ON PAGE 4 BLOCK C1 OF PROGRAM FLOWCHART 0720 REM 0730 DEFFN'120 0740 REM B1 IS BLOCK COUNTER 0750 IF B1<>0 THEN 810 0760 REM GOSUB'250 - UTILITY ROUTINE - OPENS INPUT FILE 0770 GOSUB '250(1,"IVC1F020",1) 0780 REM DATA IS NOW LOADED FROM FILE 0800 B1=1 0810 S2=0 0820 REM 0830 DATA LOAD DC #1,A1$(),C1$(),N2,N2,N2,N2,P$(),Q(),G(),D() 0840 REM CHECK FOR A3 OR B3 TYPE RECORD 0850 IF STR(A1$(1),2,1)="3" THEN 1090 0860 REM SEARCH IS NOW CONDUCTED FOR A2 OR B2 RECORD 0870 FOR P1=1TO 4 0880 IF A1$(P1)="A1" THEN 930 0890 IF A1$(P1)="B1" THEN 930 0900 IF A1$(P1)="A2" THEN 990 0910 IF A1$(P1)="B2" THEN 990 0920 REM 0930 S2=S2+G(P1)-D(P1) 0940 NEXT P1 0950 REM B1 BLOCK COUNT IS NOW STEPPED 0960 B1=B1+1 0970 GOTO 830 0980 REM 0990 P1=4 1000 NEXT P1 1010 DATA LOAD DC #1,R1$,C1$,S1,N,N1$,D9$,T,D,E9,D9$(),D9(),E8,E7,D3$,U1 1020 REM STEP B1 BLOCK COUNT BY 2 1030 B1=B1+2 1040 A1$(1)=R1$ 1050 IF STR(A1$(1),2,1)="3" THEN 1090 1060 RETURN 1070 REM GOSUB'251 - UTILITY ROUTINE - CLOSES INPUT FILE 1080 REM 1090 GOSUB '251(1) 1100 IF Q5$="F" THEN 1160 1110 B1=1 1120 IF STR(A1$(1),1,1)<"C" THEN 830 1130 GOTO 1010 1140 REM GOSUB'248 - UTILITY ROUTINE - POSITIONS CURSOR 1150 REM 1160 GOSUB '248(3,0,1) 1170 PRINT "FILE IVC1F020 IS MISSING NORMAL ENDING FORMAT, " 1180 PRINT "RECREATE FILE PROPERLY." 1190 END 1200 REM THIS SUBROUTINE EJECTS PAGE AND LINE FEEDS 1210 REM 1220 DEFFN'140 1230 REM CHECK PAGE NUMBER 1240 IF P3=0 THEN 1400 1250 REM CHECK LINE NUMBER 1260 IF L>=60 THEN 1330 1270 REM STEP LINE COUNTER 1280 L=L+1 1290 RETURN 1300 REM PAGE EJECT TO TOP OF NEXT PAGE 1310 REM SELECT PRINTER OUTPUT DEVICE 1320 REM 1330 SELECT PRINT 215(100) 1340 PRINT HEX(0C) 1350 REM CHECK FOR MANUAL PAPER CHANGE 1360 IF P=0 THEN 1470 1370 P=0 1380 REM DESELECT PRINTER AS OUTPUT DEVICE 1390 REM 1400 SELECT PRINT 005(64) 1410 PRINT HEX(03);"MOUNT NEW PAPER IN PRINTER" 1420 REM 1430 GOSUB '254 1440 PRINT HEX(03) 1450 REM STEP PAGE COUNTER 1460 REM 1470 P3=P3+1 1480 L=6 1490 REM SELECT PRINTER OUTPUT DEVICE 1500 SELECT PRINT 215(100) 1510 PRINT HEX(0A0A0A) 1520 PRINT TAB(35);"COMPANY NAME";TAB(68);"DATE";TAB(77);"PAGE" 1530 PRINT TAB(26);"CUSTOMER SALES ANALYSIS POSTING";TAB(66);Q1$;TAB(78);P3 1540 PRINT HEX(0A) 1550 RETURN 1560 REM THIS SUBROUTINE SAVES RCDS. IN NEW CUST. S.A. M/F 1570 REM BEGINS ON PAGE 5 BLOCK B1 OF PROGRAM FLOWCHART 1580 REM 1590 DEFFN'130 1600 REM B2 IS BLOCK COUNTER 1610 IF B2<>0 THEN 1670 1620 B2=1 1630 REM GOSUB'240 - UTILITY ROUTINE - OPENS OUTPUT FILE 1640 GOSUB '240(3,"SAC1F010",14,1) 1650 REM CHECK FOR END OF BLOCK 1660 REM 1670 IF B2=900 THEN 1750 1680 REM DATA IS SAVED ON NEW CUST. S.A. M/F 1690 REM 1700 DATA SAVE DC $ #3,R$,C$,N$,S,T(),L() 1710 REM STEP B2 BLOCK COUNTER 1720 B2=B2+1 1730 RETURN 1740 REM 1750 R2$="A3" 1760 REM DATA FOR A3 RECORD IS SAVED AND REEL IS CLOSED 1770 DATA SAVE DC $ #3,R2$,C$,N$,K,T(),L() 1780 REM GOSUB'241 - UTILITY ROUTINE - CLOSES OUTPUT FILE 1790 GOSUB '241(3,"EOR") 1800 B2=1 1810 GOTO 1700 1820 REM BEGINNING OF MAIN PROGRAM RUN 1830 REM BEGINS ON PAGE 1 BLOCK A1 OF PROGRAM FLOWCHART 1840 REM SELECT CRT AS OUTPUT DEVICE 1850 REM 1860 SELECT PRINT 005(64) 1870 PRINT HEX(03) 1880 REM INITIALIZE COUNTERS AND FLAGS 1890 M1$, T1$ = "OFF" 1900 V3,K,B,B1,B2,E1,F2,F3,P3,L,G,I1,T1,S1=0 1910 REM OPEN INVOICE TRANSACTION FILE AND GET RECORD 1920 REM 1930 GOSUB '120 1940 V3=U1 1950 REM OPEN OLD CUST. S.A. M/F AND GET RECORD 1960 REM 1970 GOSUB '100 1980 IF K=1 THEN 2020 1990 REM GET NEXT TRANSACTION FILE RECORD 2000 REM 2010 GOSUB '120 2020 IF C1$="^^^^^" THEN 2400 2030 REM CHECK IS MADE ON INVOICE SALES TOTAL 2040 SELECT PRINT 215(100) 2050 IF S2=T THEN 2120 2060 T=S2 2070 GOSUB '140 2080 PRINTUSING 2090,N,C1$,D3$ 2090 % INVOICE ###### OF CUSTOMER ##### ON ######## OUT OF BALANCE. 2100 REM CHECK INVOICE AND REPORT MONTH DATES 2110 REM 2120 IF U1=V3 THEN 2220 2130 GOSUB '140 2140 PRINTUSING 2150,N,C1$,D3$,V3 2150 % INVOICE ###### OF CUSTOMER ##### ON ######## POSTED TO MONTH ##. 2160 REM DESELECT PRINTER OUTPUT DEVICE 2170 SELECT PRINT 005(64) 2180 PRINT HEX(03) 2190 REM 2200 REM TEST FOR TYPE C1 OR D1 RECORD 2210 REM 2220 IF R1$="C1" THEN 2260 2230 IF R1$="D1" THEN 2290 2240 REM CALCULATES CURRENT SALES FIGURE FOR CUSTOMER 2250 REM 2260 G=(T-D) 2270 GOTO 2320 2280 REM 2290 G=(-T+D) 2300 REM SUM ALL CURRENT SALES TOGETHER 2310 REM 2320 E1=E1+G 2330 REM CALCULATE THE NUMBER OF INVOICES PROCESSED 2340 I1=I1+1 2350 REM CHECK FOR FINAL RECORD ON INVC. TRANS. FILE 2360 REM 2370 GOTO 2430 2380 REM FLAG IS SET TO DENOTE END OF INVC. TRANS. FILE 2390 REM 2400 T1$="ON" 2410 REM TEST IF PERFORMED TO SEE IF T1$ FLAG IS ON 2420 REM 2430 IF T1$="ON" THEN 2610 2440 REM TEST IS PERFORMED TO SEE IF M1$ FLAG IS ON 2450 IF M1$="ON" THEN 2650 2460 REM TEST FOR TRANS. FILE CUST. I.D. = OLD CUST. S.A. M/F I.D. 2470 IF C1$=C$ THEN 2790 2480 IF C1$<C$ THEN 2650 2490 REM PUT CUSTOMER S.A. RECORD ON NEW CUSTOMER S.A. M/F 2500 REM 2510 GOSUB '130 2520 REM SUM MONTHLY SALES TOTALS FOR FINAL A2 RECORD 2530 FOR X=1TO V3 2540 T2(X)=T2(X)+T(X) 2550 NEXT X 2560 REM GET NEXT CUSTOMER S.A. M/F RECORD 2570 GOSUB '100 2580 GOTO 2430 2590 REM TEST FOR END OF OLD CUSTOMER S.A. M/F 2600 REM 2610 IF M1$="ON" THEN 2830 2620 GOTO 2510 2630 REM F2 IS EQUAL TO THE NOT FOUND SALES TOTAL(WASH ACCT.) 2640 REM 2650 F2=F2+G 2660 T2(1)=T2(1)+G 2670 REM SELECT PRINTER AS OUTPUT DEVICE 2680 SELECT PRINT 215(100) 2690 REM PAGE EJECT SUBROUTINE 2700 GOSUB '140 2710 PRINTUSING 2720,C1$,N,D3$,ABS(G),K1$(SGN(G)+2) 2720 % CUSTOMER ##### OF INVOICE ###### ON ######## FOR ###,###.## ## NOT ON FILE. 2730 REM DESELECT PRINTER AS OUTPUT DEVICE 2740 SELECT PRINT 005(64) 2750 PRINT HEX(03) 2760 GOTO 2010 2770 REM CALCULATE THE CURRENT MONTH'S TOTAL SALES 2780 REM 2790 T(V3)=T(V3)+G 2800 GOTO 2010 2810 REM CALCULATE THE CURRENT MONTH'S TOTAL WASH ACCT. SALES 2820 REM 2830 F3=T(1)+F2 2840 IF F3=0 THEN 3070 2850 REM SELECT PRINTER OUTPUT DEVICE 2860 SELECT PRINT 215(100) 2870 REM PAGE EJECT SUBROUTINE 2880 GOSUB '140 2890 REM CHECK LINE COUNTER POSITION 2900 IF L<=55 THEN 2940 2910 L=60 2920 GOSUB '140 2930 REM 2940 PRINT HEX(0A) 2950 PRINT TAB(7);"PREV. SALES YTD";TAB(25);"+";TAB(30);"SALES THIS RUN";TA B(47);"=";TAB(51);"TOTAL SALES YTD" 2960 PRINT TAB(9);"WASH ACCT.";TAB(32);"WASH ACCT.";TAB(53);"WASH ACCT." 2970 PRINTUSING 2980,ABS(T(1)),K1$(SGN(T(1))+2),ABS(F2),K1$(SGN(F2)+2),ABS( F3),K1$(SGN(F3)+2) 2980 % #,###,###.## ## #,###,###.## ## ##,###,###.## # # 2990 PRINT HEX(0A) 3000 REM RESET LINE COUNTER 3010 L=L+4 3020 REM DESELECT PRINTER OUTPUT DEVICE 3030 SELECT PRINT 005(64) 3040 PRINT HEX(03) 3050 REM WASH ACCT. TOTAL MUST BE SAVED ON CUST. S.A. M/F 3060 REM 3070 T(1)=F3 3080 GOSUB '130 3090 REM A2 CUST. S.A. M/F RECORD IS LOADED 3100 GOSUB '110 3110 REM CHECK MUST BE MADE ON NO. OF INVOICES READ 3120 IF I1=U1 THEN 3240 3130 SELECT PRINT 215(100) 3140 GOSUB '140 3150 Y1=ABS(I1-U1) 3160 PRINTUSING 3170,I1,U1,Y1 3170 % INVC. TRANS. FILE OUT OF BALANCE ### INVOICES READ ### EXPECTED ### DIFFERENCE 3180 REM SELECT CRT AS OUTPUT DEVICE 3190 SELECT PRINT 005(64) 3200 PRINT HEX(03) 3210 REM GET NEXT CUSTOMER RECORD FROM OLD CUST. S.A. M/F 3220 GOSUB '140 3230 REM 3240 SELECT PRINT 215(100) 3250 REM CHECK \9FNO. OF RCDS. READ = NO. EXPECTED 3260 IF K=S THEN 3330 3270 SELECT PRINT 215(100) 3280 GOSUB '140 3290 Y2=ABS(K-S) 3300 PRINTUSING 3310,K,S,Y2 3310 % CUST. SALES ANALYSIS FILE OUT OF BALANCE ### RECORDS READ ### EXPECT ED ### DIFFERENCE 3320 REM 3330 T2=T1+E1 3340 REM CHECK LINE COUNTER POSITION 3350 IF L<=54 THEN 3370 3360 L=60 3370 GOSUB '140 3380 REM 3390 PRINT HEX(0A) 3400 PRINT TAB(7);"PREV. SALES YTD";TAB(25);"+";TAB(30);"SALES THIS RUN";T AB(47);"=";TAB(51);"TOTAL SALES YTD" 3410 PRINT TAB(8);"ALL ACCOUNTS";TAB(31);"ALL ACCOUNTS";TAB(52);"ALL ACCOU NTS" 3420 PRINTUSING 2980,ABS(T1),K1$(SGN(T1)+2),ABS(E1),K1$(SGN(E1)+2),ABS(T2), K1$(SGN(T2)+2) 3430 PRINT HEX(0A) 3440 PRINT "END OF REPORT" 3450 REM UPDATE TOTALS FOR A2 RCD. ON NEW CUST. S.A. M/F 3460 R$="A2" 3470 C$=" " 3480 N$=" " 3490 S=K 3500 FOR U=1TO 12 3510 T(U)=0 3520 T(1)=T(1)+T2(U) 3530 NEXT U 3540 GOSUB '130 3550 REM \96FILE UTILITY 3560 R$="A3" 3570 GOSUB '130 3580 GOSUB '241(3,"EOF") 3610 PRINT HEX(03) 3620 STOP "END OF PROGRAM" 3630 REM $