1 | IVMUFNC4 ;ALB/KCL - IVM UTILITIES ; 12/21/00 3:15pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**1,9,13,18,34**; 21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | DAT1(X,Y) ; extrinsic function - convert FM date to displayable (mm/dd/yy) format.
|
---|
7 | ;
|
---|
8 | ; Input - X as FM date.time
|
---|
9 | ; Y [optional] equal to 1 if time is to be returned
|
---|
10 | ;
|
---|
11 | ; Output - IVMDATE as (mm/dd/yy) and optional output of time, if $G(Y)
|
---|
12 | ;
|
---|
13 | N IVMDATE,T
|
---|
14 | S IVMDATE=$S(X:$TR($$FMTE^XLFDT(X,"2DF")," ","0"),1:"")
|
---|
15 | I $G(Y) S T="."_$E($P(X,".",2)_"000000",1,7) I T>0 S IVMDATE=IVMDATE_" "_$S($E(T,2,3)>12:$E(T,2,3)-12,1:+$E(T,2,3))_":"_$E(T,4,5)_$S($E(T,2,5)>1200:" pm",1:" am")
|
---|
16 | Q IVMDATE
|
---|
17 | ;
|
---|
18 | ;
|
---|
19 | DAT2(Y) ; extrinsic function - convert FM date to displayable (mmm dd yyyy) format
|
---|
20 | ;
|
---|
21 | ; Input - Y as FM date
|
---|
22 | ;
|
---|
23 | ; Output - Y as displayable (mmm dd yyyy) date
|
---|
24 | ;
|
---|
25 | N %
|
---|
26 | Q:Y']"" "" D D^DIQ
|
---|
27 | Q Y
|
---|
28 | ;
|
---|
29 | ;
|
---|
30 | STATE1(X) ; extrinsic function - convert state abbreviation to state pointer
|
---|
31 | ;
|
---|
32 | ; Input - X as state abbreviation
|
---|
33 | ;
|
---|
34 | ; Output - pointer to STATE (#5) file
|
---|
35 | ;
|
---|
36 | Q:'$D(X) ""
|
---|
37 | S X=$E(X,1,2)
|
---|
38 | Q $S(X="":X,1:+$O(^DIC(5,"C",X,0)))
|
---|
39 | ;
|
---|
40 | ;
|
---|
41 | PT(DFN) ; Returns patient name^long patient id^short patient id,
|
---|
42 | ; or null if not found.
|
---|
43 | ; Input: DFN -- Pointer to the patient in file #2
|
---|
44 | N X S X=""
|
---|
45 | I $G(DFN) S X=$G(^DPT(+DFN,0)) I X'="" S X=$P(X,"^",1)_"^"_$P($G(^DPT(DFN,.36)),"^",3,4)
|
---|
46 | Q X
|
---|
47 | ;
|
---|
48 | ;
|
---|
49 | NTE(DFN,IVMOUT,IVMMTDT) ; - entry point to get comments from a specified means test
|
---|
50 | ;
|
---|
51 | ; This function returns an array (specified by the user) which contains
|
---|
52 | ; the comments associated with a specified means Test. The comments
|
---|
53 | ; are formatted in HL7 NTE segments.
|
---|
54 | ;
|
---|
55 | ; Input: DFN as internal entry number from PATIENT (#2) file
|
---|
56 | ; IVMOUT as specified reference array
|
---|
57 | ; IVMMTDT as date of desired means test (default to latest MT)
|
---|
58 | ;
|
---|
59 | ; Output: IVMOUT array passed by reference containing comments
|
---|
60 | ; formatted in HL7 NTE segments.
|
---|
61 | ;
|
---|
62 | ;
|
---|
63 | N CTR,NODE,IVMDA,IVMIEN
|
---|
64 | I '$G(DFN) G ENQ
|
---|
65 | S IVMIEN=+$$LST^DGMTU(DFN,$S($G(IVMMTDT):IVMMTDT,1:DT))
|
---|
66 | I $G(^DGMT(408.31,IVMIEN,"C",0))]"" D GET
|
---|
67 | ENQ Q
|
---|
68 | ;
|
---|
69 | ;
|
---|
70 | GET ; - get comment nodes and place in array
|
---|
71 | S (CTR,IVMDA)=0
|
---|
72 | F S IVMDA=$O(^DGMT(408.31,IVMIEN,"C",IVMDA)) Q:'IVMDA D
|
---|
73 | .S NODE=$G(^DGMT(408.31,IVMIEN,"C",IVMDA,0))
|
---|
74 | .I 'CTR,NODE="" Q ; line feed from screen editor, maybe?
|
---|
75 | .F S CTR=CTR+1,IVMOUT(CTR)="NTE^"_CTR_"^^"_$E(NODE,1,120) Q:$L(NODE)'>120 S NODE=$E(NODE,121,255)
|
---|
76 | Q
|
---|
77 | ;
|
---|
78 | ;
|
---|
79 | MSH(IVMNOMSH,IVMFLL,IVMREC,IVMCT,IVMCNTID) ; --
|
---|
80 | ; Description: Message header processing for HL7 full data transmissions (Z07).
|
---|
81 | ;
|
---|
82 | ; Input:
|
---|
83 | ; IVMNOMSH - (optional) if IVMNOMSH=1, means MSH segment should
|
---|
84 | ; not be built
|
---|
85 | ; IVMFLL - (optional) flag for creating MSA, QRD segments for FULL
|
---|
86 | ; query transmission, $G(IVMFLL) means yes.
|
---|
87 | ; IVMREC - (optional) ien of #301.9001 multiple
|
---|
88 | ; IVMCT - count of segments transmitted, pass by reference
|
---|
89 | ;
|
---|
90 | ; HL7 Variables:
|
---|
91 | ; HLMTN - HL7 message type name
|
---|
92 | ; HLECH - HL7 encoding characters
|
---|
93 | ; HLSDT - a flag that indicates that the data to be sent is
|
---|
94 | ; stored in the ^TMP("HLS") global array
|
---|
95 | ; HLMID - message id from CREATE^HLTF
|
---|
96 | ; HLEID - protocol id
|
---|
97 | ; HL - array of protocol data from INIT^HLFNC2
|
---|
98 | ;
|
---|
99 | ; Output:
|
---|
100 | ; ^TMP("HLS",$J,IVMCT) global array containing all segments of the HL7 message that the VistA application wishes to send. The HLSDT and IVMCT variables are defined above.
|
---|
101 | ; IVMCNTID - as HL7 message control id concatenated with batch message counter, pass by reference
|
---|
102 | ;
|
---|
103 | N MID,RESULT
|
---|
104 | D INIT^HLFNC2(HLEID,.HL)
|
---|
105 | ;
|
---|
106 | ;if MSH segment not needed, still need to compute IVMCNTID (msg controll id)
|
---|
107 | I $G(IVMNOMSH) S IVMCNTID=$P($G(^TMP("HLS",$J,IVMCT-2)),HLFS,10)
|
---|
108 | ;
|
---|
109 | ; if not MSH segment, then build MSH segment
|
---|
110 | I '$G(IVMNOMSH) D
|
---|
111 | .S IVMCT=IVMCT+1
|
---|
112 | .;
|
---|
113 | .; - call HL7 utility to build MSH segment, set event type code
|
---|
114 | .; for full transmission in MSH segment
|
---|
115 | .S MID=HLMID_"-"_HLEVN
|
---|
116 | .D MSH^HLFNC2(.HL,MID,.RESULT)
|
---|
117 | .S ^TMP("HLS",$J,IVMCT)=RESULT
|
---|
118 | .;
|
---|
119 | .; - concatenate counter to msg control id (used for batch msgs)
|
---|
120 | .D MSGID(.IVMCT)
|
---|
121 | ;
|
---|
122 | ; if flag for query response, create MSA & QRD segments
|
---|
123 | I $G(IVMFLL) D
|
---|
124 | .;
|
---|
125 | .; - get query MSH segment control id of query message received from IVM
|
---|
126 | .S IVMHLMID=$P($G(^IVM(301.9,1,10,+IVMREC,0)),"^",4)
|
---|
127 | .;
|
---|
128 | .; - create MSA segment, message control id must be referenced in
|
---|
129 | .; response to query (full trans) sent back to IVM
|
---|
130 | .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AA"_HLFS_IVMHLMID_HLFS
|
---|
131 | .;
|
---|
132 | .; - get QRD segment of query message received from IVM
|
---|
133 | .S IVMQRD=$G(^IVM(301.9,1,10,+IVMREC,"ST"))
|
---|
134 | .;
|
---|
135 | .; - create QRD segment, must be transmitted back to IVM when
|
---|
136 | .; responding to query rec'd from IVM
|
---|
137 | .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMQRD
|
---|
138 | ;
|
---|
139 | Q
|
---|
140 | ;
|
---|
141 | ;
|
---|
142 | MSGID(IVMCT) ; --
|
---|
143 | ; Description: Put the batch number (HL7 msg event counter) into MSH
|
---|
144 | ; segment. Concatinate msg control id with hyphen msg event counter.
|
---|
145 | ;
|
---|
146 | ; Input:
|
---|
147 | ; IVMCT - count of segments transmitted, pass by reference
|
---|
148 | ;
|
---|
149 | ; HL7 Variables:
|
---|
150 | ; HLEVN - HL7 message event counter (# of events in an HL7 msg)
|
---|
151 | ; HLSDT - a flag that indicates that the data to be sent is
|
---|
152 | ; stored in the ^TMP("HLS") global array
|
---|
153 | ; HLFS - HL7 field separator
|
---|
154 | ;
|
---|
155 | ; Output:
|
---|
156 | ; ^TMP("HLS",$J,IVMCT) global array containing all segments of the HL7 message that the VistA application wishes to send. The HLSDT and IVMCT variables are defined above.
|
---|
157 | ;
|
---|
158 | ; included logic to extract first piece of field (HL7 1.6 upgrade)
|
---|
159 | ; just in case it has already been set
|
---|
160 | S IVMCNTID=$P($P($G(^TMP("HLS",$J,IVMCT)),HLFS,10),"-",1)
|
---|
161 | S IVMCNTID=IVMCNTID_"-"_HLEVN
|
---|
162 | S $P(^TMP("HLS",$J,IVMCT),HLFS,10)=IVMCNTID
|
---|
163 | Q
|
---|
164 | ;
|
---|
165 | ;
|
---|
166 | IEN(X) ; Get the ien for a segment from HL7 SEGMENT (#771.3) file
|
---|
167 | ; Input: X -- .01 field from file #771.3
|
---|
168 | N DIC,Y
|
---|
169 | S DIC="^HL(771.3,",DIC(0)="F" D ^DIC
|
---|
170 | Q +Y
|
---|
171 | ;
|
---|
172 | ;
|
---|
173 | BTCLM(DFN,INDATE) ; --
|
---|
174 | ; Description: This function will be used to find a patients Beneficiary Travel claim record for the current income year.
|
---|
175 | ;
|
---|
176 | ; Input:
|
---|
177 | ; DFN - internal entry number of Patient (#2) file
|
---|
178 | ; INDATE - (optional) date that will be used to determine income year
|
---|
179 | ; to begin claim search
|
---|
180 | ;
|
---|
181 | ; Output:
|
---|
182 | ; Function Value - returns the internal entry number of the
|
---|
183 | ; patients Beneficiary Travel claim record
|
---|
184 | ; for the current income year, otherwise NULL.
|
---|
185 | ;
|
---|
186 | ; if DFN not passed, exit
|
---|
187 | S IVMCLAIM="" I '$G(DFN) G BTCLMQ
|
---|
188 | ;
|
---|
189 | ; if INDATE not passed, default to today
|
---|
190 | S INDATE=$S($D(INDATE):INDATE,1:DT)
|
---|
191 | ;
|
---|
192 | ; get most recent Beneficiary Travel claim for vet (reverse $O)
|
---|
193 | S IVMCLAIM=$O(^DGBT(392,"C",DFN,IVMCLAIM),-1)
|
---|
194 | ;
|
---|
195 | ; if claim date not greater than 1/1 of INDATE year-1, set to null
|
---|
196 | I $G(IVMCLAIM)'>($E(INDATE,1,3)-2_1231.999999) S IVMCLAIM=""
|
---|
197 | ;
|
---|
198 | ;
|
---|
199 | BTCLMQ Q IVMCLAIM
|
---|
200 | ;
|
---|
201 | ;
|
---|
202 | LD(DFN) ; --
|
---|
203 | ; Description: This function will return a date based on the patient's
|
---|
204 | ; last Means Test or Copay test.
|
---|
205 | ; 1) The current year will be checked for a MT/CT, if found the
|
---|
206 | ; current date will be returned.
|
---|
207 | ; 2) The prior year will be checked for a MT/CT, if found the
|
---|
208 | ; last day (12/31) of prior year will be returned.
|
---|
209 | ; 3) Otherwise, the current date will be returned.
|
---|
210 | ;
|
---|
211 | ; Input:
|
---|
212 | ; DFN - as patient IEN
|
---|
213 | ;
|
---|
214 | ; Output:
|
---|
215 | ; Function Value - as date based on patient's last MT/CT
|
---|
216 | ;
|
---|
217 | N IVMLAST,IVMLD
|
---|
218 | ;
|
---|
219 | ; current date (default)
|
---|
220 | S IVMLD=DT
|
---|
221 | ;
|
---|
222 | ; get date of last MT/CT for patient based on current date
|
---|
223 | S IVMLAST=$P($$LST^DGMTCOU1(DFN,IVMLD),"^",2)
|
---|
224 | ;
|
---|
225 | D ; drop out of do block if condition true
|
---|
226 | .;
|
---|
227 | .; if MT/CT not found
|
---|
228 | .I 'IVMLAST Q
|
---|
229 | .;
|
---|
230 | .; if date of last MT/CT = current year
|
---|
231 | .I $E(IVMLAST,1,3)=$E(DT,1,3) Q
|
---|
232 | .;
|
---|
233 | .; if date of last MT/CT = previous year, use end-of-previous year
|
---|
234 | .I $E(IVMLAST,1,3)=($E(DT,1,3)-1) S IVMLD=$E(DT,1,3)-1_1231 Q
|
---|
235 | ;
|
---|
236 | Q IVMLD
|
---|