home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / friendly / newe.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-25  |  22.8 KB  |  252 lines
  1. 1 'Update 6/22/83
  2. 10 RUN"INFO.003
  3. 168 COLOR 7,0:LOCATE 23,1:PRINT SPC(79);
  4. 169 COLOR 7,0:LOCATE 24,1:PRINT SPC(79);
  5. 170 COLOR 7,0:LOCATE 25,1:PRINT SPC(79);:RETURN
  6. 180 CLS:COLOR 0,7:LOCATE 3,11:PRINT"╔"STRING$(65,205)"╗":FOR I=4 TO 15:LOCATE I,11:PRINT"║"STRING$(65," ")"║":NEXT:LOCATE 15,11:PRINT"╚"STRING$(65,205)"╝";
  7. 190 COLOR 7,0:LOCATE 1,8:PRINT"╔"STRING$(65,205)"╗":FOR I=2 TO 13:LOCATE I,8:PRINT"║":NEXT:LOCATE 2,74:PRINT"║":LOCATE 14,8:PRINT"╚═":LOCATE 2,9:PRINT"LAST CHECK: "SPC(38)"DATE: ";
  8. 210 COLOR 0,7:LOCATE 4,42-LEN(ACTNM$)/2:PRINT ACTNM$:LOCATE 4,13:PRINT"CHECK NO:":LOCATE 4,62:PRINT"DATE:":LOCATE 9,58:PRINT"AMOUNT:":LOCATE 8,13:PRINT"PAY TO THE":LOCATE 9,13:PRINT"ORDER OF:   "
  9. 220 LOCATE 13,13:PRINT"EXPENSE CODE":LOCATE 14,13:PRINT"NO:":LOCATE 13,64:PRINT"ACCOUNT NO:":LOCATE 14,62:PRINT AN$" 19"CYR$
  10. 230 COLOR 7,0:LOCATE 17,1:PRINT"Expense Codes:":FOR I=1 TO 4:LOCATE (17+I),3:PRINT I;". ";EX$(I):LOCATE (17+I),28:PRINT (I+4);". ";EX$(I+4):IF I<2 THEN LOCATE (17+I),55 ELSE LOCATE (17+I),54
  11. 240 PRINT (I+8);". ";EX$(I+8):NEXT:LOCATE 22,1:PRINT STRING$(79,196):LOCATE 1,1:RETURN
  12. 260 COLOR 7,0:CLS:COLOR 0,7:LOCATE 3,16:PRINT"╔"STRING$(46,205)"╗":FOR I=4 TO 12:LOCATE I,16:PRINT"║"SPC(46)"║":NEXT:LOCATE 13,16:PRINT"╚"STRING$(46,205)"╝"
  13. 270 LOCATE 5,33:PRINT"Check Register":LOCATE 7,17:PRINT"DATE:":LOCATE 7,43:PRINT"AMOUNT:":LOCATE 11,18:PRINT"ACCOUNT NAME:":LOCATE 12,18:PRINT ACTNM$:LOCATE 11,50:PRINT"ACCOUNT NO:":LOCATE 12,50:PRINT AN$" 19"CYR$:COLOR 7,0:RETURN
  14. 290 ZQ=" "+ACTNM$+" ":GOSUB 1610:LOCATE 4,15:PRINT"Account ";:COLOR 0,7:PRINT" "AN$" 19"CYR$" ";:COLOR 7,0:PRINT" Balance As Of: "LSTDT$;
  15. 300 LOCATE 7,6:PRINT"Initial Opening Balance       "STRING$(27,249):LOCATE 7,65:PRINT USING MK2$;ACTBAL#:LOCATE 9,11:PRINT"All Cancelled Deposits To Date":LOCATE 9,45:PRINT USING MK1$;CDAMT#:LOCATE 11,11:PRINT"All Cancelled Checks To Date"
  16. 310 LOCATE 11,56:PRINT USING MK1$;CCAMT#:LOCATE 13,11:PRINT"All Bank Charges To Date":LOCATE 13,56:PRINT USING MK1$;BCAMT#
  17. 320 LOCATE 15,6:PRINT"Balance Before Outstanding Transactions  "STRING$(16,249):LOCATE 15,65:PRINT USING MK2$;ACTBAL#+CDAMT#-CCAMT#-BCAMT#:LOCATE 17,11:PRINT"All Outstanding Deposits":LOCATE 17,45:PRINT USING MK1$;ODAMT#
  18. 330 LOCATE 19,11:PRINT"All Outstanding Checks":LOCATE 19,56:PRINT USING MK1$;OCAMT#:LOCATE 21,6:PRINT"Current Account Balance  "STRING$(32,249):LOCATE 21,68:PRINT USING MK1$;ACTBAL#+ODAMT#-OCAMT#-CCAMT#+CDAMT#-BCAMT#
  19. 340 COLOR 0,7:LOCATE 25,27:PRINT" Strike Any Key To Continue ";:COLOR 7,0::GOTO 13000
  20. 360 GOSUB 168:LOCATE 23,24:COLOR 14,0:PRINT"ENTER";:COLOR 7:PRINT" - After Keying Each Data Field";:LOCATE 24,24:COLOR 14:PRINT"TAB";:COLOR 7:PRINT" - To Advance To Next Data Field";
  21. 370 LOCATE 25,24:COLOR 14:PRINT"F10";:COLOR 7:PRINT" - Advance To End Of Entry";:RETURN
  22. 380 GOSUB 168:LOCATE 24,1:COLOR 14,0:PRINT" F1";:COLOR 7:PRINT" - Backup"SPC(19);:COLOR 14:PRINT"F5";:COLOR 7:PRINT" - Delete This Entry"SPC(7);:COLOR 14:PRINT"F9";:COLOR 7:PRINT" - Void Entry";
  23. 390 LOCATE 25,1:COLOR 14,0:PRINT" F2";:COLOR 7:PRINT" - Forward To Next Entry    ";:COLOR 14:PRINT"F6";:COLOR 7:PRINT" - To Enter Another"SPC(8);:COLOR 14:PRINT"F10";:COLOR 7:PRINT" - Finished";:RETURN
  24. 400 LOCATE 23,1:COLOR 7,0:PRINT"Check Will Not Be Saved Unless The ";:COLOR 14:PRINT"NUMBER,DATE,AMOUNT, And PAY TO ";:COLOR 7:PRINT"Are Complete.";:LOCATE 25,20:COLOR 14:PRINT"Do You Wish To Finish This Check? <Y/N>";:COLOR 7:RETURN
  25. 410 COLOR 0,7:LOCATE 7,23:PRINT"          ";:LOCATE ,50:PRINT"           "
  26. 420 LOCATE 7,24:PRINT C$(CR,4):LOCATE 7,50:A#=VAL(C$(CR,3)):PRINT USING MK1$;A#:RETURN
  27. 430 IF PV<0 OR CR<0 THEN PV=0:CR=1
  28. 440 LOCATE 2,20:PRINT SPC(8):LOCATE 2,64:PRINT SPC(9):COLOR 0,7:LOCATE 4,22:PRINT SPC(8):LOCATE 4,67:PRINT SPC(10):LOCATE 9,26:PRINT SPC(27):LOCATE 14,17:PRINT"    "
  29. 450 LOCATE 4,23:PRINT C$(CR,2):LOCATE 4,67:PRINT C$(CR,4):LOCATE 9,65:A#=VAL(C$(CR,3)):PRINT USING MK1$;A#:LOCATE 9,27:PRINT C$(CR,5):LOCATE 14,17:PRINT C$(CR,6):COLOR 7,0
  30. 460 LOCATE 2,65:PRINT C$(PV,4):LOCATE 2,21:PRINT C$(PV,2):COLOR 0,7:RETURN
  31. 500 GOSUB 13000:IF FKEY=10 THEN RETURN ELSE IF Z<"A" OR Z>B$ THEN 500 ELSE B=ASC(Z)-64:RETURN
  32. 550 ZH="":XLIN=X:XPOS=Y:ZR=SPACE$(7):ZA=ZR:LOCATE XLIN,XPOS,1:PRINT USING MK1$;0;
  33. 590 GOSUB 13000:IF Z=CHR$(8) THEN 670 ELSE IF Z=CHR$(13) THEN 700 ELSE IF Z=CHR$(9) OR FKEY=10 THEN 710 ELSE IF LEN(ZH)>6 OR Z<"0" OR Z>"9" THEN 590 ELSE ZH=ZH+Z
  34. 660 RSET ZR=ZH:LOCATE XLIN,XPOS,1:PRINT USING MK1$;VAL(ZR)/100;:GOTO 590
  35. 670 IF LEN(ZH)<1 THEN SPF=1 ELSE LOCATE XLIN,XPOS:PRINT SPC(7);:ZH=LEFT$(ZH,LEN(ZH)-1):GOTO 660
  36. 700 RSET ZA=ZH:ZA=STR$(VAL(ZA)/100):B$=ZA
  37. 710 LOCATE ,,0:RETURN
  38. 720 GOSUB 13100:ERASE C$:DIM C$(CX+1,6):ZQ=" ENTER TRANSACTION ":GOSUB 1770
  39. 730 B$="L":GOSUB 500:IF FKEY=10 THEN 6000 ELSE IF AC$(B,1)="" THEN 720
  40. 740 CYR$=AC$(B,2):FL$=AC$(B,1)+".A"+CYR$:DK$=" "+FL$+" Data Diskette ":GOSUB 1640:GOSUB 2440
  41. 749 CLS:IF 1+ODP+OCK>CX THEN GOSUB 13500:GOTO 6000
  42. 750 ERASE C$:DIM C$(CX+1,6):UPFLAG=0:IF 1+ODP+OCK>CX THEN 6000
  43. 760 ZQ=" ENTER TRANSACTIONS ":GOSUB 1610:LOCATE 7,30:COLOR 4,0:PRINT"Transaction options:";
  44. 770 LOCATE 9,30:COLOR 0,7:PRINT" A ":LOCATE 11,30:PRINT" B ":LOCATE 13,30:PRINT" C ":LOCATE 15,30:PRINT" D ":LOCATE 17,30:PRINT"F10"
  45. 771 LOCATE 9,35:COLOR 2,0:PRINT"Enter Checks":LOCATE 11,35:PRINT"Enter Deposits":LOCATE 13,35:PRINT"Enter Bank Charges":LOCATE 15,35:PRINT"Account Summary":LOCATE 17,35:PRINT"Return To Check Register Menu"
  46. 800 B$="D":GOSUB 500:IF FKEY=10 THEN 6000 ELSE ON B GOTO 830,1050,1230
  47. 820 GOSUB 290:GOTO 760
  48. 830 GOSUB 180
  49. 840 CR=1:PV=0:LT=0:C$(PV,2)=LSCHK$:NWDT$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  50. 850 GOSUB 360:GOSUB 430
  51. 870 X=4:Y=23:FLEN=5:GOSUB 3670:IF FKEY=10 THEN 930 ELSE IF SPF THEN 870 ELSE IF TBF THEN C$(CR,2)="":GOTO 880 ELSE C$(CR,2)=STR$(VAL(B$)):LSCHK$=C$(CR,2)
  52. 871 LOCATE 4,22:PRINT SPC(8):A#=VAL(C$(CR,2)):LOCATE 4,23:PRINT USING MK6$;A#;
  53. 880 X=4:Y=68:GOSUB 3280:IF FKEY=10 THEN 930 ELSE IF SPF THEN 870 ELSE C$(CR,4)=B$:LOCATE 4,67:PRINT SPC(9);:LOCATE 4,68:PRINT C$(CR,4);
  54. 890 X=9:Y=27:FLEN=25:GOSUB 1930:IF FKEY=10 THEN 930 ELSE IF SPF THEN 880 ELSE C$(CR,5)=B$:LOCATE 9,26:PRINT SPC(27);:LOCATE 9,27:PRINT C$(CR,5);
  55. 900 X=9:Y=65:GOSUB 550:IF FKEY=10 THEN 930 ELSE IF SPF THEN 890 ELSE IF LEN(B$)>0 THEN C$(CR,3)=B$:LOCATE 9,66:PRINT SPC(10);:A#=VAL(C$(CR,3)):LOCATE 9,65:PRINT USING MK1$;A#
  56. 910 X=14:Y=18:FLEN=2:GOSUB 2010:IF FKEY=10 THEN 930 ELSE IF SPF THEN 900 ELSE IF VAL(B$)>0 AND VAL(B$)<13 THEN C$(CR,6)=STR$(VAL(B$)) ELSE LOCATE X,Y:PRINT"  ":GOTO 910
  57. 920 LOCATE 14,17:PRINT SPC(6);:LOCATE 14,17:PRINT C$(CR,6);
  58. 930 GOSUB 168:INCOMP=0:IF LEN(C$(CR,2))<1 OR VAL(C$(CR,3))<0! OR LEN(C$(CR,4))<8 OR LEN(C$(CR,5))<1 THEN INCOMP=1
  59. 940 IF INCOMP THEN ELSE UPFLG=1:GOSUB 380:C$(CR,1)="C":IF CR>LT THEN LT=CR:GOTO 970 ELSE 970
  60. 950 GOSUB 400:GOSUB 2170:IF YES THEN 850 ELSE 1011
  61. 960 GOSUB 430:GOSUB 380
  62. 970 GOSUB 13000:ON FKEY+1 GOTO 970,980,990,970,970,1020,1000,970,970,1010,1040
  63. 980 IF PV=0 THEN 960 ELSE CR=PV:PV=PV-1:GOTO 960
  64. 990 IF CR>=LT THEN 960 ELSE PV=CR:CR=CR+1:GOTO 960
  65. 1000 PV=LT:CR=LT+1:IF CR+ODP+OCK>CX THEN CR=LT:PV=LT-1:GOSUB 13500:GOTO 960 ELSE 850
  66. 1010 C$(CR,5)="VOID":C$(CR,1)="V":GOTO 990
  67. 1011 IF CR<LT THEN ELSE FOR I=1 TO 6:C$(CR,I)="":NEXT:GOTO 990
  68. 1012 FOR I=CR TO LT:FOR J=1 TO 6:C$(I,J)=C$(I+1,J):NEXT J,I:FOR J=1 TO 6:C$(I,J)="":NEXT:LT=LT-1:GOTO 990
  69. 1020 IF CR<LT THEN ELSE FOR I=1 TO 6:C$(CR,I)="":NEXT:LT=LT-1:CR=LT:PV=LT-1:GOTO 990
  70. 1030 FOR I=CR TO LT:FOR J=1 TO 6:C$(I,J)=C$(I+1,J):NEXT J,I:FOR J=1 TO 6:C$(I,J)="":NEXT:LT=LT-1:GOTO 990
  71. 1040 IF LT<1 THEN 760 ELSE LSCHK$=C$(LT,2):GOTO 1420
  72. 1050 GOSUB 260:LOCATE 4,33:COLOR 0,7:PRINT"DEPOSIT  ENTRY";:ERASE C$:DIM C$(CX+1,6):CR=1:LT=0:NWDT$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  73. 1060 GOSUB 360:GOSUB 410
  74. 1080 X=7:Y=24:FLEN=8:GOSUB 3280:IF FKEY=10 THEN 1100 ELSE C$(CR,4)=B$:LOCATE 7,23:PRINT SPC(10);:LOCATE 7,24:PRINT C$(CR,4);
  75. 1090 X=7:Y=50:GOSUB 550:IF FKEY=10 THEN 1100 ELSE IF SPF THEN 1080 ELSE IF LEN(B$)>0 THEN C$(CR,3)=B$:LOCATE 7,50:PRINT SPC(11);:LOCATE 7,50:A#=VAL(C$(CR,3)):PRINT USING MK1$;A#;:C$(CR,5)="DEPOSIT"
  76. 1100 GOSUB 168:INCOMP=0:IF LEN(C$(CR,3))<1 OR LEN(C$(CR,4))<8 THEN INCOMP=1
  77. 1110 IF INCOMP THEN 1120 ELSE UPFLG=1:C$(CR,1)="D":IF CR>LT THEN LT=CR:GOTO 1140 ELSE 1140
  78. 1120 LOCATE 23,8:COLOR 7,0:PRINT"Deposit Will Not Be Saved Unless The ";:COLOR 14:PRINT"DATE ";:COLOR 7:PRINT"And";:COLOR 14:PRINT" AMOUNT ";:COLOR 7:PRINT"Are Complete.";:COLOR 14:LOCATE 25,20:PRINT"Do You Wish To Finish This Deposit? <Y/N>";:COLOR 7
  79. 1130 GOSUB 2170:IF YES THEN 1060 ELSE 1190
  80. 1140 GOSUB 410:GOSUB 380
  81. 1150 GOSUB 13000:ON FKEY+1 GOTO 1150,1160,1170,1150,1150,1190,1180,1150,1150,1190,1420
  82. 1160 IF CR<2 THEN 1140 ELSE CR=CR-1:GOTO 1140
  83. 1170 IF CR>=LT THEN 1140 ELSE CR=CR+1:GOTO 1140
  84. 1180 CR=LT+1:IF CR+ODP+OCK>CX THEN CR=LT:GOSUB 13500:GOTO 1140 ELSE 1060
  85. 1190 IF CR>=LT THEN ELSE FOR I=CR TO LT:FOR J=1 TO 6:C$(I,J)=C$(I+1,J):NEXT J,I
  86. 1210 FOR I=1 TO 6:C$(CR,I)="":NEXT:LT=LT-1:GOTO 1160
  87. 1230 GOSUB 260:LOCATE 4,33:COLOR 0,7:PRINT"  BANK CHARGE";:ERASE C$:DIM C$(CX+1,6):CR=1:LT=0:NWDT$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  88. 1240 GOSUB 360:GOSUB 410
  89. 1260 X=7:Y=24:GOSUB 3280:IF FKEY=10 THEN 1280 ELSE C$(CR,4)=B$:LOCATE 7,23:PRINT SPC(10);:LOCATE 7,24:PRINT C$(CR,4);
  90. 1270 X=7:Y=50:GOSUB 550:IF FKEY=10 THEN 1280 ELSE IF SPF THEN 1260 ELSE IF LEN(B$)>0 THEN C$(CR,3)=B$:LOCATE 7,50:PRINT SPC(11);:A#=VAL(C$(CR,3)):LOCATE 7,50:PRINT USING MK1$;A#;:C$(CR,5)="BANK CHARGE"
  91. 1280 GOSUB 168:INCOMP=0:IF LEN(C$(CR,3))<1 OR LEN(C$(CR,4))<8 THEN INCOMP=1
  92. 1300 IF INCOMP THEN ELSE UPFLG=1:C$(CR,1)="B":IF CR>LT THEN LT=CR:GOTO 1330 ELSE 1330
  93. 1310 LOCATE 23,1:COLOR 7,0:PRINT"Bank Charge Will Not Be Saved Unless The ";:COLOR 14:PRINT"DATE ";:COLOR 7:PRINT"and";:COLOR 14:PRINT" AMOUNT";:COLOR 7:PRINT" Are Complete.";:LOCATE 25,20:COLOR 14:PRINT"Do You Wish To Finish This Entry? <Y/N>";:COLOR 7
  94. 1320 GOSUB 2170:IF YES THEN 1240 ELSE 1380
  95. 1330 IF LT<0 THEN LT=1
  96. 1331 GOSUB 410:GOSUB 380
  97. 1340 GOSUB 13000:ON FKEY+1 GOTO 1340,1350,1360,1340,1340,1380,1370,1340,1340,1380,1420
  98. 1350 IF CR<2 THEN 1330 ELSE CR=CR-1:GOTO 1330
  99. 1360 IF CR>=LT THEN 1330 ELSE CR=CR+1:GOTO 1330
  100. 1370 CR=LT+1:IF CR+ODP+OCK>CX THEN CR=LT:GOSUB 13500:GOTO 1331 ELSE 1240
  101. 1380 IF CR>=LT THEN ELSE FOR I=CR TO LT:FOR J=1 TO 6:C$(I,J)=C$(I+1,J):NEXT J,I
  102. 1381 FOR I=1 TO 6:C$(CR,I)="":NEXT:LT=LT-1:GOTO 1350
  103. 1420 IF LT<1 OR UPFLG=0 THEN 760
  104. 1430 FL$=AN$+".O"+CYR$:GOSUB 1620:GOSUB 3260:FL$=AN$+".C"+CYR$:GOSUB 1620:GOSUB 3270
  105. 1450 GOSUB 2950:GOTO 750
  106. 1610 COLOR 7,0:CLS:COLOR 13:Y=((80-LEN(ZQ))/2)-2:LOCATE 1,Y:PRINT"┌"STRING$(LEN(ZQ)+2,196)"┐":LOCATE 3,Y:PRINT"└"STRING$(LEN(ZQ)+2,196)"┘":LOCATE 2,Y:PRINT"│ ";:COLOR 0,7:PRINT ZQ;:COLOR 13,0:PRINT" │":COLOR 7:RETURN
  107. 1620 CLS:COLOR 3:LOCATE 12:ZS="One Moment While "+FL$+" File Is Being Written":GOSUB 1765:COLOR 7:RETURN
  108. 1640 IF HK$<>"" THEN RETURN ELSE IF DK$=" Check Register Diskette " THEN RETURN
  109. 1641 CLS:LOCATE 9,2:COLOR 3,0:PRINT"╔"STRING$(76,205)"╗":FOR I=10 TO 14:LOCATE I,2:PRINT"║":LOCATE I,79:PRINT"║":NEXT:LOCATE 15,2:PRINT"╚"STRING$(76,205)"╝"
  110. 1642 LOCATE 11:ZS="Insert "+DK$
  111. 1643 IF FDY=0 AND DK$<>" Check Register Diskette " THEN ZS=ZS+" Into Drive "+XT$ ELSE ZS=ZS+" Into Your Primary Disk Drive "
  112. 1644 COLOR 0,7:GOSUB 1765
  113. 1653 COLOR 14,0:LOCATE 13:ZS="Strike Any Key When Ready":GOSUB 1765:COLOR 3:GOTO 13000
  114. 1670 LOCATE 25,28:COLOR 14:PRINT"Do You Wish TO Finish? <Y/N>";:COLOR 7:GOSUB 2170:GOTO 170
  115. 1680 LOCATE 25,5:COLOR 14,0:PRINT" If You Escape, Any Cancellations Made Will Not Be Saved. Is That OK? <Y/N>";:COLOR 7:GOSUB 2170:GOTO 170
  116. 1700 CLS:LOCATE 1,1:PRINT"PAGE: " SPC(63) AN$;:LOCATE 2,1:PRINT"LINE CHECK    DATE          NAME or SOURCE"SPC(11)" DEPOSIT   CHECK AMT.  EXP.";:LOCATE 3,1:PRINT"═════╤══════╤════════╤"STRING$(29,205)"╤═══════════╤═══════════╤═══";
  117. 1710 FOR I=4 TO 22:LOCATE I,6:PRINT"│";:LOCATE ,13:PRINT"│";:LOCATE ,22:PRINT"│";:LOCATE ,52:PRINT"│";:LOCATE ,64:PRINT"│";:LOCATE ,76:PRINT"│":NEXT
  118. 1720 LOCATE 23,1:PRINT"═════╧══════╧════════╧"STRING$(29,205)"╧═══════════╧═══════════╧═══";:RETURN
  119. 1750 LOCATE 24,1:COLOR 14:PRINT"ENTER LINE NUMBER:       F1 ";:COLOR 7:PRINT"- Backup      ";:COLOR 14:PRINT"F2 ";:COLOR 7:PRINT"- Forward       ";:COLOR 14:PRINT"F3 ";:COLOR 7:PRINT"- Void";
  120. 1760 LOCATE 25,4:COLOR 14:PRINT"F5 ";:COLOR 7:PRINT"- Cancel Record";:LOCATE 25,26:COLOR 14:PRINT"F6 ";:COLOR 7:PRINT"- Uncancel    ";:COLOR 14:PRINT"F9 ";:COLOR 7:PRINT"- Escape        ";:COLOR 14:PRINT"F10";:COLOR 7:PRINT" - Finished";:RETURN
  121. 1765 LOCATE ,(80-LEN(ZS))/2:PRINT ZS;:RETURN
  122. 1770 GOSUB 1610:COLOR 4:LOCATE 5,31:PRINT"Accounts Available:":COLOR 6:FOR I=1 TO 12:LOCATE (I+7),33:PRINT CHR$(I+64)". "AC$(I,1);:IF AC$(I,1)<>"" THEN PRINT" 19";
  123. 1771 PRINT AC$(I,2):NEXT:LOCATE 21:ZS="Enter Line Of Account Number You Wish To Use:":COLOR 2:GOSUB 1765
  124. 1790 COLOR 0,7:LOCATE 6,28:PRINT" Current data drive is "XT$:COLOR 7,0:LOCATE 22:ZS="If You Don't See The Account You Want, It Is Not On File.":GOSUB 1765:LOCATE 23:ZS="Return To MENU <F10> And Choose Another Option.":GOSUB 1765
  125. 1791 LOCATE 25:COLOR 0,7:ZS=" Strike <F10> To Return To Menu ":GOSUB 1765:COLOR 7,0:RETURN
  126. 1930 B$="":LOCATE X,Y,1
  127. 1940 GOSUB 13000:IF Z=CHR$(34) THEN 1940 ELSE IF FKEY=10 OR Z=CHR$(13) OR Z=CHR$(9) THEN 710
  128. 1950 IF Z=CHR$(8) THEN IF LEN(B$)<1 THEN SPF=1:GOTO 710 ELSE PRINT CHR$(29)" "CHR$(29);:B$=LEFT$(B$,LEN(B$)-1):GOTO 1940
  129. 1970 IF LEN(B$)>=FLEN OR LEN(Z)>1 THEN 1940 ELSE B$=B$+Z:PRINT Z;:GOTO 1940
  130. 2010 B$="":LOCATE X,Y,1
  131. 2030 GOSUB 13000:IF Z=CHR$(34) THEN 2030 ELSE IF Z=CHR$(13) OR Z=CHR$(9) OR FKEY THEN 710
  132. 2060 IF Z=CHR$(8) THEN IF LEN(B$)<1 THEN SPF=1:GOTO 710 ELSE PRINT CHR$(29)" "CHR$(29);:B$=LEFT$(B$,LEN(B$)-1):GOTO 2030
  133. 2085 IF LEN(B$)>=FLEN OR Z<"0" OR Z>"9" THEN 2030 ELSE B$=B$+Z:PRINT Z;:GOTO 2030
  134. 2170 SPF=0:GOSUB 13000:IF Z=CHR$(8) AND BKFLG THEN SPF=1:RETURN ELSE IF Z="N" THEN YES=0:GOTO 710 ELSE IF Z="Y" THEN YES=1:GOTO 710 ELSE IF FKEY=10 THEN RETURN ELSE 2170
  135. 2440 GOSUB 3220
  136. 2450 INPUT#1,AN$,ACTNM$,ACTBAL#,LSTDT$,CCAMT#,CCK,OCAMT#,OCK,CDAMT#,CDP,ODAMT#,ODP,BCAMT#,BC,LSCHK$:FOR I=1 TO 12:INPUT#1,EX$(I):NEXT:CLOSE#1:RETURN
  137. 2470 GOSUB 1620:WRITE#1,AN$,ACTNM$,ACTBAL#,LSTDT$,CCAMT#,CCK,OCAMT#,OCK,CDAMT#,CDP,ODAMT#,ODP,BCAMT#,BC,LSCHK$:FOR I=1 TO 12:WRITE#1,EX$(I):NEXT:CLOSE#1:RETURN
  138. 2480 ERASE C$:DIM C$(CX+1,6)
  139. 2490 GOSUB 3220:FOR I=1 TO CX:IF EOF(1)=0 THEN INPUT#1,C$(I,1),C$(I,2),C$(I,3),C$(I,4),C$(I,5),C$(I,6):NEXT I
  140. 2510 CLOSE#1:RETURN
  141. 2520 GOSUB 13100:ZQ=" RECONCILE ACCOUNT ":GOSUB 1770
  142. 2530 B$="L":GOSUB 500:IF FKEY=10 THEN 6000 ELSE IF AC$(B,1)="" THEN 2520
  143. 2540 CYR$=AC$(B,2):UPFLG=0:FL$=AC$(B,1)+".A"+CYR$:DK$=FL$+" Data Diskette ":GOSUB 1640:GOSUB 2440:FL$=AN$+".O"+CYR$:GOSUB 2480:COLOR 0,7:LOCATE 2,22:PRINT ZQ;:COLOR 7,0
  144. 2550 GOSUB 1700:PG=1:LOCATE 1:ZS=" RECONCILE ACCOUNT ":GOSUB 1765
  145. 2570 GOSUB 1750:PG=1:TP=1
  146. 2580 LOCATE 1,7:PRINT PG:I=TP
  147. 2590 X=I-TP+4:LOCATE X,1:PRINT SPC(5):LOCATE X,7:PRINT SPC(6);:LOCATE X,14:PRINT SPC(8):LOCATE X,23:PRINT SPC(29):LOCATE X,53:PRINT SPC(11):LOCATE X,65:PRINT SPC(11):LOCATE X,78:PRINT"   ";
  148. 2600 IF I>CX THEN 2670 ELSE IF LEN(C$(I,1))<1 THEN 2670
  149. 2610 Z4="XZB":Z5="CD":IF INSTR(Z4,C$(I,1)) THEN COLOR 14 ELSE IF C$(I,1)="V" THEN COLOR 27 ELSE IF INSTR(Z5,C$(I,1)) THEN COLOR 7
  150. 2620 LOCATE X,1:PRINT USING"####.";I
  151. 2630 LOCATE X,7:PRINT USING MK6$;VAL(C$(I,2));:LOCATE X,14:PRINT C$(I,4);:LOCATE X,24:PRINT C$(I,5);
  152. 2640 IF C$(I,1)="D" OR C$(I,1)="Z" THEN LOCATE X,53 ELSE LOCATE X,65
  153. 2650 IF C$(I,1)="V" THEN PRINT SPC(11); ELSE PRINT USING MK1$;VAL(C$(I,3));:LOCATE X,79:IF C$(I,1)="C" OR C$(I,1)="X" THEN PRINT USING "##";VAL(C$(I,6)); ELSE PRINT"  ";
  154. 2660 IF I<CX THEN 2670 ELSE FOR I=I+1 TO TP+18:X=I-TP+4:LOCATE X,1:PRINT SPC(5):LOCATE X,7:PRINT SPC(6);:LOCATE X,14:PRINT SPC(8):LOCATE X,23:PRINT SPC(29):LOCATE X,53:PRINT SPC(11):LOCATE X,65:PRINT SPC(11):LOCATE X,78:PRINT"   ";:NEXT
  155. 2670 IF I=>TP+18 THEN 2680 ELSE I=I+1:GOTO 2590
  156. 2680 COLOR 7,0:LOCATE 24,20:PRINT SPC(3);:X=24:Y=20:FLEN=3:GOSUB 2010:IF FKEY=9 THEN 2700
  157. 2690 IF FKEY THEN 2720 ELSE GOSUB 13000:IF FKEY<>9 THEN 2710
  158. 2700 GOSUB 170:GOSUB 1680:IF YES THEN 6000 ELSE GOSUB 1750:GOTO 2680
  159. 2710 IF FKEY=10 THEN 2920 ELSE IF VAL(B$)>0 THEN B=VAL(B$):CR=B ELSE 2680
  160. 2720 ON FKEY GOTO 2730,2750,2770,2680,2780,2850,2680,2680,2680,2920
  161. 2730 IF TP<20 THEN TP=1 ELSE TP=TP-19:PG=PG-1
  162. 2740 GOTO 2580
  163. 2750 IF (OCK+ODP)>=TP+19 THEN 2760 ELSE 2680
  164. 2760 TP=TP+19:PG=PG+1:GOTO 2580
  165. 2770 VFLG=0:B=VAL(B$):IF B<1 THEN 2680 ELSE IF B>TP-1 AND B<TP+19 THEN VFLG=1:GOTO 2790 ELSE 2680
  166. 2780 B=VAL(B$):IF B<1 THEN 2680 ELSE IF B>TP-1 AND B<TP+19 THEN 2790 ELSE 2680
  167. 2790 UPFLG=1:X=B-TP+4:IF B>CX THEN 2680 ELSE IF C$(B,1)="" THEN 2680
  168. 2800 IF C$(B,1)="C" THEN C$(B,1)="X" ELSE IF C$(B,1)="D" THEN C$(B,1)="Z" ELSE 2680
  169. 2810 IF VFLG THEN C$(B,1)="V":COLOR 27:VFLG=0 ELSE COLOR 14
  170. 2820 LOCATE X,1:PRINT USING "####.";B;:LOCATE X,7:PRINT USING MK6$;VAL(C$(B,2));:LOCATE X,14:PRINT C$(B,4);:LOCATE X,24:PRINT C$(B,5);:LOCATE X,79:PRINT USING "##";VAL(C$(B,6));
  171. 2830 IF C$(B,1)="Z" THEN LOCATE X,53 ELSE LOCATE X,65:IF C$(B,1)="V" THEN PRINT SPC(11);:GOTO 2680
  172. 2840 PRINT USING MK1$;VAL(C$(B,3));:COLOR 7:GOTO 2680
  173. 2850 B=VAL(B$):IF B<1 THEN 2680 ELSE IF B>TP-1 AND B<TP+19 THEN 2860 ELSE 2680
  174. 2860 X=B-TP+4:IF C$(B,1)="" THEN 2680
  175. 2870 IF C$(B,1)="X" THEN C$(B,1)="C" ELSE IF C$(B,1)="Z" THEN C$(B,1)="D"
  176. 2880 IF C$(B,1)="V" THEN IF C$(B,5)="DEPOSIT" THEN C$(B,1)="D" ELSE C$(B,1)="C"
  177. 2890 COLOR 7:LOCATE X,1:PRINT USING "####.";B;:LOCATE X,7:PRINT USING MK6$;VAL(C$(B,2));:LOCATE X,14:PRINT C$(B,4);:LOCATE X,24:PRINT C$(B,5);:LOCATE X,79:PRINT USING "##";VAL(C$(B,6));
  178. 2900 IF C$(B,1)="C" THEN LOCATE X,65 ELSE LOCATE X,53
  179. 2910 PRINT USING MK1$;VAL(C$(B,3));:GOTO 2680
  180. 2920 IF UPFLG THEN GOSUB 2940:GOTO 6000 ELSE GOSUB 3190:GOTO 6000
  181. 2940 FL$=AN$+".O"+CYR$:GOSUB 3230:FL$=AN$+".C"+CYR$:GOSUB 3270
  182. 2950 LSTDT$=DATE$:CCAMT#=0:CCK=0:OCAMT#=0:OCK=0:CDAMT#=0:CDP=0:ODAMT#=0:BCAMT#=0:ODP=0:BC=0
  183. 2960 ZO="CD":ZC="BXZV":FOR I=1 TO CX+1:IF LEN(C$(I,1))<1 THEN 3050 ELSE IF INSTR(ZO,C$(I,1)) THEN ELSE IF INSTR(ZC,C$(I,1)) THEN 3040 ELSE 3050
  184. 3030 WRITE#1,C$(I,1),C$(I,2),C$(I,3),C$(I,4),C$(I,5),C$(I,6):GOTO 3050
  185. 3040 WRITE#2,C$(I,1),C$(I,2),C$(I,3),C$(I,4),C$(I,5),C$(I,6)
  186. 3050 NEXT:CLOSE:ERASE C$:DIM C$(6)
  187. 3060 FL$=AN$+".O"+CYR$:GOSUB 3220:FL$=AN$+".C"+CYR$:GOSUB 3240
  188. 3070 IF EOF(1) THEN 3120 ELSE INPUT#1,C$(1),C$(2),C$(3),C$(4),C$(5),C$(6):IF C$(1)="C" THEN OCK=OCK+1:OCAMT#=OCAMT#+VAL(C$(3)) ELSE IF C$(1)="D" THEN ODP=ODP+1:ODAMT#=ODAMT#+VAL(C$(3))
  189. 3110 GOTO 3070
  190. 3120 IF EOF(2) THEN 3180 ELSE INPUT#2,C$(1),C$(2),C$(3),C$(4),C$(5),C$(6):IF C$(1)="B" THEN BC=BC+1:BCAMT#=BCAMT#+VAL(C$(3)) ELSE IF C$(1)="X" THEN CCK=CCK+1:CCAMT#=CCAMT#+VAL(C$(3)) ELSE IF C$(1)="Z" THEN CDP=CDP+1:CDAMT#=CDAMT#+VAL(C$(3))
  191. 3170 GOTO 3120
  192. 3180 FL$=AN$+".A"+CYR$:GOSUB 3230:GOSUB 2470
  193. 3190 GOSUB 290:RETURN
  194. 3220 GOSUB 3810:CLOSE#1:OPEN"I",#1,XT$+FL$:RETURN
  195. 3230 GOSUB 3810:CLOSE#1:OPEN"O",#1,XT$+FL$:RETURN
  196. 3240 GOSUB 3810:CLOSE#2:OPEN"I",#2,XT$+FL$:RETURN
  197. 3260 GOSUB 3810:CLOSE#1:OPEN XT$+FL$ FOR APPEND AS #1:RETURN
  198. 3270 GOSUB 3810:CLOSE#2:OPEN XT$+FL$ FOR APPEND AS #2:RETURN
  199. 3275 Z1=Z1+Z:LOCATE X,POS(0):PRINT Z;:RETURN
  200. 3280 BKFLG=1:LOCATE X,Y:PRINT NWDT$:LOCATE X+1,Y+1,1:PRINT"<Y/N>?"CHR$(29);
  201. 3290 GOSUB 2170:BKFLG=0:IF SPF THEN ELSE IF YES THEN B$=NWDT$ ELSE IF FKEY=10 THEN ELSE 3340
  202. 3291 LOCATE X+1,Y:PRINT SPC(8):RETURN
  203. 3339 Z1="":LOCATE X,Y:PRINT SPC(8);:LOCATE X,Y,1:PRINT Z2;:RETURN
  204. 3340 Z1="":Z2="":Z3=". /-":LOCATE X+1,Y:PRINT SPC(8);:GOSUB 3339
  205. 3345 GOSUB 13000:IF FKEY=10 THEN RETURN ELSE IF FKEY THEN 3345 ELSE IF INSTR(Z3,Z) THEN ELSE IF Z=CHR$(8) THEN Z2="":GOSUB 3339:GOTO 3340 ELSE IF Z<"0" OR Z>"9" OR LEN(Z1)>1 THEN 3345 ELSE GOSUB 3275:GOTO 3345
  206. 3350 MM=VAL(Z1):IF MM<1 OR MM>12 THEN 3340 ELSE IF LEN(Z1)<>2 THEN Z1="0"+Z1
  207. 3355 Z2=Z1+"-":Z1="":LOCATE X,Y:PRINT Z2;
  208. 3360 GOSUB 13000:IF FKEY=10 THEN RETURN ELSE IF INSTR(Z3,Z) THEN ELSE IF Z=CHR$(8) THEN IF LEN(Z1)<1 THEN Z2="":GOSUB 3339:GOTO 3340 ELSE GOSUB 3339:GOTO 3360 ELSE IF Z<"0" OR Z>"9" OR LEN(Z1)>1 THEN 3360 ELSE GOSUB 3275:GOTO 3360
  209. 3370 DD=VAL(Z1):IF DD<1 OR DD>31 THEN GOSUB 3339:GOTO 3360 ELSE IF LEN(Z1)<>2 THEN Z1="0"+Z1
  210. 3375 Z2=Z2+Z1+"-"+CYR$:LOCATE X,Y:PRINT Z2;CHR$(7);:NWDT$=Z2:B$=Z2:RETURN
  211. 3670 LOCATE X,Y:PRINT USING MK6$;VAL(C$(PV,2))+1:LOCATE X+1,Y+1,1:PRINT"<Y/N>?"CHR$(29);
  212. 3680 GOSUB 2170:IF YES THEN B$=STR$(VAL(C$(PV,2))+1):LOCATE X+1,Y:PRINT SPC(8):RETURN ELSE IF FKEY=10 THEN RETURN
  213. 3690 LOCATE X,Y:PRINT SPC(8):LOCATE X+1,Y:PRINT SPC(8):GOSUB 2010:RETURN
  214. 3810 OPEN"I",#3,XT$+FL$:CLOSE#3:RETURN
  215. 3820 OPEN"I",#3,"logo.com":CLOSE#3:RETURN
  216. 3825 OPEN"I",#3,"logo.com":CLOSE#3:RETURN
  217. 3830 CLOSE#3:OKFLG=1
  218. 3831 IF ERL=3825 THEN ER1=8 ELSE IF ERL=3820 THEN ER1=1 ELSE IF ERL=3810 THEN ER1=2
  219. 3910 IF ERR=71 THEN ER1=4 ELSE IF ERR=72 THEN ER1=6 ELSE IF ERR=70 THEN ER1=7
  220. 3940 BEEP:LOCATE 24,13:COLOR 30:ON ER1 GOTO 3970,3980,4000,4000,4010,4001,4002,4003
  221. 3941 PRINT"Untrapped error",ERR
  222. 3942 ON ERROR GOTO 0:STOP
  223. 3970 ZE="Please Insert CHECK REGISTER DISKETTE":GOTO 4010
  224. 3980 ZE="Please Insert DATA DISKETTE For "+FL$:GOTO 4010
  225. 4000 ZE="Disk Is Not Ready. Insert Diskette And Close Door":GOTO 4010
  226. 4001 ZE="Disk Media Error. Data On Diskette May Be Bad":GOTO 4010
  227. 4002 ZE="Disk Is Write Protected. Be Sure You Have Right Diskette":GOTO 4010
  228. 4003 ZE="Please Insert Any FRIENDLYWARE Diskette"
  229. 4010 LOCATE 24,(80-LEN(ZE))/2:PRINT ZE;:LOCATE 25,20:COLOR 14:PRINT"Strike Any Key When Ready  <ESC> To Abort";:COLOR 3
  230. 4020 ER1=0:GOSUB 13000:GOSUB 169:IF Z<>CHR$(27) THEN RESUME
  231. 4060 LOCATE 24,12:PRINT"If You Escape, Any Changes Or Entrys Will Not Be Saved!";
  232. 4067 LOCATE 25,32:PRINT"Is That OK? <Y/N>";:BEEP:GOSUB 2170:IF YES THEN FDY=0:RESUME 6000
  233. 4082 GOSUB 169:GOTO 3940
  234. 6000 ERASE C$:DIM C$(6)
  235. 6001 ZQ=" CHECK REGISTER ":GOSUB 1610:COLOR 3,0:LOCATE 5,24:PRINT"Routines Available In This Program"
  236. 6010 LOCATE 7,26:COLOR 0,7:PRINT" A ":LOCATE 9,26:PRINT" B ":LOCATE 11,26:PRINT" C ":LOCATE 13,26:PRINT" D ":LOCATE 15,26:PRINT" E ":LOCATE 17,26:PRINT" F ":LOCATE 19,26:PRINT"F10":LOCATE 7,32:COLOR 2,0:PRINT"General Information"
  237. 6020 LOCATE 9,32:PRINT"Create New Account":LOCATE 11,32:PRINT"Enter Transactions":LOCATE 13,32:PRINT"Reconcile Account":LOCATE 15,32:PRINT"Listings of Transactions":LOCATE 17,32:PRINT"System Maintenance":LOCATE 19,32:PRINT"Return To FriendlyWare Menu"
  238. 6040 GOSUB 13000:IF FKEY=10 THEN 6110 ELSE IF Z<"A" OR Z>"F" THEN 6040 ELSE ON ASC(Z)-64 GOTO 6051,6060,720,2520,6090,6100
  239. 6051 GOSUB 3820:CHAIN"info.003",300,ALL
  240. 6060 GOSUB 3820:CHAIN"info.003",2610,ALL
  241. 6090 GOSUB 3820:CHAIN"info.003",1249,ALL
  242. 6100 GOSUB 3820:CHAIN"info.003",3529,ALL
  243. 6110 DK$=" FriendlyWare Diskette "
  244. 6120 GOSUB 3825:CLEAR:ON ERROR GOTO 6121:RUN"menu3"
  245. 6121 CLEAR:ON ERROR GOTO 6122:RUN"menu2"
  246. 6122 RUN"menu1"
  247. 13000 SPF=0:TBF=0:FKEY=0:DEF SEG=&H40:POKE &H1A,PEEK(&H1C)
  248. 13010 POKE &H17,(PEEK(&H17) OR 96):Z=INKEY$:IF Z="" THEN 13010 ELSE ZZ=RIGHT$(Z,1):IF LEN(Z)>1 THEN IF ZZ<";" OR ZZ>"D" THEN 13010 ELSE ELSE RETURN
  249. 13020 FKEY=ASC(ZZ)-58:RETURN
  250. 13100 DEFINT A-Y:DEFSTR Z:MK1$="$$#####,.##":MK2$="$$#######,.##":MK6$="######":ON ERROR GOTO 3830:RETURN
  251. 13500 GOSUB 168:COLOR 12,0:LOCATE 23:ZS=" You may have only"+STR$(CX)+" outstanding transactions at a time. You must ":GOSUB 1765:LOCATE 24:ZS=" reconcile transactions before you can add any more checks or deposits. ":GOSUB 1765:GOSUB 340:RETURN
  252.