High Voltage Shareware/high1.zip/high1/DIR3/EXTPROB.ZIP/EXTPROB.BAS

BASIC Source File | 1994-01-21 | 22KB | 501 lines

      '
      ' mi-crin ...
      '

'     declare function btrv%(integer, string, integer,  flex,  flex, integer)
'     public BtrieveInstalled%

      defint a-z

      gosub Initialization
      gosub MainLogic
      gosub Termination
      system

MainLogic:
      color 7, 0: cls
      color 0, 7: locate 1,1: print " Create the Insurance file from existing insurance codes."; tab( 80 ); " ";
      color 7, 0:

      WkStartTime$ = time$
      locate  3,1: print "   Start time: "; WkStartTime$
      locate  6,1: print "     FileSpec: ";
      locate  7,1: print "Total records: ";
      locate  8,1: print "         Read: ";
      locate  9,1: print "    Ins Codes: ";
      locate 10,1: print "     FileSpec: ";
      locate 11,1: print "Total records: ";
      locate 12,1: print "      Written: ";


      WkPMNOR&    = 0
      WkINNOR&    = 0
      WkPMCount&  = 0
      WkINCount&  = 0

      WkIns$      = ""
      WkSpace3$   = space$( 3 )

      gosub BtOpenPMFile
      gosub BtErrorChecking
      gosub BtOpenInFile
      gosub BtErrorChecking

      locate  6, 17: print BtPMFileSpec$
      locate  7, 17: print using "##,###"; WkPMNOR&
      locate 10, 17: print BtINFileSpec$
      locate 11, 17: print using "##,###"; WkINNOR&

      BtPMOpr = BtStepFirst

MainGetNext:
      if inkey$ = chr$( 27 ) then
         goto QuitMainLogic
      end if

      gosub BtPMFile

      if BtSts = BtEndOfFile then
         goto QuitMainLogic
      end if
      gosub BtErrorChecking

      BtPMOpr = BtStepNext
      incr WkPMCount&

      if BtPMInsCode1$$ <> WkSpace3$ then
         if instr( WkIns$, BtPMInsCode1$$ ) = 0 then
            WkIns$ = WkIns$ + BtPMInsCode1$$ + "#"
            incr WkINCount&
         end if
      end if

      if BtPMInsCode2$$ <> WkSpace3$ then
         if instr( WkIns$, BtPMInsCode2$$ ) = 0 then
            WkIns$ = WkIns$ + BtPMInsCode2$$ + "#"
            incr WkINCount&
         end if
      end if

      if BtPMInsCode3$$ <> WkSpace3$ then
         if instr( WkIns$, BtPMInsCode3$$ ) = 0 then
            WkIns$ = WkIns$ + BtPMInsCode3$$ + "#"
            incr WkINCount&
         end if
      end if

      locate  8, 17: print using "##,###"; WkPMCount&
      locate  9, 17: print using "##,###"; WkINCount&

      goto MainGetNext

QuitMainLogic:
      WkStopTime$ = time$
      locate 4,1: print "Stop  time: "; WkStopTime$

      WkINCount& = 0
      locate 18,1

      beep
      while inkey$ = "": wend

      for WkPx = 1 to len( WkIns$ ) step 4
          WkInsNum$ = mid$( WkIns$, WkPx, 3 )
          array scan WkInsCode$( 1 ), = WkInsNum$, to WkIx
          BtINDataBuf$$       = " "
          BtINStatus$$        = "A"
          WkTemp$             = date$
          BtINCrDateYY$$      = right$( WkTemp$, 2 )
          BtINCrDateMM$$      =  left$( WkTemp$, 2 )
          BtINCrDateDD$$      =   mid$( WkTemp$, 4, 2 )
          WkTemp$             = time$
          BtINCrTimeHH$$      =  left$( WkTemp$, 2 )
          BtINCrTimeMM$$      =   mid$( WkTemp$, 4, 2 )
          BtINCrTimeSS$$      = right$( WkTemp$, 2 )
          BtINCrUserID$$      = "SAO"
          BtINCrWorkStation$$ = "U1"
          BtINCrProgram$$     = "MI-CRIN"
          BtINChLastAction$$  = "A"
          BtINChInfo$$        = BtINCrInfo$$
          BtINMiLastAction$$  = "A"
          BtINMiInfo$$        = BtINCrInfo$$
          BtINNumber$$        = WkInsNum$
          if WkIx = 0 then
             BtINDescription$$ = "No description for " + WkInsNum$ + "."
          else
             BtINDescription$$ = WkInsDesc$( WkIx )
          end if
          BtINComm$$        = "N"
          BtINOpr           = BtInsert
          BtINKey           = 0
          gosub BtINFile
          if BtSts <> 5 then
             gosub BtErrorChecking
          else
             incr WkDup
             locate 22,1: print "Dup count ="; WkDup
          end if
          print using "### ###"; WkPx; BtSts
          incr WkINCount&
          locate 12, 17: print using "##,###"; WkINCount&
      next
XMainLogic:
      return

BtINFile:
      WkBTID$ = "IN"
'     BtRetVal = btrv( BtINOpr, BtINKeyBuf$, BtINKey, BtINDataBuf$$, BtINPos$$, BtSts )
XBtINFile:
      return

BtOpenInFile:
      BtINRecLen        = 254: map BtINPos$$ * 128
      map BtINDataBuf$$ * BtINRecLen,_
                        from    1 to   4 as BtINRecordPosition$$,_
                        from    7 to  10 as BtINNOR$$,_
                        from    1 to   1 as BtINStatus$$,_
                        from    2 to  26 as BtINCrInfo$$,_
                        from    2 to   7 as   BtINCrDateYYMMDD$$,_
                        from    2 to   3 as     BtINCrDateYY$$,_
                        from    4 to   5 as     BtINCrDateMM$$,_
                        from    6 to   7 as     BtINCrDateDD$$,_
                        from    8 to  13 as   BtINCrTimeHHMMSS$$,_
                        from    8 to   9 as     BtINCrTimeHH$$,_
                        from   10 to  11 as     BtINCrTimeMM$$,_
                        from   12 to  13 as     BtINCrTimeSS$$,_
                        from   14 to  16 as   BtINCrUserID$$,_
                        from   17 to  18 as   BtINCrWorkStation$$,_
                        from   19 to  26 as   BtINCrProgram$$,_
                        from   27 to  27 as BtINChLastAction$$,_
                        from   28 to  52 as BtINChInfo$$,_
                        from   28 to  33 as   BtINChDateYYMMDD$$,_
                        from   28 to  29 as     BtINChDateYY$$,_
                        from   30 to  31 as     BtINChDateMM$$,_
                        from   32 to  33 as     BtINChDateDD$$,_
                        from   34 to  39 as   BtINChTimeHHMMSS$$,_
                        from   34 to  35 as     BtINChTimeHH$$,_
                        from   36 to  37 as     BtINChTimeMM$$,_
                        from   38 to  39 as     BtINChTimeSS$$,_
                        from   40 to  42 as   BtINChUserID$$,_
                        from   43 to  44 as   BtINChWorkStation$$,_
                        from   45 to  52 as   BtINChProgram$$,_
                        from   53 to  53 as BtINMiLastAction$$,_
                        from   54 to  78 as BtINMiInfo$$,_
                        from   54 to  59 as   BtINMiDateYYMMDD$$,_
                        from   54 to  55 as     BtINMiDateYY$$,_
                        from   56 to  57 as     BtINMiDateMM$$,_
                        from   58 to  59 as     BtINMiDateDD$$,_
                        from   60 to  65 as   BtINMiTimeHHMMSS$$,_
                        from   60 to  61 as     BtINMiTimeHH$$,_
                        from   62 to  63 as     BtINMiTimeMM$$,_
                        from   64 to  65 as     BtINMiTimeSS$$,_
                        from   66 to  68 as   BtINMiUserID$$,_
                        from   69 to  70 as   BtINMiWorkStation$$,_
                        from   71 to  78 as   BtINMiProgram$$,_
                        from   79 to 100 as BtINAuditReserved$$,_
                        from  101 to 103 as BtINNumber$$,_
                        from  104 to 138 as BtINDescription$$,_
                        from  139 to 173 as BtINCommentLine1$$,_
                        from  174 to 208 as BtINCommentLine2$$,_
                        from  209 to 209 as BtINComm$$,_
                        from  254 to 254 as BtINReserved$$

      BtINFileSpec$ = "mi-tins.btr"

      BtINKey       = 0
      BtINOpr       = BtOpen
      BtINPos$$     = string$( 128, 0)
      BtINDataBuf$$ = string$( BtINRecLen, 0)
      BtINKeyBuf$   = BtINFileSpec$ + chr$( 0 )
      gosub BtINFile
      gosub BtErrorChecking
      BtINKeyBuf$   = string$( 3, " " )

      WkInNOR&      = BtNOR&( BtINPos$$ )
XBtOpenInFile:
      return


BtPMFile:
      WkBTID$ = "PM"
'     BtRetVal = btrv( BtPMOpr, BtPMKeyBuf$, BtPMKey, BtPMDataBuf$$, BtPMPos$$, BtSts )
XBtPMFile:
      return

BtOpenPMFile:
      BtPMRecLen        = 996: map BtPMPos$$ * 128
      map BtPMDataBuf$$ * BtPMRecLen,_
                        from    1 to   4 as BtPMRecordPosition$$,_
                        from    7 to  10 as BtPMNOR$$,_
                        from    1 to   1 as BtPMStatus$$,_
                         from  34 to  35 as   BtPMCrWorkStation$$,_
                         from  36 to  47 as   BtPMCrProgram$$,_
                        from   48 to  48 as BtPMLastAction$$,_
                        from   49 to  94 as BtPMChInfo$$,_
                        from   49 to  54 as   BtPMChDateYYMMDD$$,_
                         from  49 to  50 as     BtPMChDateYY$$,_
                         from  51 to  52 as     BtPMChDateMM$$,_
                         from  53 to  54 as     BtPMChDateDD$$,_
                         from  55 to  60 as   BtPMChTimeHHMMSS$$,_
                         from  55 to  56 as     BtPMChTimeHH$$,_
                         from  57 to  58 as     BtPMChTimeMM$$,_
                         from  59 to  60 as     BtPMChTimeSS$$,_
                         from  61 to  80 as   BtPMChUserName$$,_
                         from  81 to  82 as   BtPMChWorkStation$$,_
                         from  83 to  94 as   BtPMChProgram$$,_
                        from   95 to 100 as BtPMReserved2$$,_
                        from  101 to 109 as BtPMKey0$$,_
                        from  101 to 109 as BtPMAccountNumber$$,_
                        from  101 to 103 as   BtPMDoctorNumber$$,_
                        from  104 to 108 as   BtPMChartNumber$$,_
                        from  109 to 109 as   BtPMCheckDigit$$,_
                        from  110 to 235 as BtPMPatInfo$$,_
                        from  110 to 141 as   BtPMKey1$$,_
                        from  110 to 129 as   BtPMPatLastName$$,_
                        from  130 to 141 as   BtPMPatFirstName$$,_
                        from  142 to 174 as   BtPMPatAddressLine1$$,_
                        from  175 to 207 as   BtPMPatAddressLine2$$,_
                        from  208 to 224 as   BtPMPatCity$$,_
                        from  225 to 226 as   BtPMPatState$$,_
                        from  227 to 231 as     BtPMPatZipCode$$,_
                        from  232 to 235 as     BtPMPatZipCodeExtended$$,_
                        from  236 to 245 as BtPMPatHomePhone$$,_
                        from  236 to 238 as   BtPmPatHomeAreaCode$$,_
                        from  239 to 241 as   BtPmPatHomeExchange$$,_
                        from  242 to 245 as   BtPmPatHomeNumber$$,_
                        from  246 to 248 as BtPMPatHomeExtension$$,_
                        from  249 to 258 as BtPMPatWorkPhone$$,_
                        from  249 to 251 as   BtPMPatWorkAreaCode$$,_
                        from  252 to 254 as   BtPMPatWorkExchange$$,_
                        from  255 to 258 as   BtPMPatWorkNumber$$,_
                        from  259 to 261 as BtPMPatWorkExtension$$,_
                        from  262 to 270 as BtPMPatSS$$,_
                        from  262 to 264 as   BtPMPatSS1$$,_
                        from  265 to 266 as   BtPMPatSS2$$,_
                        from  267 to 270 as   BtPMPatSS3$$,_
                        from  271 to 271 as BtPMSexCode$$,_
                        from  272 to 277 as BtPMBirthDate$$,_
                        from  272 to 273 as   BtPMBirthYY$$,_
                        from  274 to 277 as   BtPMBirthMMDD$$,_
                        from  274 to 275 as     BtPMBirthMM$$,_
                        from  276 to 277 as     BtPMBirthDD$$,_
                        from  278 to 283 as BtPMFirstConsultDate$$,_
                        from  278 to 279 as   BtPMFirstConsultYY$$,_
                        from  280 to 281 as   BtPMFirstConsultMM$$,_
                        from  282 to 283 as   BtPMFirstConsultDD$$,_
                        from  284 to 285 as BtPMBillingCode$$,_
                        from  286 to 287 as BtPMNoticeCode$$,_
                        from  288 to 288 as BtPMRelationshipCode$$,_
                        from  289 to 414 as BtPMRspInfo$$,_
                        from  289 to 320 as   BtPMKey2$$,_
                        from  289 to 308 as   BtPMRspLastName$$,_
                        from  309 to 320 as   BtPMRspFirstName$$,_
                        from  321 to 353 as   BtPMRspAddressLine1$$,_
                        from  354 to 386 as   BtPMRspAddressLine2$$,_
                        from  387 to 403 as   BtPMRspCity$$,_
                        from  387 to 400 as     BtPMRspCity14$$,_
                        from  404 to 405 as   BtPMRspState$$,_
                        from  406 to 410 as     BtPMRspZipCode$$,_
                        from  411 to 414 as     BtPMRspZipCodeExtended$$,_
                        from  415 to 424 as BtPMRspHomePhone$$,_
                        from  415 to 417 as   BtPMRspHomeAreaCode$$,_
                        from  418 to 420 as   BtPMRspHomeExchange$$,_
                        from  421 to 424 as   BtPMRspHomeNumber$$,_
                        from  425 to 427 as BtPMRspHomeExtension$$,_
                        from  428 to 437 as BtPMRspWorkPhone$$,_
                        from  428 to 430 as   BtPMRspWorkAreaCode$$,_
                        from  431 to 433 as   BtPMRspWorkExchange$$,_
                        from  434 to 437 as   BtPMRspWorkNumber$$,_
                        from  438 to 440 as BtPMRspWorkExtension$$,_
                        from  441 to 449 as BtPMRspSS$$,_
                        from  441 to 443 as   BtPMRspSS1$$,_
                        from  444 to 445 as   BtPMRspSS2$$,_
                        from  446 to 449 as   BtPMRspSS3$$,_
                        from  450 to 452 as BtPMInsCode1$$,_
                        from  453 to 487 as BtPMInsDesc1$$,_
                        from  488 to 490 as BtPMInsCode2$$,_
                        from  491 to 525 as BtPMInsDesc2$$,_
                        from  526 to 528 as BtPMInsCode3$$,_
                        from  529 to 563 as BtPMInsDesc3$$,_
                        from  564 to 596 as BtPMRefDoctorAddressLine1$$,_
                        from  597 to 629 as BtPMRefDoctorAddressLine2$$,_
                        from  630 to 662 as BtPMRefDoctorAddressLine3$$,_
                        from  838 to 906 as BtPMComment1$$,_
                        from  907 to 975 as BtPMComment2$$,_
                        from  976 to 983 as BtPMRefDoctorAlphaNumeric$$,_
                        from  976 to 977 as   BtPMRefDoctorAlpha$$,_
                        from  978 to 983 as   BtPMRefDoctorNumeric$$,_
                        from  984 to 993 as BtPMRefDoctorWorkPhone$$,_
                        from  984 to 986 as   BtPMRefDoctorWorkAreaCode$$,_
                        from  987 to 989 as   BtPMRefDoctorWorkExchange$$,_
                        from  990 to 993 as   BtPMRefDoctorWorkNumber$$,_
                        from  994 to 996 as BtPMReserved3$$

      BtPMFileSpec$ = "f:\mb-prod.dir\mb-mpat.btr"

      BtPMKey       = -2                       'Read only
      BtPMOpr       = BtOpen
      BtPMPos$$     = string$( 128, 0)
      BtPMDataBuf$$ = string$( BtPMRecLen, 0)
      BtPMKeyBuf$   = BtPMFileSpec$ + chr$( 0 )
      gosub BtPMFile
      gosub BtErrorChecking
      BtPMKeyBuf$   = string$( 32, " " )

      WkPMNOR&      = BtNOR&( BtPMPos$$ )
XBtOpenPMFile:
      return

BtErrorChecking:
      if BtSts = BtOperationOK then
         goto XBtErrorChecking
      end if

      locate 20, 1
      color 0, 7
      print " Btrieve error!  Sts = "; BtSts; "  File ID = "; WkBtID$; tab( 80 ); " ";

      beep
      while inkey$ <> chr$( 27 ): wend
      locate 3,1
      system
XBtErrorChecking:
      return

BtInitVariables:
      BtOpen                   = 0
      BtClose                  = 1
      BtInsert                 = 2
      BtUpdate                 = 3
      BtDelete                 = 4
      BtGetEqual               = 5
      BtGetNext                = 6
      BtGetPrev                = 7
      BtGetGreaterThan         = 8
      BtGetGreaterThanOrEqual  = 9
      BtGetLessThan            = 10
      BtGetLessThanOrEqual     = 11
      BtGetFirst               = 12
      BtGetLast                = 13
      BtCreate                 = 14
      BtStat                   = 15
      BtExtend                 = 16
      BtSetDirectory           = 17
      BtGetDirectory           = 18
      BtBeginTransaction       = 19
      BtEndTransaction         = 20
      BtAbortTransaction       = 21
      BtGetPosition            = 22
      BtGetDirect              = 23
      BtStepNext               = 24
      BtStop                   = 25
      BtGetVersion             = 26
      BtUnlock                 = 27
      BtReset                  = 28
      BtSetOwner               = 29
      BtClearOwner             = 30
      BtStepFirst              = 33
      BtStepLast               = 34
      BtStepPrevious           = 35

      BtOperationOK            = 0
      BtDuplicate              = 5
      BtRecordNotFound         = 4
      BtEndOfFile              = 9

      BtSts                    = 0

XBtInitVariables:
      return

BtResetAll:
      BtUtKeyBuf$ = ""
      BtUtDataBuf$$ = ""
      BtUtPos$$ = string$( 128, 0 ): map BtUtPos$$ * 128
'     BtRetVal = Btrv( BtReset, BtUtKeyBuf$, 0, BtUtDataBuf$$, BtUtPos$$, BtSts )
      gosub BtErrorChecking
XBtResetAll:
      return

InitIns:
      dim WkInsCode$( 0:32 ), WkInsDesc$( 0:32 )
      WkInsCode$(  0 ) = "???": WkInsDesc$(  0 ) = "Need a description for             "
      WkInsCode$(  1 ) = "100": WkInsDesc$(  1 ) = "No insurance                       "
      WkInsCode$(  2 ) = "112": WkInsDesc$(  2 ) = "Other insurance                    "
      WkInsCode$(  3 ) = "196": WkInsDesc$(  3 ) = "3rd Party                          "
      WkInsCode$(  4 ) = "197": WkInsDesc$(  4 ) = "NO Fault                           "
      WkInsCode$(  5 ) = "198": WkInsDesc$(  5 ) = "W/C                                "
      WkInsCode$(  6 ) = "300": WkInsDesc$(  6 ) = "Aetna                              "
      WkInsCode$(  7 ) = "310": WkInsDesc$(  7 ) = "EDS ( Electronic Data Systems )    "
      WkInsCode$(  8 ) = "315": WkInsDesc$(  8 ) = "American Community                 "
      WkInsCode$(  9 ) = "345": WkInsDesc$(  9 ) = "GM Underwriters                    "
      WkInsCode$( 10 ) = "380": WkInsDesc$( 10 ) = "MESSA                              "
      WkInsCode$( 11 ) = "385": WkInsDesc$( 11 ) = "Great West Life                    "
      WkInsCode$( 12 ) = "700": WkInsDesc$( 12 ) = "Health Central                     "
      WkInsCode$( 13 ) = "701": WkInsDesc$( 13 ) = "Health Central plus Medicare       "
      WkInsCode$( 14 ) = "702": WkInsDesc$( 14 ) = "Physicians Health Plan             "
      WkInsCode$( 15 ) = "703": WkInsDesc$( 15 ) = "Physicians Health Plan plus Medicare  "
      WkInsCode$( 16 ) = "704": WkInsDesc$( 16 ) = "Michigan Medical Network           "
      WkInsCode$( 17 ) = "710": WkInsDesc$( 17 ) = "PPOM                               "
      WkInsCode$( 18 ) = "720": WkInsDesc$( 18 ) = "Care Choices                       "
      WkInsCode$( 19 ) = "730": WkInsDesc$( 19 ) = "Partners                           "
      WkInsCode$( 20 ) = "740": WkInsDesc$( 20 ) = "Health Plus/IPA                    "
      WkInsCode$( 21 ) = "800": WkInsDesc$( 21 ) = "Wayne Oakland Medical Center       "
      WkInsCode$( 22 ) = "200": WkInsDesc$( 22 ) = "Blue Shield ( Mich )               "
      WkInsCode$( 23 ) = "201": WkInsDesc$( 23 ) = "Blue Shield ( Fed )                "
      WkInsCode$( 24 ) = "202": WkInsDesc$( 24 ) = "Blue Shield ( Nat )                "
      WkInsCode$( 25 ) = "203": WkInsDesc$( 25 ) = "Blue Shield ( Other States )       "
      WkInsCode$( 26 ) = "205": WkInsDesc$( 26 ) = "Champus                            "
      WkInsCode$( 27 ) = "280": WkInsDesc$( 27 ) = "Blue Cross - MESSA                 "
      WkInsCode$( 28 ) = "290": WkInsDesc$( 28 ) = "Blue Cross - Aetna                 "
      WkInsCode$( 29 ) = "600": WkInsDesc$( 29 ) = "Medicare                           "
      WkInsCode$( 30 ) = "601": WkInsDesc$( 30 ) = "Medicare/Travelers Railroad        "
      WkInsCode$( 31 ) = "666": WkInsDesc$( 31 ) = "Medicaid                           "
      WkInsCode$( 32 ) = "667": WkInsDesc$( 32 ) = "Crippled Childrens                 "
XInitIns:
      return

function BtNOR&( WkPos$$ ) public shared
      BtUtKeyBuf$ = space$( 64 )
      BtUtRecLen  = 512
      map BtUtDataBuf$$ * BtUtRecLen,_
                        from    1 to   2 as BtUtRecLen$$,_
                        from    3 to   4 as BtUtPageSize$$,_
                        from    5 to   6 as BtUtMaxKeys$$,_
                        from    7 to  10 as BtUtTotalRecords$$,_
                        from    7 to   7 as   BtUtTR1$$,_
                        from    8 to   8 as   BtUtTR2$$,_
                        from    9 to   9 as   BtUtTR3$$,_
                        from   10 to  10 as   BtUtTR4$$

'     BtRetVal = Btrv( BtStat, BtUtKeyBuf$, 0, BtUtDataBuf$$, WkPos$$, BtSts )
      gosub BtErrorChecking

      BtNOR& = asc( BtUtTR1$$ )          +_
               asc( BtUtTR2$$ ) *   256# +_
               asc( BtUtTR3$$ ) * 65536#

end function

function FmtAccountNumber$( WkString$$ ) local
      FmtAccountNumber$ = left$( WkString$$, 3 ) + "-" + mid$( WkString$$, 4, 5 ) + "-" + right$( WkString$$, 1 )
end function

Initialization:
      WkTrue = ( 1 = 1 ): WkFalse = not WkTrue
      gosub BtInitVariables
      gosub InitIns
XInitialization:
      return

Termination:
      close
      color 7,0
      cls
      gosub BtResetAll
XTermination:
      return

'     $alias DATA as "DSEG"
'     $link    "pbbtrv.obj"