home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol136 / checklst.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-15  |  5.2 KB  |  110 lines
  1. 4000 COLOR 7,0: REM  ***************************************************************************************************
  2. 4010 REM                       'CHECKLST' SUBROUTINE FOR PRINTING PAYEE FILE INFORMATION
  3. 4020 REM  **************************************************************************************************************
  4. 4030 GOSUB 270   'OPEN PAYEE FILES
  5. 4040 COLOR 7,0: CLS
  6. 4050 PRINT "  Reply.. N  (for Payee Name listing)"
  7. 4060 PRINT "  Reply.. A  (for Payee Name and also"
  8. 4070 PRINT SPC(14);"Address listing.) ";
  9. 4080 C$ = INKEY$: IF C$ = "" THEN 4080
  10. 4090 PRINT C$: IF C$ = "N" OR C$ = "n" THEN SHORTLIST$ = "Y": GOTO 4120
  11. 4100 IF C$ = "A" OR C$ = "a" THEN SHORTLIST$ = "N": GOTO 4120
  12. 4110 COLOR 31,0: PRINT "  You must reply N or A.  Retry!! ";: COLOR 7,0: GOTO 4080
  13. 4120 PRINT: PRINT "  Enter YEAR to be accumulated:"
  14. 4130 PRINT "    Such as:   82  (for 1982)"
  15. 4140 COLOR 0,7: PRINT "    Year ===> ";: Y = CSRLIN: X = POS(0)
  16. 4150 FIELDMAX% = 2: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 330
  17. 4160 YEAR$ = DATU$
  18. 4170 PAGENO% = 0  'INITIALIZE TO ZERO
  19. 4180 LINECT% = 0  'INITIALIZE TO ZERO
  20. 4190 IF YEAR$ = "" THEN CLOSE #1,#2: GOTO 260  'IF NULL FIELD, GO TO DISPLAY MENU
  21. 4200 GOSUB 4970   'PRINT REPORT HEADING
  22. 4210 REM  ---------------------BUILD THE PAYEE CODE ARRAY TABLE FOR SORTING PAYEE CODES---------------------------------
  23. 4220 NOE% = 0
  24. 4230 FOR I = 2 TO M1%
  25. 4240     GET #1,I
  26. 4250     IF ASC(F1$) = 255 THEN GOTO 4310
  27. 4260     KINT% = VAL(P1$)
  28. 4270     IF KINT% = 0 THEN LPRINT P1$;" PAYEE CODE IS NOT NUMERIC": GOTO 4310
  29. 4280     NOE% = NOE% + 1
  30. 4290     PSORT%(NOE%,0) = KINT%
  31. 4300     PSORT%(NOE%,1) = I
  32. 4310 NEXT I
  33. 4320 REM  --------------(SHELL)-SORT THE PAYEE CODE ARRAY TABLE INTO PAYEE CODE SEQUENCE--------------------------------
  34. 4330 CLS
  35. 4340 LOCATE 12,1
  36. 4350 PRINT "  Beginning to SORT in memory, the"
  37. 4360 PRINT: PRINT "  Payee Codes Table, which will be"
  38. 4370 PRINT: PRINT "  used to print the Payee File in"
  39. 4380 PRINT: PRINT "  alphabetic Payee Name sequence"
  40. 4390 M% = NOE%       'NOE% = NUMBER OF TABLE ENTRIES
  41. 4400 M% = INT(M% / 2)
  42. 4410 IF M% = 0 THEN GOTO 4550  'END OF SORT
  43. 4420 K = NOE% - M%
  44. 4430 J = 1
  45. 4440 I = J
  46. 4450 L% = I + M%
  47. 4460 IF PSORT%(I,0) <= PSORT%(L%,0) THEN GOTO 4510
  48. 4470 SWAP PSORT%(I,0),PSORT%(L%,0)
  49. 4480 SWAP PSORT%(I,1),PSORT%(L%,1)
  50. 4490 I = I - M%
  51. 4500 IF I >= 1 THEN GOTO 4450
  52. 4510 J = J + 1
  53. 4520 IF J > K THEN GOTO 4400
  54. 4530 GOTO 4440
  55. 4540 REM  --------------------------------START RETRIEVING PAYEE FILE USING SORTED TABLE ENTRIES------------------------
  56. 4550 FOR K = 1 TO J
  57. 4560     REC% = PSORT%(K,1)
  58. 4570     GET #1,REC%:  GET #2,REC%
  59. 4580     IF P1$ = P2$ THEN GOTO 4640
  60. 4590         COLOR 0,7: PRINT "  ERROR - File #1 and File #2"
  61. 4600         PRINT "  Payee Codes are unequal"
  62. 4610         PRINT "  File #1 is ";P1$
  63. 4620         PRINT "  File #2 is ";P2$
  64. 4630         GOTO 340  'CANCEL THIS RUN
  65. 4640     PDTODATE# = 0
  66. 4650     GOSUB 280  'MOVE FILE #2 TO ARRAY
  67. 4660     FOR I = 1 TO 8
  68. 4670         IF CHEK2$(I) = "V" THEN GOTO 4690
  69. 4680         IF MID$(CHEK3$(I),7,2) = YEAR$ THEN PDTODATE# = PDTODATE# + CHEK4(I)
  70. 4690     NEXT I
  71. 4700     CHANE% = CVI(L$)
  72. 4710     IF CHANE%<>0 THEN GET #2,CHANE%: GOTO 4650
  73. 4720     REM  **********************************************************************************************************
  74. 4730     REM                                        PRINT PAYEE FILE DATA
  75. 4740     REM  **********************************************************************************************************
  76. 4750     FED$ = SPACE$(1): STATE$ = SPACE$(1)
  77. 4760     IF G1$="D" THEN FED$="Y":STATE$="Y"
  78. 4770     IF G1$="F" THEN FED$="Y"
  79. 4780     IF G1$="S" THEN STATE$="Y"
  80. 4790     LPRINT TAB(2); P1$;" ";
  81. 4800     LPRINT USING "###";REC%;
  82. 4810     LPRINT TAB(16);A1$;TAB(50);
  83. 4820     LPRINT USING "######,.##";PDTODATE#;
  84. 4830     LPRINT TAB(66);FED$;TAB(74);STATE$;TAB(84);D1$
  85. 4840     IF SHORTLIST$ = "Y" THEN LINECT% = LINECT% + 1: GOTO 4890
  86. 4850     LPRINT TAB(16);A2$
  87. 4860     LPRINT TAB(16);A3$;TAB(40);A4$
  88. 4870     LPRINT
  89. 4880     LINECT% = LINECT% + 4
  90. 4890     IF LINECT%<60 THEN GOTO 4910
  91. 4900     GOSUB 4970  'PRINT HEADING
  92. 4910 NEXT K
  93. 4920 LPRINT CHR$(18);CHR$(12)   'RETURN TO NORMAL PRINT & SKIP TO NEXT PAGE
  94. 4930 GOTO 260   'RETURN TO JOB CHOICES MENU
  95. 4940 REM  **************************************************************************************************************
  96. 4950 REM                SUBROUTINE TO PRINT HEADING FOR THE PAYEE FILE INFORMATION REPORT
  97. 4960 REM  **************************************************************************************************************
  98. 4970 IF PAGENO%<>0 THEN LPRINT CHR$(12)
  99. 4980 PAGENO% = PAGENO% + 1
  100. 4990 LPRINT PMODE$;CHR$(14); SPC(16); "PAYEE FILE AS OF ";
  101. 5000 LPRINT DATE$; SPC(6);"PAGE ";
  102. 5010 LPRINT USING "###";PAGENO%
  103. 5020 LPRINT: LPRINT TAB(51);CHR$(39);YEAR$;"  AMOUNT" TAB(64);"TAX DEDUCTIBLE"
  104. 5030 LPRINT TAB(6);"CODES";TAB(23);"NAME AND ADDRESS";TAB(50);"PAID-TO-DATE  FEDERAL  STATE          MEMO DATA"
  105. 5040 LPRINT
  106. 5050 LINECT% = 5
  107. 5060 RETURN
  108. 5070 REM  --------------------------------------------------------------------------------------------------------------
  109. 9000 GOTO 9000  'CHAIN MERGE AREA LAST STATEMENT
  110.