source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTL6.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1EASMTL6 ; ALB/SCK,BRM,LBD,PHH - AUTOMATED MEANS TEST LETTER-INTERACTIVE PRINT ; 5/22/03 9:52am
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,25,22,54**;MAR 15,2001
3 ;
4EN ; Main entry point
5 ; Input, set in option call, if not passed in, or called interactively, user is asked to specify.
6 ; EATYP - Used for selective printing of letters and forms
7 ; 1 : 60-Day
8 ; 2 : 30-Day
9 ; 4 : 0-Day
10 ;
11 N DIR,DIRUT,POP,EASLOC,Y
12 ;
13 ;; Select type of letter to print
14 I '$G(EATYP) D Q:$D(DIRUT)
15 . S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
16 . S DIR("?")="Select the type of letter to print"
17 . D ^DIR K DIR
18 . S EATYP=+Y
19 ;
20 ;; Select facility filter if appropriate
21 S EASLOC=-1
22 I $$GET1^DIQ(713,1,8,"I") D Q:$D(DIRUT)
23 . S DIR(0)="YAO",DIR("A")="Filter letters by Preferred Facility? "
24 . S DIR("B")="NO"
25 . S DIR("?")="Enter 'YES' to limit letters to a specific Facility or 'NO' to print all letters."
26 . D ^DIR K DIR
27 . Q:$D(DIRUT)!('Y)
28 . S EASLOC=$$FACNUM
29 ;
30 K IOP,IO("Q")
31 ;
32 S %ZIS="QP",%ZIS("B")=$$GET1^DIQ(713,1,5)
33 D ^%ZIS K %ZIS
34 Q:POP
35 I $D(IO("Q")) D QUE Q
36 D LTR
37 D ^%ZISC
38 K EATYP
39 Q
40 ;
41QUE ; Queue the report
42 N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED
43 ;
44 S ZTRTN="LTR^EASMTL6"
45 S ZTDESC="EAS MT LETTERS PRINT JOB"
46 S ZTSAVE("EATYP")="",ZTSAVE("EASLOC")=""
47 S ZTDTH="NOW"
48 ;
49 D ^%ZTLOAD
50 I $D(ZTSK)[0 W !!?5,"Letters canceled!"
51 E W !!?5,"Letters queued! [ ",ZTSK," ]"
52 D HOME^%ZIS
53 Q
54 ;
55LTR ; Main entry point
56 N EASTMP,EASKP
57 ;
58 S EASTMP="^TMP(""EASMT"",$J)"
59 K @EASTMP
60 ;
61 I '$D(ZTQUEUED) W !,"...Gathering letters to print...Please wait"
62 D BLD(EATYP,EASLOC,EASTMP,.EASKP)
63 D RESULT(.EASKP,EATYP)
64 I '$D(ZTQUEUED) W !,"...Printing letters..."
65 D PRINT(EASTMP,EATYP)
66 K @EASTMP,EATYP
67 Q
68 ;
69RESULT(EASKP,EATYP) ; Send results of letter printing to mail group
70 N MSG,XMSUB,XMY,XMTEXT,XMDUZ,TOT,X1
71 ;
72 S MSG(1)="Letters to print: "_$J($FN(EASKP("CNT"),","),8)
73 S MSG(2)="Letters where the print date has not reached: "_$J($FN(EASKP("T"),","),8)
74 S MSG(2.5)=""
75 S MSG(3)="The following letters were found but not printed for the following reasons:"
76 S MSG(4)="Incomplete/Bad Addr : "_$J($FN(EASKP("I"),","),8)
77 S MSG(5)="Deceased : "_$J($FN(EASKP("D"),","),8)
78 S MSG(6)="MT Changed: "_$J($FN(EASKP("C"),","),8)
79 S MSG(7)="Prohibit flag set: "_$J($FN(EASKP("P"),","),8)
80 S MSG(8)="Not a User Enrollee: "_$J($FN(EASKP("U"),","),8)
81 S MSG(8.5)="Not a User Enrollee of this facility: "_$J($FN(EASKP("O"),","),8)
82 S MSG(9)=""
83 S TOT=0 F X1="I","D","C","P","O","T","U","CNT" S TOT=TOT+EASKP(X1)
84 S MSG(10)="Total Letters Processed: "_$J($FN(TOT,","),8)_" (MT not returned)"
85 ;
86 S XMSUB=$S(EATYP=1:"60-Day",EATYP=2:"30-Day",1:"0-Day")_" Print Letter Results"
87 S XMTEXT="MSG("
88 S XMY("G.EAS MTLETTERS")=""
89 S XMDUZ="AUTOMATED MT LETTERS"
90 D ^XMD
91 Q
92 ;
93BLD(EATYP,EASLOC,EASTMP,EASKP) ; Build TMP array of letters to print
94 N DFN,EASIEN,COUNT,EAX2,EASPTR,EASABRT,EASUE
95 ;
96 F EAX2="P","D","C","F","T","I","O","U","CNT" S EASKP(EAX2)=0
97 S COUNT=0
98 ;
99 S EASIEN=0 ; Begin loop through un-returned means tests
100 F S EASIEN=$O(^EAS(713.2,"AC",0,EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
101 . S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I") ; Pointer to File 713.1
102 . ; begin checks
103 . Q:EASPTR<0 ; SAFETY CHECK
104 . Q:$$LTRTYP^EASMTL6B(EASIEN)'=EATYP ; Check for appropriate letter type
105 . S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I") Q:'DFN
106 . ;; Filter by site, quit if filter not met
107 . I +$G(EASLOC)>0 Q:$$GET1^DIQ(2,DFN,27.02,"I")'=+EASLOC
108 . I $D(^EAS(713.1,"AP",1,EASPTR)) D Q ; Check Prohibit letter
109 . . D CLRFLG^EASMTUTL(0,EASIEN)
110 . . S EASKP("P")=EASKP("P")+1
111 . I $$DECEASED^EASMTUTL(EASIEN) D Q ; Check Deceased
112 . . D CLRFLG^EASMTUTL(0,EASIEN)
113 . . S EASKP("D")=EASKP("D")+1
114 . I $$CHECKMT^EASMTUTL(EASPTR,EASIEN) D Q ; Check MT changed?
115 . . D CLRFLG^EASMTUTL(0,EASIEN)
116 . . S EASKP("C")=EASKP("C")+1 Q
117 . I $$FUTMT^EASMTUTL(EASIEN) D Q ; Check for a Future MT
118 . . D CLRFLG^EASMTUTL(0,EASIEN)
119 . . S EASKP("F")=EASKP("F")+1
120 . I '$$THRSHLD(EATYP,EASIEN) D Q ; Quit if letter threshold not reached
121 . . S EASKP("T")=EASKP("T")+1
122 . ; Get User Enrollee status (0=not UE; 1=UE; 2=UE, not this site)
123 . S EASUE=$$UESTAT^EASUER(DFN)
124 . I 'EASUE D Q ; Quit if not User Enrollee
125 . . D NOPRT(EATYP,EASIEN)
126 . . S EASKP("U")=EASKP("U")+1
127 . I EASUE'=1 D Q ; Quit if User Enrollee site is not this facility
128 . . D NOPRT(EATYP,EASIEN)
129 . . S EASKP("O")=EASKP("O")+1
130 . I $$CHKADR^EASMTL6A(EASPTR) D Q ; Check for valid address
131 . . S EASKP("I")=EASKP("I")+1
132 . S @EASTMP@(EASIEN)=EATYP ; Build entry
133 . S EASKP("CNT")=EASKP("CNT")+1
134 . I $D(IO("Q")),$$S^%ZTLOAD("STOPPED BY USER") S EASABRT=1
135 Q
136 ;
137OWNED(PTR1,EAIEN) ; Check - Does this facility "own" this means test
138 ; Returns '1' if means test 'owned' by facility
139 ; '0' if not owned
140 ;
141 N MTNODE,MTLST,MTOWN,RSLT
142 ;
143 S RSLT=0
144 S MTLST=$$LST^DGMTU(PTR1)
145 I $P(MTLST,U,1)>0 D
146 . S MTNODE=$G(^DGMT(408.31,$P(MTLST,U,1),0))
147 . S MTOWN=$$GET1^DIQ(408.34,$P(MTNODE,U,23),.01)
148 . I MTOWN="VAMC" S RSLT=1 Q
149 . I MTOWN="DCD",$$VERSION^XPDUTL("IVMC") S RSLT=1
150 ;
151 ;; If another facility 'owns' this MT, update MT Status information
152 I 'RSLT D
153 . Q:'EAIEN
154 . S DIE="^EAS(713.2,",DA=EAIEN
155 . S DR="4///YES;5///TODAY;7///MT 'OWNED' BY ANOTHER FACILITY;9///NO;12///NO;18///NO"
156 . D ^DIE K DIE
157 ;
158 Q RSLT
159 ;
160PRINT(EASTMP,EATYP) ; Print letters
161 N EASIEN,EASABRT,Y
162 ;
163 U IO
164 S EASIEN=0
165 F S EASIEN=$O(@EASTMP@(EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
166 . D LETTER^EASMTL6A(EASIEN,EATYP) ; Print letter
167 . D UPDSTAT(EASIEN,EATYP) ; Update Letter status file, #713.2
168 . I $D(IO("Q")),$$S^%ZTLOAD("STOPPED BY USER") S EASABRT=1 Q
169 . I '$D(IO("Q")),$E(IOST,1,2)="C-" D
170 . . S DIR(0)="E"
171 . . D ^DIR K DIR
172 . . S:'Y EASABRT=1
173 Q
174 ;
175THRSHLD(EATYP,EASIEN) ; Check threshold for letter types
176 ; Input
177 ; EATYP - Letter type to print
178 ; EASIEN - IEN for file #713.2
179 ;
180 ; Output
181 ; RSLT = 1: Letter is inside threshold to print
182 ; 0: Letter is outside threshold (Don't print)
183 ;
184 N DIFF,THRESH,RSLT,ANVDT,MTDT
185 ;
186 S RSLT=1
187 Q:'$G(EATYP)
188 S THRESH=$S(EATYP=1:60,EATYP=2:30,1:0)
189 S MTDT=$$GET1^DIQ(713.2,EASIEN,3,"I")
190 S ANVDT=$$ADDLEAP^EASMTUTL(MTDT)
191 S DIFF=$$FMDIFF^XLFDT(ANVDT,$$DT^XLFDT)
192 I DIFF>THRESH S RSLT=0
193 Q RSLT
194 ;
195NOPRT(EATYP,EASIEN) ; Letter not printed, update Letter Status file #713.2
196 ; Input
197 ; EATYP - Letter type to print
198 ; EASIEN - IEN for file #713.2
199 ;
200 N DIE,DR,DA,LTR
201 Q:'$G(EATYP) Q:'$G(EASIEN)
202 S DIE="^EAS(713.2,",DA=EASIEN
203 S LTR=$S(EATYP=1:9,EATYP=2:12,EATYP=4:18,1:0)
204 Q:'LTR
205 ; Set current letter print statuses = "N"
206 S DR=LTR_"///0;"_(LTR+1)_"///0"
207 ; If current letter is not 0-day letter, set next letter print = "Y"
208 S:LTR'=18 DR=DR_";"_$S(LTR=9:12,1:18)_"///1"
209 D ^DIE
210 Q
211 ;
212UPDSTAT(EASN,EAX) ; Update Letter status file, #713.2
213 N DIE,DR,DA,EAPD,EAFLG,NXTFLG
214 ;
215 S DIE="^EAS(713.2,",DA=EASN
216 S DR=$S(EAX=1:10,EAX=2:13,EAX=4:19,1:0)
217 Q:'DR
218 S EAPD=DR_".5",EAFLG=DR-1
219 S DR=DR_"///1;"_EAPD_"///^S X=$$DT^XLFDT;"_EAFLG_"///0"
220 S NXTFLG=$S(EAFLG=9:12,EAFLG=12:18,1:0)
221 S:NXTFLG>0 DR=DR_";"_NXTFLG_"///1"
222 D ^DIE K DIE
223 D CLRFLG^EASMTUTL(EAX,EASN)
224 Q
225 ;
226FACNUM() ; Get facility number
227 N RSLT,DIR,Y
228 ;
229 S DIR(0)="P^4:EMZ"
230 S DIR("S")="I '$P($G(^DIC(4,Y,99)),U,4)"
231 D ^DIR K DIR
232 I $D(DIRUT) S RSLT=0
233 E S RSLT=+Y_"^"_$P($G(^DIC(4,+Y,99)),U,1)
234 ;
235 Q RSLT
236 ;
237GETFAC(EADFN,EASARY) ; set facility return address information
238 N EASFAC,EAX,EASF,EAS4
239 ;
240 I $$GET1^DIQ(713,1,9,"I") D
241 . S EASFAC=$$GET1^DIQ(2,EADFN,27.02,"I")
242 . Q:'EASFAC
243 . ;; Check for inactive flag
244 . Q:$$GET1^DIQ(4,EASFAC,101,"I")
245 . D GETS^DIQ(4,EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
246 . S EASF=EASFAC_","
247 . ;; Check for valid address information
248 . I EAS4(4,EASF,1.01,"E")]"",EAS4(4,EASF,1.03,"E")]"",EAS4(4,EASF,.02,"E")]"" S EASARY("TYP")="P"
249 ;
250 I $G(EASARY("TYP"))'="P" D
251 . S EASFAC=$$SITE^VASITE
252 . D GETS^DIQ(4,+EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
253 . S EASARY("TYP")="F"
254 ;
255 S EASARY("FACNUM")=+EASFAC
256 S EASARY("FAC")=$$GET1^DIQ(4,+EASFAC,.01,"I")
257 F EAX=1.01,1.02,1.03,1.04,100 D
258 . S EASARY(EAX)=EAS4(4,+EASFAC_",",EAX,"E")
259 S EASARY(.02)=EAS4(4,+EASFAC_",",.02,"E")_"^"_$$GET1^DIQ(5,EAS4(4,+EASFAC_",",.02,"I"),1)
260 Q
Note: See TracBrowser for help on using the repository browser.