source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCQ.m@ 846

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1IVMCQ ;ALB/KCL/AEG/GAH - API FOR FINANCIAL QUERIES ; 28-N0V-06
2 ;;2.0;INCOME VERIFICATION MATCH;**17,30,55,120**;21-OCT-94;Build 8
3 ;
4 ;
5OPT ; Entry point for stand-alone financial query option.
6 ;
7 N IVMQUIT
8 W !!,"This option allows queries to be sent to the Health Eligibility"
9 W !,"Center (HEC) for patients that require updated income information."
10 S IVMQUIT=0 F D EACH1 Q:IVMQUIT
11 Q
12 ;
13EACH1 ; Description: Used to send a financial query for each patient selected. from stand-alone option.
14 ;
15 N DFN,IVMERROR,IVMOK,IVMOUT,IVMQUE,IVMREPLY,Y
16 S DIC="^DPT(",DIC(0)="AEMQ"
17 W ! D ^DIC K DIC S DFN=+Y I Y<1 S IVMQUIT=1 G EACH1Q
18 ;
19 ; does patient need a financial query?
20 I '$$NEED(DFN,1,.IVMERROR) W !!,"A financial query can not be sent for this patient!" W !,IVMERROR G EACH1Q
21 ;
22 ; ask if okay to send query?
23 I '$$ASK(.IVMOK)!($G(IVMOK)) G EACH1Q
24 ;
25 ; notify when a reply to query is received?
26 S IVMREPLY=$$NOTIFY(.IVMOUT)
27 I $G(IVMOUT) G EACH1Q
28 ;
29 ; send query for patient, else write error
30 I $$QUERY^IVMCQ1(DFN,$G(DUZ),$G(IVMREPLY),$G(XQY),.IVMERROR,1) W !!,"Financial query sent ..."
31 E D
32 .W !!,"Failure to send query: ",IVMERROR
33 ;
34EACH1Q Q
35 ;
36 ;
37REG(DFN) ; Entry point to automatically send a query to HEC for updated financial information.
38 ;
39 ; This entry point is called from hooks in registration:
40 ; - Register a Patient option (DGREG)
41 ; - Load/Edit Patient Data option (DG10)
42 ;
43 ; Input:
44 ; DFN - IEN of patient record in PATIENT file
45 ;
46 ; Output: none
47 ;
48 I '$G(DFN) G REGQ
49 I '$$NEED(DFN) G REGQ
50 I $$QUERY^IVMCQ1(DFN,$G(DUZ),0,$G(XQY),,1) W !!,"Financial query sent ..."
51REGQ Q
52 ;
53 ;
54APPT ; Entry point for IVM SEND FINANCIAL QUERY protocol.
55 ;
56 ; Input:
57 ; SDAMEVT - IEN of record in APPOINTMENT TRANSACTION TYPE file.
58 ; (Transaction type that can occur against an appointment)
59 ; SDATA - Array passed from the [SDAM APPOINTMENT EVENTS]
60 ; extended protocol. 2nd piece of SDATA is IEN of patient
61 ; record in PATIENT file.
62 ;
63 ; Output: none
64 ;
65 N DFN
66 ;
67 ; quit if supported Sched vars not defined
68 I '$D(SDAMEVT) G APPTQ
69 S DFN=$P($G(SDATA),"^",2)
70 I 'DFN G APPTQ
71 ;
72 ; quit if transaction type not (make appt, check-in, check-out)
73 I SDAMEVT'=1,(SDAMEVT'=4),(SDAMEVT'=5) G APPTQ
74 ;
75 ; does patient need query sent?
76 I '$$NEED(DFN,1) G APPTQ
77 ;
78 ; send query for patient
79 I $$QUERY^IVMCQ1(DFN,$G(DUZ),0,$G(XQY),,1)
80 ;
81APPTQ Q
82 ;
83 ;
84ASK(IVMTOUT) ; Ask user if ok to send financial query for patient.
85 ;
86 ; Input: none
87 ;
88 ; Output:
89 ; Function Value: 1=Yes and 0=No
90 ; IVMTOUT (pass by reference) 1=Timeout or up-arrow
91 ;
92 N DIR,DIRUT,DTOUT,DUOUT,X,Y
93 W !
94 S DIR("A")="Would you like to send a financial query for this patient"
95 S DIR("B")="YES"
96 S DIR(0)="Y"
97 W ! D ^DIR
98 I $D(DTOUT)!($D(DUOUT)) S IVMTOUT=1
99 Q +$G(Y)
100 ;
101 ;
102NOTIFY(IVMOUT) ; Ask if user should be notified when a reply to query is received.
103 ;
104 ; Input: none
105 ;
106 ; Output:
107 ; Function Value: 1=Yes and 0=No
108 ; IVMOUT (pass by reference) 1=Timeout or up-arrow
109 ;
110 N DIR,DTOUT,DUOUT,X,Y
111 S DIR("A")="Do you want to be notified when a query reply is received"
112 S DIR("B")="YES"
113 S DIR(0)="Y"
114 W ! D ^DIR
115 I $D(DTOUT)!($D(DUOUT)) S IVMOUT=1
116 Q +$G(Y)
117 ;
118 ;
119NEED(DFN,IVMSENT,ERROR) ; Description: Used to determine if a financial query should be sent for a patient.
120 ;
121 ; Input:
122 ; DFN - ien of patient record in PATIENT file
123 ; IVMSENT - (optional) Check if query sent on same day 0=>No|1=>Yes
124 ; Output:
125 ; Function Value: Does pt. need a query? 1 on success, 0 on failure
126 ; ERROR - If failure, return the reason for not sending
127 ; the query (pass by reference)
128 ;
129 N DGMSGF,DGADDF,DGREQF,IVMBT,IVML,SUCCESS
130 N IVMDOD
131 ;
132 S SUCCESS=0,(DGMSGF,DGADDF)=1
133 I '$D(IVMSENT) S IVMSENT=1
134 ; Can this patient be identified?
135 I '$G(DFN) S ERROR="PATIENT CAN NOT BE IDENTIFIED" G NEEDQ
136 ; is this patient deceased?
137 S IVMDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
138 I IVMDOD]"" S ERROR="Patient Expired on "_$$GET1^DIQ(2,DFN_",",.351,"E")_". Financial query unnecessary." G NEEDQ
139 ; Check to see if this patient is currently on a DOM ward.
140 D DOM^DGMTR I $G(DGDOM) D G NEEDQ
141 .S ERROR="PATIENT CURRENTLY A DOMICILIARY PATIENT - "
142 .S ERROR=ERROR_"QUERY NOT REQUIRED"
143 .K DGDOM
144 .Q
145 ; Check for PRIMARY test either MEANS or Copay exemption.
146 S IVML=$$LST^DGMTCOU1(DFN,DT_.2359,3)
147 ; If no primary test on file check to see if patient requires a means
148 ; test or copay exemption test. Call to DGMTR invokes EN^DGMTCOR as
149 ; well.
150 I IVML']"" D EN^DGMTR I +$G(DGREQF) S SUCCESS=1 G NEEDQ
151 ;
152 ; If current test is not incomplete and not required and is less than
153 ; 365 days old, presume a current test exists, no query necessary.
154 I ($P(IVML,U,4)'="I")&($P(IVML,U,4)'="R"),'$$OLD^DGMTU4($P(IVML,U,2)) D G NEEDQ
155 .S ERROR="PATIENT HAS A CURRENT "_$S($P(IVML,U,5)=1:"MEANS",$P(IVML,U,5)=2:"COPAY EXEMPTION",1:"MEANS")_" TEST ON FILE"
156 .Q
157 ;
158 ; If the current test is NO LONGER REQUIRED or NO LONGER APPLICABLE no
159 ; query is necessary.
160 I ($P(IVML,U,4)="N")!($P(IVML,U,4)="L") D G NEEDQ
161 .S ERROR="PATIENT'S "_$S($P(IVML,U,5)=1:"MEANS",$P(IVML,U,5)=2:"COPAY EXEMPTION",1:"MEANS")_" TEST STATUS "_$P(IVML,U,3)_"."
162 .Q
163 ;
164 ; If current test is not REQUIRED and not NO LONGER REQUIRED and it is
165 ; older than 365 days, initiate query.
166 I ($P(IVML,U,4)'="R")&($P(IVML,U,4)'="N"),$$OLD^DGMTU4($P(IVML,U,2)) S SUCCESS=1 G NEEDQ
167 ;
168 ; If a query is pending, don't send another.
169 I $$OPEN^IVMCQ2(DFN) S ERROR="A QUERY IS ALREADY PENDING FOR THIS PATIENT" G NEEDQ
170 ;
171 ; if a query has already been sent today, don't send another.
172 I IVMSENT,$$SENT^IVMCQ2(DFN) S ERROR="A QUERY HAS BEEN SENT FOR PATIENT TODAY" G NEEDQ
173 ;
174 ; Has a bene travel cert been filed with a year?
175 S IVMBT=$O(^DGBT(392.2,"C",DFN,0))
176 I IVMBT,$$FMDIFF^XLFDT(DT,+$G(^DGBT(392.2,IVMBT,0))\1)>330 S SUCCESS=1 G NEEDQ
177 ;
178 S ERROR="A FINANCIAL QUERY IS NOT REQUIRED FOR THIS PATIENT"
179 ;
180NEEDQ Q SUCCESS
Note: See TracBrowser for help on using the repository browser.