source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUFNC.m@ 1638

Last change on this file since 1638 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 7.7 KB
RevLine 
[613]1IVMUFNC ;ALB/MLI/PHH/SCK - IVM GENERIC FUNCTIONS ; 10/15/2004 1:10pm
2 ;;2.0;INCOME VERIFICATION MATCH;**3,11,17,34,95,94**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine contains generic calls for use throughout IVM
6 ;
7INIT(EID,HL,INT) ; initialize variables for 1.6 HL7/IVM
8 S EID=$G(EID),INT=$G(INT)
9 S HLDAP="IVM" D INIT^HLFNC2(EID,.HL,INT)
10 S (HLEVN,IVMCT)=0 ; initialize segment and message counters
11 ;;D NOW^%DTC S HLSDT=%
12 Q
13 ;
14 ;
15CLEAN ; clean-up variables for HL7/IVM (as defined by call to INIT)
16 D KILL^HLTRANS
17 K HLEVN,HLMTN,HLSDT,IVMCT
18 Q
19 ;
20 ;
21BATCH ; put BHS and BTS segments into TMP global
22 ;
23 ; Input - HLMTN as HL7 message type being sent in this batch (REQUIRED)
24 ; HLEVN as number of HL7 messages in batch (REQUIRED)
25 ; IVMCT as subscript in TMP global where BTS segment goes (REQ)
26 ; HLSEC (optional) as security (see BHS^HLFNC1)
27 ; HLMSA (optional) as message ack variables (see BHS^HLFNC1)
28 ;
29 ; ****Also assumes all HL7 variables returned from****
30 ; INIT^HLTRANS are defined
31 ;
32 Q ; LINE ADDED FOR HL7 1.6
33 S HLSEC=$G(HLSEC),HLMSA=$G(HLMSA)
34 S ^TMP("HLS",$J,HLSDT,0)=$$BHS^HLFNC1(HLMTN,HLSEC,HLMSA)
35 S ^TMP("HLS",$J,HLSDT,IVMCT)="BTS"_HLFS_HLEVN ; trailer
36 Q
37 ;
38 ;
39IVM(DFN,IVMDT) ; extrinsic function - should this pt be transmitted to IVM?
40 ;
41 ; Input - DFN as internal entry number of PATIENT file
42 ; IVMDT as date of test (default DT)
43 ;
44 ; Output - 1 if pt should be sent to IVM, 0 otherwise
45 ;
46 N X,Y
47 S DFN=$G(DFN) I '$D(^DPT(+DFN,0)) G IVMQ
48 S IVMDT=$S($G(IVMDT):IVMDT,1:DT)
49 S X=$$LST^DGMTU(DFN,IVMDT)
50 I $E($P(X,"^",2),1,3)'=$E(IVMDT,1,3) K IVMDT G IVMQ ; not in same year
51 S X=$G(^DGMT(408.31,+X,0)) I 'X G IVMQ ; can't find MT entry for date
52 I $P(X,"^",3)=6 S:'$$INS(DFN,IVMDT) Y=1 G IVMQ ; C/no insurance...send
53 I $P(X,"^",3)'=4 G IVMQ ; not cat A
54 I ($P(X,"^",4)-$P(X,"^",15)>$P(X,"^",12))!$P(X,"^",10) G IVMQ ; income-deduct expenses>threshold (hardship) or adjudicated
55 S Y=1
56IVMQ Q +$G(Y)
57 ;
58 ;
59INS(DFN,IVMDT) ; extrinsic function to see if pt has active insurance
60 ;
61 ; Input - DFN as internal entry number of PATIENT file
62 ; IVMDT [optional] as date to compute ins coverage for
63 ;
64 ; Output - 1 if yes, 0 if no
65 ;
66 Q $S($$INSUR^IBBAPI(DFN,$G(IVMDT))=1:1,1:0)
67 ;
68 ;
69MAIL(IVMGRP) ; Transmit to members of Mail Group. Before D MAIL^IVMUFNC()
70 ; set XMSUB = to subject and set IVMTEXT array to message.
71 ;
72 ;Input:
73 ; IVMGRP - optional parameter, = to name of a mailgroup to send the
74 ; message to. If not sent, the IVM Site Parameter file is
75 ; used to determine the mailgroup.
76 ;
77 N DIFROM,XMDUZ,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMDF
78 S XMDF=""
79 S XMDUZ="IVM PACKAGE"
80 S XMTEXT="IVMTEXT("
81 I '$L($G(IVMGRP)) D
82 .S IVMGRP=$P($G(^XMB(3.8,+$P($G(^IVM(301.9,1,0)),"^",2),0)),"^")
83 S XMY("G."_IVMGRP_"@"_^XMB("NETNAME"))=""
84 D ^XMD
85 K IVMTEXT,XMDUZ,XMSUB,XMTEXT,XMY
86 Q
87 ;
88 ;
89LTD(DFN,IVMQUERY) ; Find Last Treatment Date
90 ; Input: DFN -- pointer to the patient in file #2
91 ; IVMQUERY("LTD") -- # of the QUERY that is currently open or
92 ; undefined, zero, or null if no QUERY opened for
93 ; last treatment date
94 ; Output: LTD -- Last Treatment Date (really last date seen at
95 ; the facility)
96 ;
97 N LTD,SDSTOP,X,Z,IVMQ
98 ;
99 ; - need a patient
100 S IVMQ=$G(IVMQUERY("LTD"))
101 I '$G(DFN) S LTD=0 G LTDQ
102 ;
103 ; - if current inpatient, set LTD = today and quit
104 I $G(^DPT(DFN,.105)) S LTD=DT G LTDQ
105 ;
106 ; - get the last discharge date
107 S LTD=+$O(^DGPM("ATID3",DFN,"")) S:LTD LTD=9999999.9999999-LTD\1 S:LTD>DT LTD=DT
108 ;
109 ; - get the last registration date and compare to LTD
110 S X=+$O(^DPT(DFN,"DIS",0)) I X S X=9999999-X\1 S:X>LTD LTD=X
111 ;
112 ; - get the last appointment or stop after LTD (if any)
113 K ^TMP("DIERR",$J)
114 I $G(IVMQ) D ACTIVE^SDQ(.IVMQ,"FALSE","SET") ;clear QUERY results
115 I '$G(IVMQ) D
116 .D OPEN^SDQ(.IVMQ) Q:'$G(IVMQ)
117 .D INDEX^SDQ(.IVMQ,"PATIENT/DATE","SET")
118 .D SCANCB^SDQ(.IVMQ,"I $S($P(SDOE0,U,8)=2:1,$P(SDOE0,U,8)=1:$$APPT^IVMUFNC(SDOE0),1:0) S LTD=SDOE0\1,SDSTOP=1","SET")
119 .S IVMQUERY("LTD")=IVMQ
120 ;
121 D PAT^SDQ(.IVMQ,DFN,"SET")
122 D DATE^SDQ(.IVMQ,LTD+.000001,9999999,"SET")
123 D ACTIVE^SDQ(.IVMQ,"TRUE","SET")
124 D SCAN^SDQ(.IVMQ,"BACKWARD")
125 K ^TMP("DIERR",$J)
126 ;
127LTDQ ;
128 Q $S(LTD:$$HLDATE^HLFNC(LTD),1:HLQ)
129 ;
130APPT(SDOE0) ;Determine if appt associated with encounter is in a valid state
131 ; Quit when Outpatient Encounter STATUS is CHECKED OUT
132 Q:$P(SDOE0,U,12)=2 1
133 ; Quit when Outpatient Encounter STATUS is ACTION REQUIRED and the
134 ; Appointment Status is SCHEDULED/KEPT
135 N DGARRAY,SDCNT,SDSTAT,SDDTTM S DGARRAY("FLDS")=3,DGARRAY(4)=+$P(SDOE0,U,2)
136 S DGARRAY(1)=$P(SDOE0,U),DGARRAY("SORT")="P",DGARRAY("MAX")=1
137 S SDCNT=$$SDAPI^SDAMA301(.DGARRAY),SDSTAT=""
138 I SDCNT>0 D
139 .S SDDTTM=$O(^TMP($J,"SDAMA301",DGARRAY(4),0))
140 .I SDDTTM S SDSTAT=$P($P($G(^TMP($J,"SDAMA301",DGARRAY(4),SDDTTM)),U,3),";")
141 K ^TMP($J,"SDAMA301")
142 Q:(($P(SDOE0,U,12)=14)&(SDSTAT="R")) 1
143 Q 0
144 ;
145OUTTR(IVMINT,IVMPAR,IVMST) ; - Transform IVMINT to a displayable value
146 ; Input: IVMINT -- internal value of demographic element
147 ; received from IVM
148 ; IVMPAR -- Zeroth node of the entry in file #301.92
149 ; for the demographic element IVMINT
150 ; IVMST -- [optional] pointer to the STATE (#5) file
151 ; Required to transform the county code
152 ; Output: IVMOUT -- Displayable value for IVMINT
153 ;
154 N IVMOUT,Z S IVMOUT=IVMINT
155 I $G(IVMINT)=""!($G(IVMPAR)="") S IVMOUT="" G OUTTRQ
156 ;
157 ; - use special transform for county
158 I $G(IVMST),$P(IVMPAR,"^",2)="PID12" S IVMOUT=$P($G(^DIC(5,IVMST,1,IVMINT,0)),"^")
159 ;
160 ; - transform the internal value if necessary
161 I $P(IVMPAR,"^",6) S IVMOUT=$$EXPAND($P(IVMPAR,"^",4),$P(IVMPAR,"^",5),IVMINT)
162 ;
163OUTTRQ Q IVMOUT
164 ;
165 ;
166EXPAND(FILE,FIELD,VALUE) ; - returns internal data in an output format
167 N Y,C S Y=VALUE
168 I 'FILE!('FIELD)!(VALUE="") G EXPQ
169 S Y=VALUE,C=$P(^DD(FILE,FIELD,0),"^",2) D Y^DIQ
170EXPQ Q Y
171 ;
172 ;
173GETPAT(DFN,IVMPAT) ;
174 ; Description: Used to obtain identifying information for a patient
175 ; in the PATIENT file and place it in the IVMPAT() array.
176 ;
177 ; Input:
178 ; DFN - ien of patient in PATIENT file
179 ;
180 ; Output:
181 ; Function Value - 1 on success, 0 on failure
182 ; IVMPAT - (pass by reference) On success, this array will contain
183 ; the patient identifing information. Array subscripts are:
184 ; "DFN" - ien PATIENT file
185 ; "NAME" - patient name
186 ; "SSN" - patient Social Security Number
187 ; "DOB" - patient date of birth (FM format)
188 ; "SEX" - patient sex
189 ;
190 N IVMNODE
191 Q:'$G(DFN) 0
192 K IVMPAT S IVMPAT=""
193 ;
194 ; obtain patient record
195 S IVMNODE=$G(^DPT(DFN,0))
196 Q:IVMNODE="" 0
197 ;
198 S IVMPAT("DFN")=DFN
199 S IVMPAT("NAME")=$P(IVMNODE,"^")
200 S IVMPAT("SEX")=$P(IVMNODE,"^",2)
201 S IVMPAT("DOB")=$P(IVMNODE,"^",3)
202 S IVMPAT("SSN")=$P(IVMNODE,"^",9)
203 Q 1
204 ;
205LOOKUP(SSN,DOB,SEX,ERROR) ;
206 ;Description: This function will do a search for the patient based on
207 ;the identifying information provided. The function will be successful
208 ;only if a single patient is found matching the identifiers provided.
209 ;
210 ;Inputs:
211 ; SSN - patient Social Security Number
212 ; DOB - patient date of birth (FM format)
213 ; SEX - patient sex
214 ;Outputs:
215 ; Function Value - patient DFN if successful, 0 otherwise
216 ; ERROR - if unsuccessful, an error message is returned (optional, pass by reference)
217 ;
218 N DFN,NODE
219 ;
220 S DFN=$O(^DPT("SSN",SSN,0))
221 I 'DFN S ERROR="SSN NOT FOUND" Q 0
222 I $O(^DPT("SSN",SSN,DFN)) S ERROR="MULTIPLE PATIENTS MATCHING SSN" Q 0
223 S NODE=$G(^DPT(DFN,0))
224 I $P(NODE,"^",2)'=SEX S ERROR="SEX DOES NOT MATCH" Q 0
225 I $E($P(NODE,"^",3),1,3)'=$E(DOB,1,3) S ERROR="DOB DOES NOT MATCH" Q 0
226 I $E($P(NODE,"^",3),4,5),$E($P(NODE,"^",3),4,5)'=$E(DOB,4,5) S ERROR="DOB DOES NOT MATCH" Q 0
227 Q DFN
Note: See TracBrowser for help on using the repository browser.