source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTUTL.m@ 701

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1EASMTUTL ; ALB/SCK/BRM/PHH - AUTOMATED MEANS TEST LETTERS UTILITIES ; 7/2/01
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,22,54**;MAR 15,2001
3 ;
4 ;
5PAUSE ; Screen pause, user must press key to continue
6 S DIR(0)="FAO",DIR("A")="Press any key to continue..."
7 D ^DIR K DIR
8 Q
9 ;
10CLRFLG(EAX,DA) ; Clears flags in File #713.2, For development
11 N DIE,DR
12 ;
13 Q:EAX=1
14 S:EAX=2 DR="9///0"
15 S:EAX=3 DR="9///0;12///0"
16 S:EAX=4 DR="9///0;12///0"
17 S:EAX=0 DR="9///0;12///0;18///0"
18 S DIE="^EAS(713.2,"
19 D ^DIE K DIE
20 Q
21 ;
22LOCK(ACTION) ; Flag IN USE field in EAS Parameters file, #713
23 ; Input
24 ; ACTION - Locking action
25 ; 1 = Flag IN USE for Automated Generator is running
26 ; 0 = Flag IN USE for Automated Generator is not running
27 ; Output
28 ; 1 if action was successful
29 ; 0 if action was not successful
30 N RSLT
31 ;
32 I ACTION,$D(^EAS(713,"ALOCK",1)) Q $G(RSLT)
33 ;
34 S DIE="^EAS(713,",DA=1,DR="30////^S X=ACTION"
35 D ^DIE K DIE
36 S RSLT=1
37 Q +$G(RSLT)
38 ;
39ALERT(ERRMSG) ; Post an alert message to the EAS Letters Mail group
40 N XMY,XMTEXT,XMDUZ,XMSUB,MSG
41 ;
42 S MSG(1)="Notification:"
43 S MSG(2)=ERRMSG
44 ;
45 S XMY("G.EAS MTLETTERS")=""
46 S XMTEXT="MSG("
47 S XMDUZ="EAS Auto MT Letters"
48 S XMSUB="EAS Means Test Letter's Notice"
49 D ^XMD
50 Q
51 ;
52ADRERR(EASADD,DFN) ; Error notification for missing or invalid patient address
53 N MSG,XMY,XMTEXT,XMDUZ,XMSUB,VAROOT,EASDEM,VA,EASPRF
54 ;
55 S VAROOT="EASDEM"
56 D DEM^VADPT
57 D PID^VADPT6
58 S EASPRF=$$GET1^DIQ(2,DFN,27.02)
59 I EASPRF']"" S EASPRF="No Preferred Facility"
60 ;
61 S MSG(1)="The following patient does not have a complete permanent mailing"
62 S MSG(2)="address. A means test reminder letter could not be mailed."
63 S MSG(3)=" "
64 S MSG(4)=" Patient : "_EASDEM(1)
65 S MSG(5)=" Last 4 : "_VA("BID")
66 S MSG(6)="Address Line 1 : "_EASADD(1)
67 S MSG(7)=" City : "_EASADD(4)
68 S MSG(8)=" State : "_$P(EASADD(5),U,2)
69 S MSG(9)=" Zipcode : "_$P(EASADD(11),U,2)
70 S MSG(9.5)=" Bad Addr : "_$P(EASADD("BAI"),U,2)
71 S MSG(10)=""
72 S MSG(11)=" DFN : "_$G(DFN)
73 S MSG(13)=""
74 S MSG(14)="This patient's letter entry will stay in 'FLAGGED-TO-PRINT' status until"
75 S MSG(15)="the address is corrected."
76 ;
77 I +EASADD(9)>0!(+EASADD(10)>0) D
78 . S MSG(5.5)="** Temporary Address in effect **"
79 S XMY("G.EAS MTLETTERS")=""
80 S XMTEXT="MSG("
81 S XMDUZ="EAS Auto MT Letters"
82 S XMSUB="Incomplete/Bad Addr: "_EASPRF
83 D ^XMD
84 Q
85 ;
86CLRLCK ; Clears IN USE field of the EAS MT PARAMETERS if an error occurs and locks the field
87 N DIE,DR,DA
88 ;
89 S DA=1,DIE="^EAS(713,",DR="30///0"
90 D ^DIE
91 Q
92 ;
93PROHBIT ; Set or delete the Prohibit fields in the Patient Status file, #713.1
94 N DIR,DIRUT,EASF,Y,X,EASIEN,DFN,DGFDA,FDAIEN,ERRMSG
95 ;
96 S DIR(0)="S^S:Set Prohibit Flag;R:Remove Prohibit Flag"
97 S DIR("A")="Set or remove the MT Prohibit flag"
98 S DIR("?")="Select 'S' to set flag, 'R' to remove the flag"
99 D ^DIR K DIR
100 Q:$D(DIRUT)
101 S EASF=Y
102 ;
103 I EASF="R"!(EASF="r") D Q:$D(DIRUT)
104 . S DIR(0)="PAO^713.1:EMZ"
105 . S DIR("A")="Select Patient: "
106 . D ^DIR K DIR
107 . S EASIEN=+Y
108 ;
109 I EASF="S"!(EASF="s") D Q:$D(DIRUT)
110 . S DIR(0)="PAO^2:EMZ"
111 . S DIR("A")="Select Patient: "
112 . D ^DIR K DIR
113 . Q:$D(DIRUT)
114 . S DFN=+Y
115 . I '$D(^EAS(713.1,"B",DFN)) D Q:$D(DIRUT)
116 . . S DIR(0)="Y",DIR("B")="YES"
117 . . S DIR("A")="Add patient to the Patient Status File"
118 . . D ^DIR K DIR
119 . . Q:$D(DIRUT)
120 . . I 'Y S DIRUT=1 Q
121 . . S DGFDA(1,713.1,"+1,",.01)=DFN
122 . . D UPDATE^DIE("","DGFDA(1)","FDAIEN","ERRMSG")
123 . . S EASIEN=FDAIEN(1)
124 . I $D(^EAS(713.1,"B",DFN)) S EASIEN=$O(^EAS(713.1,"B",DFN,0))
125 ;
126 Q:'$G(EASIEN)
127 ;
128 N DGFDA,DGIEN,DGEFF,DIR,DIRUT,DGERR,DIE
129 ;
130 S DGIEN=EASIEN_","
131 I EASF="S" D
132 . S DIR(0)="DAO^"_$$DT^XLFDT_"::EX"
133 . S DIR("A")="Effective Date: "
134 . D ^DIR K DIR
135 . Q:$G(DIRUT)
136 . S DGFDA(1,713.1,DGIEN,3)=Y
137 . S DGFDA(1,713.1,DGIEN,2)=1
138 . S DGFDA(1,713.1,DGIEN,5)=$$NOW^XLFDT
139 . S DGFDA(1,713.1,DGIEN,4)=DUZ
140 . D:$D(DGFDA) FILE^DIE("","DGFDA(1)","DGERR")
141 . I $D(DGERR) D Q
142 . . D DSPLYER(.DGERR)
143 . S DIE="^EAS(713.1,",DA=EASIEN,DR="10"
144 . D ^DIE K DIE
145 ;
146 I EASF="R" D
147 . S DGFDA(1,713.1,DGIEN,2)=0
148 . S DGFDA(1,713.1,DGIEN,3)="@"
149 . S DGFDA(1,713.1,DGIEN,5)="@"
150 . S DGFDA(1,713.1,DGIEN,4)="@"
151 . S DGFDA(1,713.1,DGIEN,10)="@"
152 . D:$D(DGFDA) FILE^DIE("","DGFDA(1)","DGERR")
153 . I $D(DGERR) D
154 . . D DSPLYER(.DGERR)
155 . E W !!?3,"Prohibit Flag Removed from Patient.",!
156 ;
157 Q
158 ;
159DSPLYER(ERRARY) ;
160 N DGER
161 ;
162 W !!?3,"The following error(s) occurred:"
163 S DGER=0
164 F S DGER=$O(ERRARY("DIERR",DGER)) Q:'DGER D
165 . W !?3,ERRARY("DIERR",DGER)," - ",ERRARY("DIERR",DGER,"TEXT",1)
166 W !?3,"Please check, this record update may not have processed completely."
167 Q
168 ;
169EDTLTRS ;
170 N DIR,EASIEN
171 ;
172 S DIR(0)="P^713.3:EMZ"
173 S DIR("A")="Select Letter"
174 D ^DIR K DIR
175 Q:$D(DIRUT)
176 S EASIEN=+Y
177 ;
178 S DIE="^EAS(713.3,",DA=EASIEN,DR="4"
179 D ^DIE
180 Q
181 ;
182MTRTN ; Update the letter status file, #713.2, with returned Means Test information
183 N DIE,DIC,EASIEN,DR,DA,Y
184 ;
185 S DIC="^EAS(713.2,",DIC(0)="AEQM",DIC("A")="Select the Letter Status entry to update: "
186 D ^DIC K DIC
187 Q:Y<0
188 S EASIEN=+Y
189 ;
190 S DIE="^EAS(713.2,",DA=EASIEN
191 S DR="4;I X=0 S Y=0;5;7;6////^S X=DUZ;9///0;12///0;18///0"
192 L +^EAS(713.2,EASIEN):0 I $T D
193 . D ^DIE K DIE
194 E W !,$CHAR(7),"Entry is being edited by another user."
195 L -^EAS(713.2,EASIEN)
196 ;
197 Q
198 ;
199DECEASED(EASIEN,DFN) ; Check deceased status for patient
200 N RSLT,EADEM,EAS1,VAROOT
201 ;
202 S EASIEN=$G(EASIEN)
203 S DFN=$G(DFN)
204 I EASIEN>0 D
205 . S EAS1=$$GET1^DIQ(713.2,EASIEN,2,"I")
206 . S DFN=$$GET1^DIQ(713.1,EAS1,.01,"I")
207 Q:'DFN 0
208 S RSLT=0
209 ;
210 S VAROOT="EADEM"
211 D DEM^VADPT
212 S:+EADEM(6) RSLT=1
213 D KVA^VADPT
214 Q RSLT
215 ;
216CHECKMT(EASPT,EAIEN) ; Check current MT status
217 N DFN,RTN,EACHK,DIE,DR,DA
218 ;
219 S RTN=0
220 I '$G(EASPT) S RTN=1 G CHKQ ; Safety check
221 S DFN=$$GET1^DIQ(713.1,EASPT,.01,"I") ; Get DFN
222 I '$G(DFN) S RTN=1 G CHKQ ; Safety check
223 ;
224 S EACHK=$$MTCHK^EASMTCHK(DFN,"L") ; Check current MT to see if it's changed
225 I 'EACHK D ; If MT no longer required, update letter status file
226 . S DIE="^EAS(713.2,",DA=EAIEN
227 . S DR="4///YES;5///TODAY;7///AUTO-GENERATED;9///NO;12///NO;18///NO"
228 . D ^DIE K DIE ;; Remove before release
229 . S RTN=1
230 ;
231CHKQ Q RTN
232 ;
233FUTMT(EASIEN) ; Check for a future MT
234 ; Input
235 ; EASIEN - IEN for record in Letter Status file
236 ;
237 ; Output
238 ; 1 - Future MT exist's (API call)
239 ; 0 - Future MT does not exist
240 ;
241 N EASPTR,DFN,EASFUT
242 ;
243 S RTN=0
244 S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
245 S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
246 ;
247 ;; Call API for future MT check
248 S EASFUT=$$FUT^DGMTU(DFN)
249 ;
250 I +$G(EASFUT) D ; Turn off letters if future MT present
251 . Q:'EASIEN
252 . S DIE="^EAS(713.2,",DA=EASIEN
253 . S DR="4///YES;5///TODAY;7///FUTURE MEANS TEST;9///NO;12///NO;18///NO"
254 . D ^DIE K DIE
255 . S RTN=1
256 Q RTN
257 ;
258TESTLTR ;
259 N EASIEN,EATYP,DIR,DIRUT,ZTSAVE
260 ;
261 S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
262 S DIR("A")="Select letter type to test"
263 S DIR("?")="Select the type of letter to print a test output of"
264 D ^DIR K DIR
265 Q:$D(DIRUT)
266 S EATYP=+Y
267 S EASIEN=-1
268 S ZTSAVE("EASIEN")="",ZTSAVE("EATYP")=""
269 D EN^XUTMDEVQ("ZTEST^EASMTUTL","EAS MT TEST LETTER",.ZTSAVE)
270 Q
271 ;
272TESTIT ;
273 D LETTER^EASMTL6A(EASIEN,EATYP)
274 Q
275 ;
276ZTEST ;
277 D LETTER^EASMTL6A(EASIEN,EATYP)
278 Q
279ADDLEAP(DATE) ; Adding a year with Leap Year checking
280 ; Input:
281 ; DATE - Date passed in.
282 ;
283 ; Output:
284 ; Date passed in plus one year (with leap year ck/adj).
285 ;
286 N YEAR
287 S YEAR=$E($$FMTHL7^XLFDT(DATE),1,4)
288 I $E(DATE,4,7)="0229",'$$LEAP^XLFDT3(YEAR+1) D
289 .S DATE=$$FMADD^XLFDT(DATE,-1)
290 Q $E(DATE,1,3)+1_$E(DATE,4,7)
291 ;
292SUBLEAP(DATE) ; Subtracting a year with Leap Year checking
293 ; Input:
294 ; DATE - Date passed in.
295 ;
296 ; Output:
297 ; Date passed in minus one year (with leap year ck/adj).
298 ;
299 N YEAR
300 S YEAR=$E($$FMTHL7^XLFDT(DATE),1,4)
301 I $E(DATE,4,7)="0229",'$$LEAP^XLFDT3(YEAR-1) D
302 .S DATE=$$FMADD^XLFDT(DATE,-1)
303 Q $E(DATE,1,3)-1_$E(DATE,4,7)
Note: See TracBrowser for help on using the repository browser.