- IBCNSM ;ALB/AAS - INSURANCE MANAGEMENT, LIST MANAGER INIT ROUTINE ; 21-OCT-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % ; -- main entry point
- EN ;
- D DT^DICRW
- K XQORS,VALMEVL
- D EN^VALM("IBCNS INSURANCE MANAGEMENT")
- ENQ K DFN
- Q
- ;
- ;
- INIT ; -- set up inital variables
- S U="^",VALMCNT=0,VALMBG=1
- K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
- ;K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ
- S DIR(0)="350.9,4.02",DIR("A")="Select Patient Name or Insurance Co."
- D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G INITQ
- S IBY=Y
- I IBY["DPT(" S IBTYP="P",DFN=+IBY D BLD
- I IBY["DIC(" S IBTYP="I",IBCNS=+IBY D EN^VALM("IBCNS INSURANCE COMPANY") S VALMQUIT=""
- ;
- INITQ Q
- ;
- ;
- PAT ; -- select patient you are working with
- S DIC(0)="AEQMN",DIC="^DPT(" D ^DIC I +Y<1 S VALMQUIT="" Q
- S DFN=+Y
- Q
- ;
- ;
- BLD ; -- build list of bills
- K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
- N I,J,K,IBHOLD,IBGRP,IBINS,IBCNT,IBCDFND,IBCPOLD
- S (IBN,IBCNT,VALMCNT)=0,IBFILE=2
- ;
- ; -- find all ins. co data
- K IBINS S IBINS=0
- D ALL^IBCNS1(DFN,"IBINS")
- I $G(IBINS(0)) S K=0 F S K=$O(IBINS(K)) Q:'K D
- .; -- add to list
- .W "."
- .S IBCNT=IBCNT+1
- .S IBCDFND=$G(IBINS(K,0))
- .S IBCDFND1=$G(IBINS(K,1))
- .S IBCPOLD=$G(^IBA(355.3,+$P($G(IBINS(K,0)),"^",18),0))
- .S X=""
- .S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
- .I $D(^DIC(36,+IBCDFND,0)) S X=$$SETFLD^VALM1($P(^(0),"^"),X,"NAME")
- .S X=$$SETFLD^VALM1($E($P(IBCDFND,"^",2),1,14),X,"POLICY")
- .S IBHOLD=$P(IBCDFND,"^",6),X=$$SETFLD^VALM1($S(IBHOLD="v":"SELF",IBHOLD="s":"SPOUSE",IBHOLD="o":"OTHER",1:"UNKNOWN"),X,"HOLDER")
- .S X=$$SETFLD^VALM1($E($$GRP^IBCNS($P(IBCDFND,"^",18)),1,10),X,"GROUP")
- .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",8)),X,"EFFDT")
- .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",4)),X,"EXPIRE")
- .S X=$$SETFLD^VALM1($E($P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),U),1,8),X,"TYPE")
- .S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.1,.03,$P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBCDFND,"^",18),0)),"^",9),0)),"^",3)),X,"TYPEPOL")
- .S X=$$SETFLD^VALM1($E($P($G(^VA(200,+$P(IBCDFND1,"^",4),0)),U),1,15),X,"VERIFIED BY")
- .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND1,"^",3)),X,"VERIFIED ON")
- .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",6)),X,"PRECERT")
- .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",5)),X,"UR")
- .S X=$$SETFLD^VALM1($$YN($P(IBCDFND,"^",20)),X,"COB")
- .K IBHOLD,IBGRP
- .D SET(X)
- BLDQ ;
- Q
- ;
- SET(X) ; -- set arrays
- S VALMCNT=VALMCNT+1,^TMP("IBNSM",$J,VALMCNT,0)=X
- S ^TMP("IBNSM",$J,"IDX",VALMCNT,IBCNT)=""
- S ^TMP("IBNSMDX",$J,IBCNT)=VALMCNT_"^"_IBFILE_"^"_DFN_"^"_K_"^"_IBCDFND
- Q
- ;
- HDR ; -- screen header for initial screen
- D PID^VADPT
- S VALMHDR(1)="Insurance Management for Patient: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
- S VALMHDR(2)=" "
- Q
- ;
- FNL ; -- exit and clean up
- K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
- K IBFASTXT
- D CLEAN^VALM10
- Q
- ;
- YN(X,Y) ; -- convert 1 or 0 to yes/no/unknown
- Q $S($G(X)="":$S($G(Y):"",1:"UNK"),X=0:"NO",X=1:"YES",1:"")
- ;
- CP ; -- change patient
- N VALMQUIT
- D FULL^VALM1
- S IBDFN=DFN D PAT
- I $D(VALMQUIT) S DFN=IBDFN
- D HDR,BLD
- S VALMBCK="R"
- CPQ K IBDFN
- Q
- ;
- PCI S VALMBCK="R" Q
- ;
- FASTEXIT ;just sets a flag signaling system should be exited
- S VALMBCK="Q"
- D FULL^VALM1
- K DIR S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
- I $D(DIRUT)!(Y) S IBFASTXT=1
- K DIR
- Q
- IBCNSM ;ALB/AAS - INSURANCE MANAGEMENT, LIST MANAGER INIT ROUTINE ; 21-OCT-92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % ; -- main entry point
- EN ;
- +1 DO DT^DICRW
- +2 KILL XQORS,VALMEVL
- +3 DO EN^VALM("IBCNS INSURANCE MANAGEMENT")
- ENQ KILL DFN
- +1 QUIT
- +2 ;
- +3 ;
- INIT ; -- set up inital variables
- +1 SET U="^"
- SET VALMCNT=0
- SET VALMBG=1
- +2 KILL ^TMP("IBNSM",$JOB),^TMP("IBNSMDX",$JOB)
- +3 ;K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ
- +4 SET DIR(0)="350.9,4.02"
- SET DIR("A")="Select Patient Name or Insurance Co."
- +5 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET VALMQUIT=""
- GOTO INITQ
- +6 SET IBY=Y
- +7 IF IBY["DPT("
- SET IBTYP="P"
- SET DFN=+IBY
- DO BLD
- +8 IF IBY["DIC("
- SET IBTYP="I"
- SET IBCNS=+IBY
- DO EN^VALM("IBCNS INSURANCE COMPANY")
- SET VALMQUIT=""
- +9 ;
- INITQ QUIT
- +1 ;
- +2 ;
- PAT ; -- select patient you are working with
- +1 SET DIC(0)="AEQMN"
- SET DIC="^DPT("
- DO ^DIC
- IF +Y<1
- SET VALMQUIT=""
- QUIT
- +2 SET DFN=+Y
- +3 QUIT
- +4 ;
- +5 ;
- BLD ; -- build list of bills
- +1 KILL ^TMP("IBNSM",$JOB),^TMP("IBNSMDX",$JOB)
- +2 NEW I,J,K,IBHOLD,IBGRP,IBINS,IBCNT,IBCDFND,IBCPOLD
- +3 SET (IBN,IBCNT,VALMCNT)=0
- SET IBFILE=2
- +4 ;
- +5 ; -- find all ins. co data
- +6 KILL IBINS
- SET IBINS=0
- +7 DO ALL^IBCNS1(DFN,"IBINS")
- +8 IF $GET(IBINS(0))
- SET K=0
- FOR
- SET K=$ORDER(IBINS(K))
- IF 'K
- QUIT
- Begin DoDot:1
- +9 ; -- add to list
- +10 WRITE "."
- +11 SET IBCNT=IBCNT+1
- +12 SET IBCDFND=$GET(IBINS(K,0))
- +13 SET IBCDFND1=$GET(IBINS(K,1))
- +14 SET IBCPOLD=$GET(^IBA(355.3,+$PIECE($GET(IBINS(K,0)),"^",18),0))
- +15 SET X=""
- +16 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
- +17 IF $DATA(^DIC(36,+IBCDFND,0))
- SET X=$$SETFLD^VALM1($PIECE(^(0),"^"),X,"NAME")
- +18 SET X=$$SETFLD^VALM1($EXTRACT($PIECE(IBCDFND,"^",2),1,14),X,"POLICY")
- +19 SET IBHOLD=$PIECE(IBCDFND,"^",6)
- SET X=$$SETFLD^VALM1($SELECT(IBHOLD="v":"SELF",IBHOLD="s":"SPOUSE",IBHOLD="o":"OTHER",1:"UNKNOWN"),X,"HOLDER")
- +20 SET X=$$SETFLD^VALM1($EXTRACT($$GRP^IBCNS($PIECE(IBCDFND,"^",18)),1,10),X,"GROUP")
- +21 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBCDFND,"^",8)),X,"EFFDT")
- +22 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBCDFND,"^",4)),X,"EXPIRE")
- +23 SET X=$$SETFLD^VALM1($EXTRACT($PIECE($GET(^IBE(355.1,+$PIECE(IBCPOLD,"^",9),0)),U),1,8),X,"TYPE")
- +24 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.1,.03,$PIECE($GET(^IBE(355.1,+$PIECE($GET(^IBA(355.3,+$PIECE(IBCDFND,"^",18),0)),"^",9),0)),"^",3)),X,"TYPEPOL")
- +25 SET X=$$SETFLD^VALM1($EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCDFND1,"^",4),0)),U),1,15),X,"VERIFIED BY")
- +26 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBCDFND1,"^",3)),X,"VERIFIED ON")
- +27 SET X=$$SETFLD^VALM1($$YN($PIECE(IBCPOLD,"^",6)),X,"PRECERT")
- +28 SET X=$$SETFLD^VALM1($$YN($PIECE(IBCPOLD,"^",5)),X,"UR")
- +29 SET X=$$SETFLD^VALM1($$YN($PIECE(IBCDFND,"^",20)),X,"COB")
- +30 KILL IBHOLD,IBGRP
- +31 DO SET(X)
- End DoDot:1
- BLDQ ;
- +1 QUIT
- +2 ;
- SET(X) ; -- set arrays
- +1 SET VALMCNT=VALMCNT+1
- SET ^TMP("IBNSM",$JOB,VALMCNT,0)=X
- +2 SET ^TMP("IBNSM",$JOB,"IDX",VALMCNT,IBCNT)=""
- +3 SET ^TMP("IBNSMDX",$JOB,IBCNT)=VALMCNT_"^"_IBFILE_"^"_DFN_"^"_K_"^"_IBCDFND
- +4 QUIT
- +5 ;
- HDR ; -- screen header for initial screen
- +1 DO PID^VADPT
- +2 SET VALMHDR(1)="Insurance Management for Patient: "_$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,20)_" "_$EXTRACT($GET(^(0)),1)_VA("BID")
- +3 SET VALMHDR(2)=" "
- +4 QUIT
- +5 ;
- FNL ; -- exit and clean up
- +1 KILL ^TMP("IBNSM",$JOB),^TMP("IBNSMDX",$JOB)
- +2 KILL IBFASTXT
- +3 DO CLEAN^VALM10
- +4 QUIT
- +5 ;
- YN(X,Y) ; -- convert 1 or 0 to yes/no/unknown
- +1 QUIT $SELECT($GET(X)="":$SELECT($GET(Y):"",1:"UNK"),X=0:"NO",X=1:"YES",1:"")
- +2 ;
- CP ; -- change patient
- +1 NEW VALMQUIT
- +2 DO FULL^VALM1
- +3 SET IBDFN=DFN
- DO PAT
- +4 IF $DATA(VALMQUIT)
- SET DFN=IBDFN
- +5 DO HDR
- DO BLD
- +6 SET VALMBCK="R"
- CPQ KILL IBDFN
- +1 QUIT
- +2 ;
- PCI SET VALMBCK="R"
- QUIT
- +1 ;
- FASTEXIT ;just sets a flag signaling system should be exited
- +1 SET VALMBCK="Q"
- +2 DO FULL^VALM1
- +3 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Exit option entirely"
- SET DIR("B")="NO"
- DO ^DIR
- +4 IF $DATA(DIRUT)!(Y)
- SET IBFASTXT=1
- +5 KILL DIR
- +6 QUIT
