1 | IVMLINS1 ;ALB/KCL - IVM INSURANCE DISPLAY POLICY ; 01-FEB-94
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**14,94,111**; 21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | DE ; - select patient for insurance information upload/purge
|
---|
7 | ;
|
---|
8 | ; Input: - ^TMP("IVMLST",$J,"IDX",CTR,CTR)=pat name_pat ssn_ivm ien_ivm sub ien
|
---|
9 | ;
|
---|
10 | ;
|
---|
11 | ;
|
---|
12 | S IVMDONE=0
|
---|
13 | ;
|
---|
14 | ; - generic seletor used within a list manager action call
|
---|
15 | D EN^VALM2($G(XQORNOD(0)),"S")
|
---|
16 | Q:'$D(VALMY)
|
---|
17 | S IVMENT=0 F S IVMENT=$O(VALMY(IVMENT)) Q:'IVMENT D
|
---|
18 | .;
|
---|
19 | .; - get index for look-up
|
---|
20 | .S IVMIDX=$G(^TMP("IVMLST",$J,"IDX",IVMENT,IVMENT)) I IVMIDX']"" Q
|
---|
21 | .;
|
---|
22 | .; - change if HL7 segment sep ever changes!
|
---|
23 | .S HLFS="^",HLECH="~"
|
---|
24 | .;
|
---|
25 | .; - get patient name, ssn, da(1), da
|
---|
26 | .S IVMNAME=$P(IVMIDX,"^",1),IVMSSN=$P(IVMIDX,"^",2),IVMI=$P(IVMIDX,"^",3),IVMJ=$P(IVMIDX,"^",4)
|
---|
27 | .;
|
---|
28 | .; - get data node from list manager storage array
|
---|
29 | .S IVMDND=$G(^TMP("IVMIUPL",$J,IVMNAME,IVMI,IVMJ)),DFN=$P(IVMDND,"^",1)
|
---|
30 | .;
|
---|
31 | . S IVMIN1=$$GETIN1(IVMI,IVMJ)
|
---|
32 | .;
|
---|
33 | .; - alert user if date of death
|
---|
34 | .I $P(IVMDND,"^",6)]""!($P($G(^DPT(+DFN,.35)),"^")]"") D DOD^IVMLINS2
|
---|
35 | .;
|
---|
36 | .; - display all insurance currently on file in DHCP
|
---|
37 | .D CLEAR^VALM1,ALL
|
---|
38 | .; - display insurance information received from IVM IN1 segment
|
---|
39 | .D HDR,DISP1
|
---|
40 | .S DIR(0)="E",DIR("A")="Press RETURN to continue or '^' to return to display screen" D ^DIR K DIR Q:'Y
|
---|
41 | .;
|
---|
42 | .; - ask user to add or purge
|
---|
43 | .D ASK^IVMLINS2
|
---|
44 | ;
|
---|
45 | DEQ ; - clean up variables
|
---|
46 | D IVMQ
|
---|
47 | Q
|
---|
48 | ;
|
---|
49 | ;
|
---|
50 | GETIN1(IVMI,IVMJ) ; get IN1 segment from (#301.5) file containing ins data
|
---|
51 | S IVMIN1=$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST"))
|
---|
52 | ; - set if IN1 segment exceeds 245 chars
|
---|
53 | S:$D(^IVM(301.5,IVMI,"IN",IVMJ,"ST1")) IVMIN1=IVMIN1_(^("ST1"))
|
---|
54 | ;
|
---|
55 | Q IVMIN1
|
---|
56 | ;
|
---|
57 | ALL ; - display all insurance company information for patient in DHCP
|
---|
58 | ;
|
---|
59 | W !,?22,"INSURANCE POLICIES CURRENTLY ON FILE"
|
---|
60 | ; - write dashed line
|
---|
61 | W !,?7,$TR($J("",66)," ","*")
|
---|
62 | ;
|
---|
63 | ; - IB call to display all DHCP ins co. information
|
---|
64 | D DISP^DGIBDSP
|
---|
65 | W !
|
---|
66 | Q
|
---|
67 | ;
|
---|
68 | ;
|
---|
69 | HDR ; - header for insurance data received from HEC
|
---|
70 | W !,?23,"INSURANCE POLICY RECEIVED FROM HEC"
|
---|
71 | ; - write dashed line
|
---|
72 | W !,?7,$TR($J("",66)," ","*")
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | ;
|
---|
76 | DISP1 ; - display insurance fields from IN1 segment
|
---|
77 | ;
|
---|
78 | ; - ins effec and exp dates in FM format
|
---|
79 | S IVMEFF=$$FMDATE^HLFNC($P(IVMIN1,HLFS,12)),IVMEXP=$$FMDATE^HLFNC($P(IVMIN1,HLFS,13))
|
---|
80 | ;
|
---|
81 | S IVMADD=$P(IVMIN1,"^",5)
|
---|
82 | S IVMPLAN=$P(IVMIN1,HLFS,15),IVMPLAN=$P($G(^IBE(355.1,+IVMPLAN,0)),"^")
|
---|
83 | ;
|
---|
84 | ; - display insurance policy fields from IVM
|
---|
85 | W !,?2,"Company: ",?9,$E($P(IVMIN1,HLFS,4),1,32),?45,"Effective Date: ",?62,$$DAT2^IVMUFNC4(IVMEFF)
|
---|
86 | W !,?2,"Phone #: ",?9,$E($P(IVMIN1,HLFS,7),1,25),?45,"Expiration Date: ",?62,$$DAT2^IVMUFNC4(IVMEXP)
|
---|
87 | W !,?2,"Address: ",?45,"Subscriber ID: " W:$P(IVMIN1,HLFS,36)]"" ?59,$E($P(IVMIN1,HLFS,36),1,20) W !
|
---|
88 | 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")
|
---|
89 | W:$P(IVMADD,HLECH,1)']"" !
|
---|
90 | W:$P(IVMADD,HLECH,2)]"" !,?4,$E($P(IVMADD,HLECH,2),1,35)
|
---|
91 | 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)
|
---|
92 | W:$P(IVMADD,HLECH,5)]""&($P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")) " "
|
---|
93 | W $P(IVMADD,HLECH,5)
|
---|
94 | I $P(IVMADD,HLECH,2)']"" D
|
---|
95 | .W !,?45,"Group Name: " W:$P(IVMIN1,HLFS,9)]"" ?59,$E($P(IVMIN1,HLFS,9),1,20)
|
---|
96 | 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)
|
---|
97 | W !,?45,"Group Number: " W:$P(IVMIN1,HLFS,8)]"" ?59,$E($P(IVMIN1,HLFS,8),1,20)
|
---|
98 | 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)
|
---|
99 | 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:"")
|
---|
100 | I $P(IVMIN1,HLFS,16)]"" S $P(IVMIN1,HLFS,16)=$$FMNAME^HLFNC($P(IVMIN1,HLFS,16))
|
---|
101 | W !,?45,"Plan Type: ",?55,$E(IVMPLAN,1,23) W !
|
---|
102 | Q
|
---|
103 | ;
|
---|
104 | ;
|
---|
105 | DISP2 ; - display ins co. name and address
|
---|
106 | W !,?4,"Insurance Company: ",$E($P(IVMIN1,HLFS,4),1,45),!
|
---|
107 | W !,?4,"Company Address: " W:$P(IVMADD,HLECH,1)]"" ?23,$E($P(IVMADD,HLECH,1),1,35) ; address line1
|
---|
108 | W:$P(IVMADD,HLECH,2)]"" !?23,$E($P(IVMADD,HLECH,2),1,35) ; address line2
|
---|
109 | W:$P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")!($P(IVMADD,HLECH,5)]"") !?23
|
---|
110 | W $P(IVMADD,HLECH,3) W:$P(IVMADD,HLECH,3)]""&($P(IVMADD,HLECH,4)]"") ", " ; city
|
---|
111 | W $E($P(IVMADD,HLECH,4),1,2) ; state
|
---|
112 | W:$P(IVMADD,HLECH,5)]""&($P(IVMADD,HLECH,3)]""!($P(IVMADD,HLECH,4)]"")) " "
|
---|
113 | W $P(IVMADD,HLECH,5) ; zip
|
---|
114 | Q
|
---|
115 | ;
|
---|
116 | ;
|
---|
117 | IVMQ ; - kill variables used from all protocols
|
---|
118 | ;
|
---|
119 | ; - if action completed reset List Man array for display
|
---|
120 | I $D(^TMP("IVMLST",$J)) D ; Only if list manager array exists
|
---|
121 | . I IVMDONE D INIT^IVMLINS
|
---|
122 | . ;
|
---|
123 | . S VALMBCK="R"
|
---|
124 | K DA,DFN,IVM0NOD,IVMADD,IVMDND,IVMDONE,IVMEFF,IVMENT,IVMEXP
|
---|
125 | K IVMI,IVMIDX,IVMIN1,IVMJ,IVMNAME,IVMPLAN,IVMSSN,Y
|
---|
126 | Q
|
---|