IVMLINS1 ;ALB/KCL,TDM - IVM INSURANCE DISPLAY POLICY ; 12/23/08 3:44pm
;;2.0;INCOME VERIFICATION MATCH;**14,94,111,121**; 21-OCT-94;Build 45
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
DE ; - select patient for insurance information upload/purge
;
; Input: - ^TMP("IVMLST",$J,"IDX",CTR,CTR)=pat name_pat ssn_ivm ien_ivm sub ien
;
;
;
S IVMDONE=0
;
; - generic seletor used within a list manager action call
D EN^VALM2($G(XQORNOD(0)),"S")
Q:'$D(VALMY)
S IVMENT=0 F S IVMENT=$O(VALMY(IVMENT)) Q:'IVMENT D
.;
.; - get index for look-up
.S IVMIDX=$G(^TMP("IVMLST",$J,"IDX",IVMENT,IVMENT)) I IVMIDX']"" Q
.;
.; - change if HL7 segment sep ever changes!
.S HLFS="^",HLECH="~"
.;
.; - get patient name, ssn, da(1), da
.S IVMNAME=$P(IVMIDX,"^",1),IVMSSN=$P(IVMIDX,"^",2),IVMI=$P(IVMIDX,"^",3),IVMJ=$P(IVMIDX,"^",4)
.;
.; - get data node from list manager storage array
.S IVMDND=$G(^TMP("IVMIUPL",$J,IVMNAME,IVMI,IVMJ)),DFN=$P(IVMDND,"^",1)
.;
. S IVMIN1=$$GETIN1(IVMI,IVMJ)
.;
.; - alert user if date of death
.I $P(IVMDND,"^",6)]""!($P($G(^DPT(+DFN,.35)),"^")]"") D DOD^IVMLINS2
.;
.; - display all insurance currently on file in DHCP
.D CLEAR^VALM1,ALL
.; - display insurance information received from IVM IN1 segment
.D HDR,DISP1
.S DIR(0)="E",DIR("A")="Press RETURN to continue or '^' to return to display screen" D ^DIR K DIR Q:'Y
.;
.; - ask user to add or purge
.D ASK^IVMLINS2
;
DEQ ; - clean up variables
D IVMQ
Q
;
;
GETIN1(IVMI,IVMJ) ; get IN1 segment from (#301.5) file containing ins data
S IVMIN1=$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST"))
; - set if IN1 segment exceeds 245 chars
S:$D(^IVM(301.5,IVMI,"IN",IVMJ,"ST1")) IVMIN1=IVMIN1_(^("ST1"))
;
Q IVMIN1
;
ALL ; - display all insurance company information for patient in DHCP
;
W !,?22,"INSURANCE POLICIES CURRENTLY ON FILE"
; - write dashed line
W !,?7,$TR($J("",66)," ","*")
;
; - IB call to display all DHCP ins co. information
D DISP^DGIBDSP
W !
Q
;
;
HDR ; - header for insurance data received from HEC
W !,?23,"INSURANCE POLICY RECEIVED FROM HEC"
; - write dashed line
W !,?7,$TR($J("",66)," ","*")
Q
;
;
DISP1 ; - display insurance fields from IN1 segment
;
; - ins effec and exp dates in FM format
S IVMEFF=$$FMDATE^HLFNC($P(IVMIN1,HLFS,12)),IVMEXP=$$FMDATE^HLFNC($P(IVMIN1,HLFS,13))
;
S IVMADD=$P(IVMIN1,"^",5)
S IVMPLAN=$P(IVMIN1,HLFS,15),IVMPLAN=$P($G(^IBE(355.1,+IVMPLAN,0)),"^")
;
; - display insurance policy fields from IVM
W !,?2,"Company: ",?9,$E($P(IVMIN1,HLFS,4),1,32),?45,"Effective Date: ",?62,$$DAT2^IVMUFNC4(IVMEFF)
W !,?2,"Phone #: ",?9,$E($P(IVMIN1,HLFS,7),1,25),?45,"Expiration Date: ",?62,$$DAT2^IVMUFNC4(IVMEXP)
W !,?2,"Address: ",?45,"Subscriber ID: " W:$P(IVMIN1,HLFS,36)]"" ?59,$E($P(IVMIN1,HLFS,36),1,20) W !
W:$P(IVMADD,HLECH,1)]"" ?4,$E($P(IVMADD,HLECH,1),1,35) W ?45,"Policy Holder: " W:$P(IVMIN1,HLFS,17)]"" ?59,$S($P(IVMIN1,HLFS,17)="v":"SELF",$P(IVMIN1,HLFS,17)="s":"SPOUSE",1:"OTHER")
W:$P(IVMADD,HLECH,1)']"" !
W:$P(IVMADD,HLECH,2)]"" !,?4,$E($P(IVMADD,HLECH,2),1,35)
W:$P(IVMADD,HLECH,8)]"" !,?4,$E($P(IVMADD,HLECH,8),1,35) ; address line 3
W:$P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")!($P(IVMADD,HLECH,5)]"") !,?4,$P(IVMADD,HLECH,3) W:$P(IVMADD,HLECH,3)]""&($P(IVMADD,HLECH,4)]"") ", ",$E($P(IVMADD,HLECH,4),1,2)
W:$P(IVMADD,HLECH,5)]""&($P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")) " "
W $P(IVMADD,HLECH,5)
I $P(IVMADD,HLECH,2)']"" D
.W !,?45,"Group Name: " W:$P(IVMIN1,HLFS,9)]"" ?59,$E($P(IVMIN1,HLFS,9),1,20)
W:$P(IVMADD,HLECH,2)]"" ?45,"Group Name: " W:$P(IVMADD,HLECH,2)]""&($P(IVMIN1,HLFS,9)]"") ?59,$E($P(IVMIN1,HLFS,9),1,20)
W !,?45,"Group Number: " W:$P(IVMIN1,HLFS,8)]"" ?59,$E($P(IVMIN1,HLFS,8),1,20)
W !,?2,"Name of Insured: " W:$P(IVMIN1,HLFS,16)]"" ?9,$E($$FMNAME^HLFNC($P(IVMIN1,HLFS,16)),1,23) W:$P(IVMIN1,HLFS,16)']"" ?9,$E(IVMNAME,1,23)
W ?45,"Pre-Cert. Req?: " W:$P(IVMIN1,HLFS,28)]"" ?60,$S($P(IVMIN1,HLFS,28)=1:"YES",$P(IVMIN1,HLFS,28)=0:"NO",1:"")
I $P(IVMIN1,HLFS,16)]"" S $P(IVMIN1,HLFS,16)=$$FMNAME^HLFNC($P(IVMIN1,HLFS,16))
W !,?45,"Plan Type: ",?55,$E(IVMPLAN,1,23) W !
Q
;
;
DISP2 ; - display ins co. name and address
W !,?4,"Insurance Company: ",$E($P(IVMIN1,HLFS,4),1,45),!
W !,?4,"Company Address: " W:$P(IVMADD,HLECH,1)]"" ?23,$E($P(IVMADD,HLECH,1),1,35) ; address line1
W:$P(IVMADD,HLECH,2)]"" !?23,$E($P(IVMADD,HLECH,2),1,35) ; address line2
W:$P(IVMADD,HLECH,8)]"" !,23,$E($P(IVMADD,HLECH,2),1,35) ; address line3
W:$P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")!($P(IVMADD,HLECH,5)]"") !?23
W $P(IVMADD,HLECH,3) W:$P(IVMADD,HLECH,3)]""&($P(IVMADD,HLECH,4)]"") ", " ; city
W $E($P(IVMADD,HLECH,4),1,2) ; state
W:$P(IVMADD,HLECH,5)]""&($P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")) " "
W $P(IVMADD,HLECH,5) ; zip
Q
;
;
IVMQ ; - kill variables used from all protocols
;
; - if action completed reset List Man array for display
I $D(^TMP("IVMLST",$J)) D ; Only if list manager array exists
. I IVMDONE D INIT^IVMLINS
. ;
. S VALMBCK="R"
K DA,DFN,IVM0NOD,IVMADD,IVMDND,IVMDONE,IVMEFF,IVMENT,IVMEXP
K IVMI,IVMIDX,IVMIN1,IVMJ,IVMNAME,IVMPLAN,IVMSSN,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLINS1 5265 printed Oct 16, 2024@18:02:41 Page 2
IVMLINS1 ;ALB/KCL,TDM - IVM INSURANCE DISPLAY POLICY ; 12/23/08 3:44pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**14,94,111,121**; 21-OCT-94;Build 45
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
DE ; - select patient for insurance information upload/purge
+1 ;
+2 ; Input: - ^TMP("IVMLST",$J,"IDX",CTR,CTR)=pat name_pat ssn_ivm ien_ivm sub ien
+3 ;
+4 ;
+5 ;
+6 SET IVMDONE=0
+7 ;
+8 ; - generic seletor used within a list manager action call
+9 DO EN^VALM2($GET(XQORNOD(0)),"S")
+10 if '$DATA(VALMY)
QUIT
+11 SET IVMENT=0
FOR
SET IVMENT=$ORDER(VALMY(IVMENT))
if 'IVMENT
QUIT
Begin DoDot:1
+12 ;
+13 ; - get index for look-up
+14 SET IVMIDX=$GET(^TMP("IVMLST",$JOB,"IDX",IVMENT,IVMENT))
IF IVMIDX']""
QUIT
+15 ;
+16 ; - change if HL7 segment sep ever changes!
+17 SET HLFS="^"
SET HLECH="~"
+18 ;
+19 ; - get patient name, ssn, da(1), da
+20 SET IVMNAME=$PIECE(IVMIDX,"^",1)
SET IVMSSN=$PIECE(IVMIDX,"^",2)
SET IVMI=$PIECE(IVMIDX,"^",3)
SET IVMJ=$PIECE(IVMIDX,"^",4)
+21 ;
+22 ; - get data node from list manager storage array
+23 SET IVMDND=$GET(^TMP("IVMIUPL",$JOB,IVMNAME,IVMI,IVMJ))
SET DFN=$PIECE(IVMDND,"^",1)
+24 ;
+25 SET IVMIN1=$$GETIN1(IVMI,IVMJ)
+26 ;
+27 ; - alert user if date of death
+28 IF $PIECE(IVMDND,"^",6)]""!($PIECE($GET(^DPT(+DFN,.35)),"^")]"")
DO DOD^IVMLINS2
+29 ;
+30 ; - display all insurance currently on file in DHCP
+31 DO CLEAR^VALM1
DO ALL
+32 ; - display insurance information received from IVM IN1 segment
+33 DO HDR
DO DISP1
+34 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue or '^' to return to display screen"
DO ^DIR
KILL DIR
if 'Y
QUIT
+35 ;
+36 ; - ask user to add or purge
+37 DO ASK^IVMLINS2
End DoDot:1
+38 ;
DEQ ; - clean up variables
+1 DO IVMQ
+2 QUIT
+3 ;
+4 ;
GETIN1(IVMI,IVMJ) ; get IN1 segment from (#301.5) file containing ins data
+1 SET IVMIN1=$GET(^IVM(301.5,IVMI,"IN",IVMJ,"ST"))
+2 ; - set if IN1 segment exceeds 245 chars
+3 if $DATA(^IVM(301.5,IVMI,"IN",IVMJ,"ST1"))
SET IVMIN1=IVMIN1_(^("ST1"))
+4 ;
+5 QUIT IVMIN1
+6 ;
ALL ; - display all insurance company information for patient in DHCP
+1 ;
+2 WRITE !,?22,"INSURANCE POLICIES CURRENTLY ON FILE"
+3 ; - write dashed line
+4 WRITE !,?7,$TRANSLATE($JUSTIFY("",66)," ","*")
+5 ;
+6 ; - IB call to display all DHCP ins co. information
+7 DO DISP^DGIBDSP
+8 WRITE !
+9 QUIT
+10 ;
+11 ;
HDR ; - header for insurance data received from HEC
+1 WRITE !,?23,"INSURANCE POLICY RECEIVED FROM HEC"
+2 ; - write dashed line
+3 WRITE !,?7,$TRANSLATE($JUSTIFY("",66)," ","*")
+4 QUIT
+5 ;
+6 ;
DISP1 ; - display insurance fields from IN1 segment
+1 ;
+2 ; - ins effec and exp dates in FM format
+3 SET IVMEFF=$$FMDATE^HLFNC($PIECE(IVMIN1,HLFS,12))
SET IVMEXP=$$FMDATE^HLFNC($PIECE(IVMIN1,HLFS,13))
+4 ;
+5 SET IVMADD=$PIECE(IVMIN1,"^",5)
+6 SET IVMPLAN=$PIECE(IVMIN1,HLFS,15)
SET IVMPLAN=$PIECE($GET(^IBE(355.1,+IVMPLAN,0)),"^")
+7 ;
+8 ; - display insurance policy fields from IVM
+9 WRITE !,?2,"Company: ",?9,$EXTRACT($PIECE(IVMIN1,HLFS,4),1,32),?45,"Effective Date: ",?62,$$DAT2^IVMUFNC4(IVMEFF)
+10 WRITE !,?2,"Phone #: ",?9,$EXTRACT($PIECE(IVMIN1,HLFS,7),1,25),?45,"Expiration Date: ",?62,$$DAT2^IVMUFNC4(IVMEXP)
+11 WRITE !,?2,"Address: ",?45,"Subscriber ID: "
if $PIECE(IVMIN1,HLFS,36)]""
WRITE ?59,$EXTRACT($PIECE(IVMIN1,HLFS,36),1,20)
WRITE !
+12 if $PIECE(IVMADD,HLECH,1)]""
WRITE ?4,$EXTRACT($PIECE(IVMADD,HLECH,1),1,35)
WRITE ?45,"Policy Holder: "
if $PIECE(IVMIN1,HLFS,17)]""
WRITE ?59,$SELECT($PIECE(IVMIN1,HLFS,17)="v":"SELF",$PIECE(IVMIN1,HLFS,17)="s":"SPOUSE",1:"OTHER")
+13 if $PIECE(IVMADD,HLECH,1)']""
WRITE !
+14 if $PIECE(IVMADD,HLECH,2)]""
WRITE !,?4,$EXTRACT($PIECE(IVMADD,HLECH,2),1,35)
+15 ; address line 3
if $PIECE(IVMADD,HLECH,8)]""
WRITE !,?4,$EXTRACT($PIECE(IVMADD,HLECH,8),1,35)
+16 if $PIECE(IVMADD,HLECH,3)]""!($PIECE(IVMADD,HLECH,4)]"")!($PIECE(IVMADD,HLECH,5)]"")
WRITE !,?4,$PIECE(IVMADD,HLECH,3)
if $PIECE(IVMADD,HLECH,3)]""&($PIECE(IVMADD,HLECH,4)]"")
WRITE ", ",$EXTRACT($PIECE(IVMADD,HLECH,4),1,2)
+17 if $PIECE(IVMADD,HLECH,5)]""&($PIECE(IVMADD,HLECH,3)]""!($PIECE(IVMADD,HLECH,4)]""))
WRITE " "
+18 WRITE $PIECE(IVMADD,HLECH,5)
+19 IF $PIECE(IVMADD,HLECH,2)']""
Begin DoDot:1
+20 WRITE !,?45,"Group Name: "
if $PIECE(IVMIN1,HLFS,9)]""
WRITE ?59,$EXTRACT($PIECE(IVMIN1,HLFS,9),1,20)
End DoDot:1
+21 if $PIECE(IVMADD,HLECH,2)]""
WRITE ?45,"Group Name: "
if $PIECE(IVMADD,HLECH,2)]""&($PIECE(IVMIN1,HLFS,9)]"")
WRITE ?59,$EXTRACT($PIECE(IVMIN1,HLFS,9),1,20)
+22 WRITE !,?45,"Group Number: "
if $PIECE(IVMIN1,HLFS,8)]""
WRITE ?59,$EXTRACT($PIECE(IVMIN1,HLFS,8),1,20)
+23 WRITE !,?2,"Name of Insured: "
if $PIECE(IVMIN1,HLFS,16)]""
WRITE ?9,$EXTRACT($$FMNAME^HLFNC($PIECE(IVMIN1,HLFS,16)),1,23)
if $PIECE(IVMIN1,HLFS,16)']""
WRITE ?9,$EXTRACT(IVMNAME,1,23)
+24 WRITE ?45,"Pre-Cert. Req?: "
if $PIECE(IVMIN1,HLFS,28)]""
WRITE ?60,$SELECT($PIECE(IVMIN1,HLFS,28)=1:"YES",$PIECE(IVMIN1,HLFS,28)=0:"NO",1:"")
+25 IF $PIECE(IVMIN1,HLFS,16)]""
SET $PIECE(IVMIN1,HLFS,16)=$$FMNAME^HLFNC($PIECE(IVMIN1,HLFS,16))
+26 WRITE !,?45,"Plan Type: ",?55,$EXTRACT(IVMPLAN,1,23)
WRITE !
+27 QUIT
+28 ;
+29 ;
DISP2 ; - display ins co. name and address
+1 WRITE !,?4,"Insurance Company: ",$EXTRACT($PIECE(IVMIN1,HLFS,4),1,45),!
+2 ; address line1
WRITE !,?4,"Company Address: "
if $PIECE(IVMADD,HLECH,1)]""
WRITE ?23,$EXTRACT($PIECE(IVMADD,HLECH,1),1,35)
+3 ; address line2
if $PIECE(IVMADD,HLECH,2)]""
WRITE !?23,$EXTRACT($PIECE(IVMADD,HLECH,2),1,35)
+4 ; address line3
if $PIECE(IVMADD,HLECH,8)]""
WRITE !,23,$EXTRACT($PIECE(IVMADD,HLECH,2),1,35)
+5 if $PIECE(IVMADD,HLECH,3)]""!($PIECE(IVMADD,HLECH,4)]"")!($PIECE(IVMADD,HLECH,5)]"")
WRITE !?23
+6 ; city
WRITE $PIECE(IVMADD,HLECH,3)
if $PIECE(IVMADD,HLECH,3)]""&($PIECE(IVMADD,HLECH,4)]"")
WRITE ", "
+7 ; state
WRITE $EXTRACT($PIECE(IVMADD,HLECH,4),1,2)
+8 if $PIECE(IVMADD,HLECH,5)]""&($PIECE(IVMADD,HLECH,3)]""!($PIECE(IVMADD,HLECH,4)]""))
WRITE " "
+9 ; zip
WRITE $PIECE(IVMADD,HLECH,5)
+10 QUIT
+11 ;
+12 ;
IVMQ ; - kill variables used from all protocols
+1 ;
+2 ; - if action completed reset List Man array for display
+3 ; Only if list manager array exists
IF $DATA(^TMP("IVMLST",$JOB))
Begin DoDot:1
+4 IF IVMDONE
DO INIT^IVMLINS
+5 ;
+6 SET VALMBCK="R"
End DoDot:1
+7 KILL DA,DFN,IVM0NOD,IVMADD,IVMDND,IVMDONE,IVMEFF,IVMENT,IVMEXP
+8 KILL IVMI,IVMIDX,IVMIN1,IVMJ,IVMNAME,IVMPLAN,IVMSSN,Y
+9 QUIT
