- 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 Feb 18, 2025@23:27:33 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