1 | IVMCZMT ;ALB/MLI/LD/CKN,TDM,EG,TDM - Creation of HL7 ZMT (means test) segment ; 7/19/06 4:41pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**17,53,49,58,81,89,104,105**;21-OCT-94;Build 2
|
---|
3 | ;
|
---|
4 | ; This routine returns the ZMT segment which contains means test
|
---|
5 | ; data for a selected patient. It differs from the standard segment
|
---|
6 | ; builder in that it will add default values where needed for
|
---|
7 | ; fields added by means test sharing - these fields may not have
|
---|
8 | ; values for old tests, though for new tests the values should be there.
|
---|
9 | ;
|
---|
10 | ;
|
---|
11 | ;
|
---|
12 | EN(DFN,VAFSTR,VAFMTDT,VAFTYPE,SETID,DELETE,LIMIT) ; Entry point to get ZMT segment
|
---|
13 | ;
|
---|
14 | ; Input:
|
---|
15 | ; DFN - as the IEN or corresponding patient in the PATIENT file
|
---|
16 | ; VAFSTR - as string of segment fields needed separated by commas
|
---|
17 | ; VAFMTDT - (optional) as date of desired means test (defaults to latest MT)
|
---|
18 | ; VAFTYPE - (optional) as type of test: 1 - Means Test (default=1)
|
---|
19 | ; 2 - Copay Test
|
---|
20 | ; 4 - LTC Copay Exemption Test
|
---|
21 | ; SETID - (optional) value to use for SEQ 1, the set id field (1 used
|
---|
22 | ; as default if not passed.)
|
---|
23 | ; DELETE - (optional, pass by reference) This array is used to
|
---|
24 | ; indicate whether the segment is being used to notify of the
|
---|
25 | ; the deletion of a means test, pharmacy copay test, or a
|
---|
26 | ; hardship determinatin. If a means test or hardship is being
|
---|
27 | ; deleted, then VAFTYPE must equal 1. If an Rx copay test is
|
---|
28 | ; being deleted, then VAFTYPE must equal 2. The subscripts
|
---|
29 | ; are as follows:
|
---|
30 | ; DELETE("DATE OF TEST")=<date of test> - indicates
|
---|
31 | ; the income year of the test that the deletion flags
|
---|
32 | ; refer to
|
---|
33 | ; DELETE("HARDSHIP") - if $G(DELETE("HARDSHIP"))=1 then the
|
---|
34 | ; segment will be created to delete the hardship.
|
---|
35 | ; DELETE("MT") - if $G(DELETE("MT"))=1 then
|
---|
36 | ; the segment will be created to delete a means test.
|
---|
37 | ; DELETE("RX")= if $G(DELETE("RX"))=1 then
|
---|
38 | ; the segment will be created to delete a pharmacy
|
---|
39 | ; copay test.
|
---|
40 | ; DELETE("LTC")= if $G(DELETE("LTC"))=1 then
|
---|
41 | ; the segment will be created to delete a Long term
|
---|
42 | ; care copay exemption test.
|
---|
43 | ; LIMIT - (optional) if $G(LIMIT)=1 then this indicates that a test in
|
---|
44 | ; an income year other than indicated in the IVM Patient File
|
---|
45 | ; should NOT be returned in the ZMT segment
|
---|
46 | ;
|
---|
47 | ; ****Also assumes all HL7 variables are defined as returned ****
|
---|
48 | ; by the INIT^HLTRANS call
|
---|
49 | ;
|
---|
50 | ; Output - string in the form of the DHCP HL7 ZMT segment
|
---|
51 | ;
|
---|
52 | ;
|
---|
53 | N NODE,PRIM,X,Y,VAFY,NODE2,MTIEN
|
---|
54 | ;
|
---|
55 | I '$G(DFN)!($G(VAFSTR)']"") G QUIT
|
---|
56 | S $P(VAFY,HLFS,22)="",VAFSTR=","_VAFSTR_","
|
---|
57 | S VAFTYPE=$S($G(VAFTYPE):VAFTYPE,1:1)
|
---|
58 | S VAFMTDT=$S($G(VAFMTDT):VAFMTDT,1:DT)
|
---|
59 | S $P(VAFY,HLFS,1)=$S($G(SETID):SETID,1:1)
|
---|
60 | S (NODE,NODE2,PRIM)=""
|
---|
61 | ;
|
---|
62 | ;handle deletions of a test
|
---|
63 | I ($G(DELETE("MT"))=1),VAFTYPE=1 D G QUIT
|
---|
64 | .S $P(VAFY,HLFS,2)=$$HLDATE^HLFNC(DELETE("DATE OF TEST")) ; MT Date
|
---|
65 | .S $P(VAFY,HLFS,3)=HLQ
|
---|
66 | .I ($G(DELETE("HARDSHIP"))=1) S $P(VAFY,HLFS,24)=HLQ
|
---|
67 | .S $P(VAFY,HLFS,17)=VAFTYPE ; Type Of Test
|
---|
68 | ;
|
---|
69 | I ($G(DELETE("RX"))=1),VAFTYPE=2 D G QUIT
|
---|
70 | .S $P(VAFY,HLFS,2)=$$HLDATE^HLFNC(DELETE("DATE OF TEST")) ; MT Date
|
---|
71 | .S $P(VAFY,HLFS,3)=HLQ
|
---|
72 | .S $P(VAFY,HLFS,17)=VAFTYPE ; Type Of Test
|
---|
73 | ;
|
---|
74 | I ($G(DELETE("LTC"))=1),VAFTYPE=4 D G QUIT
|
---|
75 | .S $P(VAFY,HLFS,2)=$$HLDATE^HLFNC(DELETE("DATE OF TEST")) ; MT Date
|
---|
76 | .S $P(VAFY,HLFS,3)=HLQ
|
---|
77 | .S $P(VAFY,HLFS,17)=VAFTYPE ; Type Of Test
|
---|
78 | ;
|
---|
79 | ; Income Year requiring transmission from IVM Patient File (301.5)
|
---|
80 | S IVMIY=$S($D(IVMIY):IVMIY,1:(VAFMTDT-10000))
|
---|
81 | ;
|
---|
82 | ; Check for a future dated Income Test
|
---|
83 | S MTIEN=""
|
---|
84 | N EC S EC=0
|
---|
85 | I VAFTYPE'=4 D
|
---|
86 | . S MTIEN=+$$FUT^DGMTU(DFN,"",$S($G(VAFTYPE):VAFTYPE,1:1))
|
---|
87 | . I MTIEN D
|
---|
88 | . . S NODE=$G(^DGMT(408.31,MTIEN,0)),PRIM=$G(^("PRIM")),NODE2=$G(^DGMT(408.31,MTIEN,2))
|
---|
89 | . . ;the FUT API works off the a XREF that is not deleted if the test
|
---|
90 | . . ;is no longer future. As a result, you may pick up the wrong income
|
---|
91 | . . ;year as a return. The check $E(IVMIY,1,3)+1'=$E(+NODE,1,3) must be
|
---|
92 | . . ;performed here and after the current Primary icnome test section below
|
---|
93 | . . I ($G(LIMIT)=1),($E(IVMIY,1,3)+1)'=$E(+NODE,1,3) S EC=1
|
---|
94 | . . Q
|
---|
95 | . Q
|
---|
96 | I VAFTYPE'=4,EC S (NODE,NODE2,MTIEN,PRIM)="" ;Q "ZMT"_HLFS_$G(VAFY)
|
---|
97 | ;
|
---|
98 | ; Check for a current Primary Income Test
|
---|
99 | I 'MTIEN S MTIEN=+$$LST^DGMTU(DFN,VAFMTDT,$S($G(VAFTYPE):VAFTYPE,1:1))
|
---|
100 | S:(NODE="") NODE=$G(^DGMT(408.31,MTIEN,0)),PRIM=$G(^("PRIM")),NODE2=$G(^DGMT(408.31,MTIEN,2))
|
---|
101 | ;
|
---|
102 | ;if the wrong income yr, and told to ignore it ($G(LIMIT)=1,
|
---|
103 | ;send blank means test
|
---|
104 | I ($G(LIMIT)=1),($E(IVMIY,1,3)+1)'=$E(+NODE,1,3) S (NODE,NODE2,MTIEN,PRIM)="" Q "ZMT"_HLFS_$G(VAFY)
|
---|
105 | ;
|
---|
106 | ;
|
---|
107 | I NODE'="" D
|
---|
108 | .;add default values to new means test sharing fields
|
---|
109 | .N STATUS,CODE,TDSTATUS,TDCODE,HARDSHIP,DATA,SOURCE,TIME
|
---|
110 | .S TDSTATUS=$P(NODE2,"^",3)
|
---|
111 | .S HARDSHIP=$P(NODE,"^",20)
|
---|
112 | .I TDSTATUS="" D
|
---|
113 | ..S STATUS=$P(NODE,"^",3)
|
---|
114 | ..Q:'STATUS
|
---|
115 | ..S CODE=$$GETCODE^DGMTH(STATUS)
|
---|
116 | ..I CODE'="","ABCEGMP"[CODE D
|
---|
117 | ...I VAFTYPE=1,HARDSHIP D
|
---|
118 | ....I "AG"[CODE D Q
|
---|
119 | .....I CODE="A",($P(NODE,"^",4)'>$P(NODE,"^",27)) S TDSTATUS=$$GETSTAT^DGMTH("G",1) Q ;Income <= GMT Threshold
|
---|
120 | .....S TDSTATUS=$$GETSTAT^DGMTH("C",1)
|
---|
121 | ....S TDSTATUS=STATUS
|
---|
122 | ...S DATA(2.03)=TDSTATUS,$P(NODE2,"^",3)=TDSTATUS
|
---|
123 | .S SOURCE=$P(NODE,"^",23)
|
---|
124 | .I SOURCE=1 D
|
---|
125 | ..S TIME=$P(NODE2,"^",2)
|
---|
126 | ..I TIME="" S TIME=$$NOW^XLFDT,$P(NODE2,"^",2)=TIME,DATA(2.02)=TIME
|
---|
127 | ..I $P(NODE2,"^",5)="",$P(NODE,"^",6) S $P(NODE2,"^",5)=$$GETSITE^DGMTU4($P(NODE,"^",6)),DATA(2.05)=$P(NODE2,"^",5)
|
---|
128 | .I HARDSHIP,$P(NODE2,"^",4)="",$P(NODE,"^",22) S $P(NODE2,"^",4)=$$GETSITE^DGMTU4($P(NODE,"^",22)),DATA(2.04)=$P(NODE2,"^",4)
|
---|
129 | .I $D(DATA),$$UPD^DGENDBS(408.31,MTIEN,.DATA)
|
---|
130 | .;
|
---|
131 | I VAFSTR[",2," S $P(VAFY,HLFS,2)=$S(+NODE:$$HLDATE^HLFNC(+NODE),1:HLQ) ; MT Date
|
---|
132 | I VAFSTR[",3," S X=$P($G(^DG(408.32,+$P(NODE,"^",3),0)),"^",2),$P(VAFY,HLFS,3)=$S(X]"":X,1:"") ; MT Status
|
---|
133 | I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(NODE,"^",4)]"":$P(NODE,"^",4),1:HLQ) ; Income
|
---|
134 | I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(NODE,"^",5)]"":$P(NODE,"^",5),1:HLQ) ; Net Worth
|
---|
135 | I VAFSTR[",6," S $P(VAFY,HLFS,6)=$S($P(NODE,"^",10):$$HLDATE^HLFNC($P(NODE,"^",10)),1:HLQ) ; Adjudication Date/Time
|
---|
136 | I VAFSTR[",7," S $P(VAFY,HLFS,7)=$$YN^VAFHLFNC($P(NODE,"^",11)) ;Agreed To Pay
|
---|
137 | I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S($P(NODE,"^",12):$P(NODE,"^",12),1:HLQ) ; Threshold A
|
---|
138 | I VAFSTR[",9," S $P(VAFY,HLFS,9)=$S($P(NODE,"^",15)]"":$P(NODE,"^",15),1:HLQ) ; Deductible Expenses
|
---|
139 | I VAFSTR[",10," S $P(VAFY,HLFS,10)=$S($P(NODE,"^",7):$$HLDATE^HLFNC($P(NODE,"^",7)),1:HLQ) ; Date/Time Completed
|
---|
140 | I VAFSTR[",11," S $P(VAFY,HLFS,11)=$$YN^VAFHLFNC($P(NODE,"^",16)) ;Previous Year Means Test Threshold Flag
|
---|
141 | I VAFSTR[",12," S $P(VAFY,HLFS,12)=$S($P(NODE,"^",18)]"":$P(NODE,"^",18),1:HLQ) ; Total Dependents
|
---|
142 | I VAFSTR[",13," S $P(VAFY,HLFS,13)=$$YN^VAFHLFNC($P(NODE,"^",20)) ;Hardship
|
---|
143 | I VAFSTR[",14," S $P(VAFY,HLFS,14)=$S($P(NODE,"^",21):$$HLDATE^HLFNC($P(NODE,"^",21)),1:HLQ) ; Hardship Review Date
|
---|
144 | I VAFSTR[",15," S $P(VAFY,HLFS,15)=$S($P(NODE,"^",24):$$HLDATE^HLFNC($P(NODE,"^",24)),1:HLQ) ; Date Vet Signed Test
|
---|
145 | I VAFSTR[",16," S $P(VAFY,HLFS,16)=$$YN^VAFHLFNC($P(NODE,"^",14)) ;Declines To Give Income Info
|
---|
146 | I VAFSTR[",17," S $P(VAFY,HLFS,17)=$S($P(NODE,"^",19):$P(NODE,"^",19),1:VAFTYPE) ; Type Of Test
|
---|
147 | I VAFSTR[",18," S $P(VAFY,HLFS,18)=$S($P(NODE,"^",23)]"":$P(NODE,"^",23),1:HLQ) ; Source Of Test
|
---|
148 | I VAFSTR[",19," S $P(VAFY,HLFS,19)=$$YN^VAFHLFNC(PRIM) ; Primary Test?
|
---|
149 | I VAFSTR[",20," S $P(VAFY,HLFS,20)=$S($P(NODE,"^",25):$$HLDATE^HLFNC($P(NODE,"^",25)),1:HLQ) ; Date IVM Verified MT Completed
|
---|
150 | I VAFSTR[",21," S $P(VAFY,HLFS,21)=$$YN^VAFHLFNC($P(NODE,"^",26)) ;Refused To Sign
|
---|
151 | ;
|
---|
152 | ;
|
---|
153 | I VAFSTR[",22," S $P(VAFY,HLFS,22)=$P(NODE2,"^",5) ;Site Conducting Test
|
---|
154 | I VAFSTR[",23," S $P(VAFY,HLFS,23)=$P(NODE2,"^",4) ;Site Granting Hardship
|
---|
155 | I VAFSTR[",24," S $P(VAFY,HLFS,24)=$S($P(NODE2,"^"):$$HLDATE^HLFNC($P(NODE2,"^")),1:"") ;Hardship Effective Date
|
---|
156 | I VAFSTR[",25," S $P(VAFY,HLFS,25)=$S($P(NODE2,"^",2):$$HLDATE^HLFNC($P(NODE2,"^",2)),1:"") ;Dt/Tm Test Last Edited
|
---|
157 | I VAFSTR[",26," S $P(VAFY,HLFS,26)=$S($P(NODE2,"^",3):$$GETCODE^DGMTH($P(NODE2,"^",3)),1:"") ; Test Determined Status
|
---|
158 | I VAFSTR[",28," S $P(VAFY,HLFS,28)=$P(NODE,"^",27) ;GMT Threshold
|
---|
159 | I VAFSTR[",29," S $P(VAFY,HLFS,29)=$P(NODE2,"^",9) ;Hardship Reason
|
---|
160 | I VAFSTR[",30," S $P(VAFY,HLFS,30)=+$P(NODE2,"^",11) ; Test Version
|
---|
161 | ;
|
---|
162 | ;can only transmit the deletion of a hardship if the segment is for a means test - and the income years must match if there is a means test
|
---|
163 | ;
|
---|
164 | I VAFTYPE=1,($G(DELETE("HARDSHIP"))=1),('(+NODE)!($E(DELETE("DATE OF TEST"),1,3)=$E((+NODE),1,3))) S $P(VAFY,HLFS,24)=HLQ
|
---|
165 | ;
|
---|
166 | QUIT Q "ZMT"_HLFS_$G(VAFY)
|
---|