Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMLINS1

IVMLINS1.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. DE ; - select patient for insurance information upload/purge
  1. ;
  1. ; Input: - ^TMP("IVMLST",$J,"IDX",CTR,CTR)=pat name_pat ssn_ivm ien_ivm sub ien
  1. ;
  1. ;
  1. ;
  1. S IVMDONE=0
  1. ;
  1. ; - generic seletor used within a list manager action call
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. Q:'$D(VALMY)
  1. S IVMENT=0 F S IVMENT=$O(VALMY(IVMENT)) Q:'IVMENT D
  1. .;
  1. .; - get index for look-up
  1. .S IVMIDX=$G(^TMP("IVMLST",$J,"IDX",IVMENT,IVMENT)) I IVMIDX']"" Q
  1. .;
  1. .; - change if HL7 segment sep ever changes!
  1. .S HLFS="^",HLECH="~"
  1. .;
  1. .; - get patient name, ssn, da(1), da
  1. .S IVMNAME=$P(IVMIDX,"^",1),IVMSSN=$P(IVMIDX,"^",2),IVMI=$P(IVMIDX,"^",3),IVMJ=$P(IVMIDX,"^",4)
  1. .;
  1. .; - get data node from list manager storage array
  1. .S IVMDND=$G(^TMP("IVMIUPL",$J,IVMNAME,IVMI,IVMJ)),DFN=$P(IVMDND,"^",1)
  1. .;
  1. . S IVMIN1=$$GETIN1(IVMI,IVMJ)
  1. .;
  1. .; - alert user if date of death
  1. .I $P(IVMDND,"^",6)]""!($P($G(^DPT(+DFN,.35)),"^")]"") D DOD^IVMLINS2
  1. .;
  1. .; - display all insurance currently on file in DHCP
  1. .D CLEAR^VALM1,ALL
  1. .; - display insurance information received from IVM IN1 segment
  1. .D HDR,DISP1
  1. .S DIR(0)="E",DIR("A")="Press RETURN to continue or '^' to return to display screen" D ^DIR K DIR Q:'Y
  1. .;
  1. .; - ask user to add or purge
  1. .D ASK^IVMLINS2
  1. ;
  1. DEQ ; - clean up variables
  1. D IVMQ
  1. Q
  1. ;
  1. ;
  1. GETIN1(IVMI,IVMJ) ; get IN1 segment from (#301.5) file containing ins data
  1. S IVMIN1=$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST"))
  1. ; - set if IN1 segment exceeds 245 chars
  1. S:$D(^IVM(301.5,IVMI,"IN",IVMJ,"ST1")) IVMIN1=IVMIN1_(^("ST1"))
  1. ;
  1. Q IVMIN1
  1. ;
  1. ALL ; - display all insurance company information for patient in DHCP
  1. ;
  1. W !,?22,"INSURANCE POLICIES CURRENTLY ON FILE"
  1. ; - write dashed line
  1. W !,?7,$TR($J("",66)," ","*")
  1. ;
  1. ; - IB call to display all DHCP ins co. information
  1. D DISP^DGIBDSP
  1. W !
  1. Q
  1. ;
  1. ;
  1. HDR ; - header for insurance data received from HEC
  1. W !,?23,"INSURANCE POLICY RECEIVED FROM HEC"
  1. ; - write dashed line
  1. W !,?7,$TR($J("",66)," ","*")
  1. Q
  1. ;
  1. ;
  1. DISP1 ; - display insurance fields from IN1 segment
  1. ;
  1. ; - ins effec and exp dates in FM format
  1. S IVMEFF=$$FMDATE^HLFNC($P(IVMIN1,HLFS,12)),IVMEXP=$$FMDATE^HLFNC($P(IVMIN1,HLFS,13))
  1. ;
  1. S IVMADD=$P(IVMIN1,"^",5)
  1. S IVMPLAN=$P(IVMIN1,HLFS,15),IVMPLAN=$P($G(^IBE(355.1,+IVMPLAN,0)),"^")
  1. ;
  1. ; - display insurance policy fields from IVM
  1. W !,?2,"Company: ",?9,$E($P(IVMIN1,HLFS,4),1,32),?45,"Effective Date: ",?62,$$DAT2^IVMUFNC4(IVMEFF)
  1. W !,?2,"Phone #: ",?9,$E($P(IVMIN1,HLFS,7),1,25),?45,"Expiration Date: ",?62,$$DAT2^IVMUFNC4(IVMEXP)
  1. W !,?2,"Address: ",?45,"Subscriber ID: " W:$P(IVMIN1,HLFS,36)]"" ?59,$E($P(IVMIN1,HLFS,36),1,20) W !
  1. 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")
  1. W:$P(IVMADD,HLECH,1)']"" !
  1. W:$P(IVMADD,HLECH,2)]"" !,?4,$E($P(IVMADD,HLECH,2),1,35)
  1. W:$P(IVMADD,HLECH,8)]"" !,?4,$E($P(IVMADD,HLECH,8),1,35) ; address line 3
  1. 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)
  1. W:$P(IVMADD,HLECH,5)]""&($P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")) " "
  1. W $P(IVMADD,HLECH,5)
  1. I $P(IVMADD,HLECH,2)']"" D
  1. .W !,?45,"Group Name: " W:$P(IVMIN1,HLFS,9)]"" ?59,$E($P(IVMIN1,HLFS,9),1,20)
  1. 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)
  1. W !,?45,"Group Number: " W:$P(IVMIN1,HLFS,8)]"" ?59,$E($P(IVMIN1,HLFS,8),1,20)
  1. 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)
  1. 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:"")
  1. I $P(IVMIN1,HLFS,16)]"" S $P(IVMIN1,HLFS,16)=$$FMNAME^HLFNC($P(IVMIN1,HLFS,16))
  1. W !,?45,"Plan Type: ",?55,$E(IVMPLAN,1,23) W !
  1. Q
  1. ;
  1. ;
  1. DISP2 ; - display ins co. name and address
  1. W !,?4,"Insurance Company: ",$E($P(IVMIN1,HLFS,4),1,45),!
  1. W !,?4,"Company Address: " W:$P(IVMADD,HLECH,1)]"" ?23,$E($P(IVMADD,HLECH,1),1,35) ; address line1
  1. W:$P(IVMADD,HLECH,2)]"" !?23,$E($P(IVMADD,HLECH,2),1,35) ; address line2
  1. W:$P(IVMADD,HLECH,8)]"" !,23,$E($P(IVMADD,HLECH,2),1,35) ; address line3
  1. W:$P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")!($P(IVMADD,HLECH,5)]"") !?23
  1. W $P(IVMADD,HLECH,3) W:$P(IVMADD,HLECH,3)]""&($P(IVMADD,HLECH,4)]"") ", " ; city
  1. W $E($P(IVMADD,HLECH,4),1,2) ; state
  1. W:$P(IVMADD,HLECH,5)]""&($P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")) " "
  1. W $P(IVMADD,HLECH,5) ; zip
  1. Q
  1. ;
  1. ;
  1. IVMQ ; - kill variables used from all protocols
  1. ;
  1. ; - if action completed reset List Man array for display
  1. I $D(^TMP("IVMLST",$J)) D ; Only if list manager array exists
  1. . I IVMDONE D INIT^IVMLINS
  1. . ;
  1. . S VALMBCK="R"
  1. K DA,DFN,IVM0NOD,IVMADD,IVMDND,IVMDONE,IVMEFF,IVMENT,IVMEXP
  1. K IVMI,IVMIDX,IVMIN1,IVMJ,IVMNAME,IVMPLAN,IVMSSN,Y
  1. Q