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
