home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 1 #3 / utv1n3s1.d64 / medtax (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  13KB  |  429 lines
  1. 1 rem medtax.03
  2. 2 rem 11/14/86
  3. 3 rem by michael reich
  4. 4 rem with instruction loader
  5. 8 rem 04/05/87
  6. 9 poke53280,6:poke53281,1
  7. 10 if a=0 then a=1:gosub 10030:rem print screen
  8. 11 if b=0 then b=1:ld$="seq reader.exe":goto 7500
  9. 12 if b=1 then b=2:ld$="lptr rtn":goto 7500
  10. 13 gosub 210
  11. 15 rem **********
  12. 16 rem * init.  *
  13. 17 rem **********
  14. 20 t$="[205]edical-[212]ax [198]ile":rv$=chr$(18):ro$=chr$(146):ts$="medtax.dat":sc$=chr$(147)
  15. 25 def fnr(z)=int(z*100+.5)/100
  16. 30 cl$="                                       ":dn$=""
  17. 40 lo$=dn$+cl$+dn$:c1$=chr$(154):c2$=chr$(152):pc=.85:rem copay
  18. 50 m=100:nf=6:pe=5:ty=5:dim en$(m),a$(nf),sl(nf),le(nf),pe$(9)
  19. 55 fori=1tope:readpe$(i):next:rem family names
  20. 60 data mike,nancy,sara,amanda,jake
  21. 65 fori=1toty:readty$(i):next:rem expense types
  22. 70 data "[205][196]","[196][196][211]","[200]osp","[210][216]","[207]ther"
  23. 75 en$(0)="..................................":rem len=34
  24. 80 fori=1tonf:readfi$(i),sl(i),le(i):next:fi$(0)="[210]ecord #"
  25. 82 data"[196]ate      ",1,8,"[212]ype      ",9,1,"[197]xpense   ",10,7,"[210]eimburse.",17,7
  26. 84 data"[208]rovider  ",24,10,"[208]atient   ",34,1
  27. 85 no=9:dim mo$(no):fori=1tono:readmo$(i):next
  28. 87 data"[205]odify [210]ecord","[208]rint [198]ile","[193]dd [210]ecord"
  29. 88 data"[204]oad [198]ile","[211]ave [198]ile","[195]alculate [207]utstanding [195]laims"
  30. 89 data"[197]dit [198]amily [205]embers' [206]ames","[201]nstructions","[197]xit"
  31. 95 goto500
  32. 100 rem **********
  33. 102 rem * screen *
  34. 104 rem **********
  35. 110 printsc$;mo;mo$(mo):ifmo=2thenifz<=pethenprinttab(25)"[145]"rv$pe$(z)
  36. 115 print"[192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]":return
  37. 120 gosub100:printleft$(dn$,6);
  38. 130 fori=1tonf:printi;rv$;fi$(i)
  39. 140 next: return
  40. 200 rem **********
  41. 202 rem * delay  *
  42. 204 rem **********
  43. 210 fort=1to500:next
  44. 220 fort=1to500:next:return
  45. 255 rem **********
  46. 256 rem *keypress*
  47. 257 rem **********
  48. 260 getc$:ifc$=""then260
  49. 270 return
  50. 280 ifmo=1thenprintlo$tab(16)"[145] [201][146]ndex,"
  51. 282 printlo$"            [195][146]ontinue or [197][146]xit";
  52. 285 gosub 260: rem get kbd input
  53. 286 if (c$="c") or (c$="e") or (c$="i") then 290
  54. 287 if (c$<>"[195]") and (c$<>"[197]") and (c$<>"[201]") then 285
  55. 290 return
  56. 300 rem **********
  57. 302 rem *disasemb*
  58. 304 rem **********
  59. 310 fori=1tonf:a$(i)=mid$(en$(0),sl(i),le(i)):next:return
  60. 320 fori=1tonf:a$(i)=mid$(en$(cr),sl(i),le(i)):next:return
  61. 340 rem **********
  62. 342 rem *print a$*
  63. 344 rem **********
  64. 350 printleft$(dn$,5)fi$(0)cr:fori=1tonf    :printtab(15)a$(i)
  65. 360 ifmo=1thenx$(i)=a$(i)
  66. 370 next: return
  67. 400 rem **********
  68. 402 rem * select *
  69. 404 rem **********
  70. 410 printlo$"[145][145][145][145]"
  71. 420 print"[215]hich [208]erson:"
  72. 425 printc2$0;c1$"[193]ll",;
  73. 430 forp=1tope:print"[152]"p"[154]"pe$(p),;:next
  74. 450 gosub260:c=val(c$):if c>pe then450
  75. 460 printlo$"[145][145][145]"cl$cl$cl$" ":return
  76. 500 rem **********
  77. 502 rem * menu   *
  78. 504 rem **********
  79. 510 mo=0:gosub10000
  80. 512 printleft$(dn$,24)spc(9)"";lr;"[157] [146]"c2$" [210]ecords in [205]emory"c1$:print
  81. 515 fori=1tono:print:printtab(5)i;mo$(i):next:print
  82. 520 printtab(12)"[211]election? [163][145][157][157] ";
  83. 530 gosub260:mo$=c$
  84. 540 mo=val(mo$):ifmo<1ormo>no then510
  85. 550 printc2$mo$c1$:if mo=no then sys (8*4096)+4
  86. 560 ifmo=4 or mo=8or mo=7 or lr>0then580
  87. 570 printlo$rv$spc(9)"[150]  [206]o [198]ile in [205]emory  "
  88. 575 printspc(12)"[154][206]ew [198]ile? <y/n>";:gosub 260: ne$=c$: ifne$="y"thengoto580
  89. 576 goto590
  90. 580 onmogosub1000,42000,3000,5000,6000,9000,43000,30000
  91. 590 goto510
  92. 1000 rem **********
  93. 1002 rem * modify *
  94. 1004 rem **********
  95. 1020 gosub100:gosub280
  96. 1030 ifc$<>"c"andc$<>"i"andc$<>"e"then1020
  97. 1050 ifc$="e"then1999
  98. 1060 ifc$="i"thengosub1800:goto1000
  99. 1100 printlo$"[145]"cl$lo$"[197]nter [210]ecord [206]umber to [205]odify -> ";:bs$="[157] [157]":max=3
  100. 1110 gosub 30200:cr=val(te$)
  101. 1120 ifcr<1orcr>lrthenprintlo$"         [201]nvalid [210]ecord [206]umber"c1$:gosub200:goto1000
  102. 1130 gosub120:gosub320:gosub350
  103. 1170 printlo$"[205]odify [215]hich [198]ield (1-"nf"or 0=exit) ";:gosub260:printc$;
  104. 1174 i=val(c$):ifi=0then1000
  105. 1175 ifi<>4 then 1180
  106. 1176 printlo$"[193]utomatic calc. <[217]> ";:de$="[157] [157]"
  107. 1177 gosub 30200:if te$="y" or te$="[217]" or te$="" then 1240
  108. 1180 ifi>nfthenprintlo$"[201]nvalid [198]ield [206]umber"c1$:gosub200:goto1000
  109. 1190 gosub3600:gosub3740:ify$<>"y"then1170
  110. 1230 a$(i)=x$:en$(cr)="":forx=1tonf:en$(cr)=en$(cr)+a$(x):next:goto1170
  111. 1235 :
  112. 1240 ifi=4thenz=.85*val(a$(3)):z=fnr(z):z$=left$(str$(z)+en$(0),le(i))
  113. 1250 a$(i)=mid$(z$,2)+".":en$(cr)="":forx=1tonf:en$(cr)=en$(cr)+a$(x):next
  114. 1260 goto1130
  115. 1800 :
  116. 1802 rem index
  117. 1804 :
  118. 1810 gosub1890:forcr=1tolr:x1$=mid$(en$(cr),1,8):x2$=mid$(en$(cr),34,1)
  119. 1820 x2=val(x2$):x3$=mid$(en$(cr),9,1):x3=val(x3$)
  120. 1830 printcr;tab(5)x1$tab(15)pe$(x2)tab(30)ty$(x3):ln=ln+1
  121. 1840 ifln>19thengosub1870
  122. 1850 next:gosub2850:return
  123. 1870 gosub2850
  124. 1890 printsc$tab(16)rv$" [201]ndex ":printa$(0)
  125. 1900 print"[210]ec"tab(5)"[196]ate"tab(15)"[208]erson"tab(30)"[212]ype":printa$(0):ln=3
  126. 1999 return
  127. 2000 rem **********
  128. 2002 rem * view   *
  129. 2004 rem **********
  130. 2010 printlo$"       [214]iew "rv$"[193]"ro$"ll or "rv$"[210]"ro$"ange or ";
  131. 2015 printrv$"[197]"ro$"xit"
  132. 2020 gosub260:ifc$<>"a"andc$<>"r"andc$<>"e"then2020
  133. 2030 ifc$="e"thenreturn
  134. 2040 ur=0:ifc$="a"thenf=1:l=lr:goto2100
  135. 2050 printlo$"[145]"cl$" [197]nter [198]irst [210]ecord: ";:bs$="[157] [157]":max=3:gosub 30200
  136. 2055 f=val(te$):if f<1 or f>lr then 2010
  137. 2060 printlo$"[197]nter [204]ast [210]ecord: ";:gosub 30200:l=val(te$):ifl<fthen2010
  138. 2070 ifl>lrthenl=lr
  139. 2100 z=0:gosub 110:gosub400:z=c:ifmo=6thenreturn
  140. 2120 gosub2900:forcr=ftol
  141. 2140 gosub320:ifz=0then2160
  142. 2150 ifval(a$(6))<>zthen2310
  143. 2160 printa$(1)spc(4)a$(3)spc(4);:           ifleft$(a$(5),1)="."thenprint
  144. 2170 ifleft$(a$(5),1)<>"."thenprinta$(5)
  145. 2180 print" "ty$(val(a$(2)))tab(12)a$(4)spc(4);:ifleft$(a$(6),1)="."thenprint
  146. 2190 ifleft$(a$(6),1)<>"."thenprintpe$(val(a$(6)))
  147. 2200 u1=val(a$(3))-val(a$(4))
  148. 2220 ur=ur+u1:ur$=str$(ur):u1$=str$(u1):     ifu1<1thenu1$=left$(u1$,4)
  149. 2230 printc2$"^[210]ec."cr"[157] [213]nreim:"u1$" [212]otal :"ur$c1$
  150. 2300 ln=ln+3:ifln>18thengosub2850
  151. 2310 next
  152. 2320 gosub2850:return
  153. 2850 printlo$"       [208]ress <[211]pace> to [195]ontinue"
  154. 2860 gosub260:ifc$<>" "then2860
  155. 2870 ifcr>=l thenreturn
  156. 2900 gosub100
  157. 2920 fori=1tonfstep2:printrv$"[152]"fi$(i)ro$" ";:next:print
  158. 2930 fori=2to nfstep2:printrv$fi$(i)ro$" ";:next:print"[154]":ln=4:return
  159. 3000 rem **********
  160. 3002 rem * add    *
  161. 3004 rem **********
  162. 3010 fl=1:bs$="[157][154].[157]":gosub100:gosub280:ifc$="e"thenreturn
  163. 3100 gosub120:cr=lr+1
  164. 3110 ifcr>mthenprint"[198]ile [212]oo [204]arge -[154] [211]ave [196]ata":gosub210:gosub210:return
  165. 3130 gosub300:gosub350
  166. 3150 fori=1tonf:x$(i)=a$(i):gosub3600:       a$(i)=x$:next
  167. 3170 gosub3740:ify$<>"y"then3000
  168. 3190 lr=cr:fori=1tonf:en$(lr)=en$(lr)+a$(i):next:goto3000
  169. 3600 :
  170. 3602 rem input for current record
  171. 3604 :
  172. 3610 po$=left$(dn$,5+i):printlo$
  173. 3620 printpo$tab(15)x$(i):x$="": max=6
  174. 3625 if i=1 then max=8:printlo$spc(16)"[205][205]/[196][196]/[217][217]"
  175. 3630 if i=2 then max=1: printlo$;:for p=1 to ty: print""p"[154]"ty$(p);: next
  176. 3640 ifi=4thenprintlo$" [197]nter amount reimbursed by insurance"
  177. 3650 if i=5 then max=10: printlo$" enter md/dds/hosp name [optional]"
  178. 3670 if i=6 then max=1: printlo$"[145]";: for p=1 to pe:print""p"[154]"pe$(p),;:next
  179. 3680 print po$ tab(15)"";: if (i=3) or (i=4) then print"[157]$";
  180. 3685 gosub 30200:x$=te$+left$(en$(0),le(i)-len(te$))
  181. 3686 print po$ tab(13)" "
  182. 3687 if i<>1 or len(te$)=8 then 3690
  183. 3688 if mid$(x$,2,1)="/" then x$=left$("0"+x$,8)
  184. 3689 if len(te$)<8 thenif mid$(x$,5,1)="/" then x$=left$(x$,3)+"0"+right$(te$,4)
  185. 3690 if i=6 then if (x$<"1") or (x$>mid$(str$(pe),2,1)) then 3610
  186. 3720 print lo$:x$(i)=x$: return
  187. 3730 :
  188. 3740 printlo$"[145]"cl$"               [193]ccept <[217]>";:de$="y":gosub 41000
  189. 3750 printlo$:return
  190. 4000 rem **********
  191. 4002 rem * print  *
  192. 4004 rem **********
  193. 4005 rem printer variables
  194. 4010 lf$=chr$(10):es$=chr$(27):ff$=chr$(12):ri$=es$+chr$(98):pa=0
  195. 4020 ts$=es$+chr$(68)+chr$(5)+chr$(10)+chr$(19)+chr$(30)+chr$(40)