home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PROG_BAS
/
EXTPROB.ZIP
/
EXTPROB.BAS
next >
Wrap
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"