source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS155PT.m@ 1427

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

initial load of WorldVistAEHR
File size: 6.5 KB
RevLine 
[613]1EAS155PT ;ALB/SCK - PATCH 55 USER ENROLLEE MT LETTER CLEANUP ; 9-AUG-04
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**55**;Mar 15, 2004
3 ;
4 Q
5 ;
6CHECK ;
7 N CURSTN,CURSITE,PRNT,PTYP
8 N MSG,XMDUZ,XMSUB,XMTEXT,XMY,XX
9 ;
10 S XMSUB="EAS*1*55 PARENT CHECK"
11 S XMDUZ="EAS*1*55"
12 S XMY(.5)="",XMY(DUZ)=""
13 S XMTEXT="MSG("
14 ;
15 S CURSITE=$P($$SITE^VASITE,U,3)
16 S CURSTN=$$STA^XUAF4(CURSITE)
17 S PRNT=$$PRNT^XUAF4(CURSITE)
18 S PTYP=$$GET1^DIQ(4,+PRNT,13)
19 ;
20 S MSG(1)="Current Site: "_CURSITE
21 S MSG(2)="Current Station: "_$$GET1^DIQ(4,CURSTN,.01)_" ("_CURSTN_")"
22 S MSG(3)="Parent Facility: "_$P(PRNT,U,3)
23 S MSG(4)="Parent Type: "_PTYP
24 S MSG(5)=""
25 I PTYP="HCS" D
26 . S MSG(6)="Because your parent facility type is ""HCS"", it's recommended that you run"
27 . S MSG(7)="the MT Letter cleanup at this time. Please refer to the patch for directions"
28 E D
29 . S MSG(6)="Your parent facility type does not appear to be of type ""HCS"". "
30 . S MSG(7)="It is not recommended that you run the MT letter cleanup at this time"
31 . S MSG(8)="If you are experiencing problems with the MT Letters, please contact EVS."
32 D MES^XPDUTL(.MSG)
33 D ^XMD
34 ;
35 Q
36 ;
37EN ; Que off the background task
38 N ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDH,MSG,ZTSAVE
39 ;
40 W !,"Preparing to run the EAS*1*55 MT Letters Cleanup"
41 W !,"After the cleanup, you will be sent a MailMan summary of the cleanup"
42 W !,"statistics. You will also be asked to select a printer to send the"
43 W !,"detailed results to. This report could be quite lengthy. Please "
44 W !,"DO NOT run the report to your screen!",!
45 D ^%ZIS
46 S ZTRTN="LETTERS^EAS155PT"
47 S ZTDH=$$NOW^XLFDT
48 S ZTSAVE("DUZ")=""
49 S ZTDESC="EAS155 MT LETTER CLEANUP FOR UE STATUS"
50 D ^%ZTLOAD
51 I $D(ZTSK) W !!?5,"Task: "_ZTSK_" Queued."
52 D HOME^%ZIS
53 Q
54 ;
55LETTERS ; Reflag those MT letters which need to be updated for UE Status update
56 N EASIEN,EASPTR,EASDFN,EASLTR,EASCNT,XX
57 ;
58 K ^TMP("EAS155P",$J)
59 S ^TMP("EAS155P",$J,"START")=$H,^TMP("EAS155P",$J,"COUNT")=0,^TMP("EAS155P",$J,"NOCHANGE")=0
60 ;
61 F XX="60D","30D","0D","OFF" S EASCNT(XX)=0
62 S EASIEN=0
63 F S EASIEN=$O(^EAS(713.2,"AC",0,EASIEN)) Q:'EASIEN D
64 . S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
65 . Q:$D(^EAS(713.1,"AP",1,EASPTR)) ; Quit if Letter Prohibit Flag set
66 . Q:$$DECEASED^EASMTUTL(EASIEN) ; Quit if patient deceased
67 . ; ** Safety check for bad patient pointers in 713.1
68 . Q:$$GET1^DIQ(713.2,EASIEN,2)']""
69 . D TESTLTR(EASIEN)
70 ;
71 S ^TMP("EAS155P",$J,"END")=$H
72 D MAIL
73 D REPORT
74 Q
75 ;
76TESTLTR(EASIEN) ; Test letter conditions
77 N NODE6,NODE4,NODEZ,IENS,FDA,FIN
78 ;
79 S ^TMP("EAS155P",$J,"COUNT")=^TMP("EAS155P",$J,"COUNT")+1
80 ; Piece 1: Threshold date, Piece 2: Flag-to-print, Piece 3: Letter Printed?, Piece 4: Date printed
81 S NODE6=$G(^EAS(713.2,EASIEN,6))
82 S NODE4=$G(^EAS(713.2,EASIEN,4))
83 S NODEZ=$G(^EAS(713.2,EASIEN,"Z"))
84 ;
85 ; Check 1, check if letters have been completely turned off, No flags to print and no letters printed. Turn back on most appropriate letter.
86 I '$P(NODE6,U,3),'$P(NODE4,U,3),'$P(NODEZ,U,3) D Q:$G(FIN)
87 . I '$P(NODE6,U,2),'$P(NODE4,U,2),'$P(NODEZ,U,2) D
88 . . I $P(NODEZ,U)<DT D Q
89 . . . S EASCNT("0D")=EASCNT("0D")+1
90 . . . S ^TMP("EAS155P",$J,"0D",EASIEN)=""
91 . . . S FDA(1,713.2,EASIEN_",",18)="YES"
92 . . . S FDA(1,713.2,EASIEN_",",9)="NO"
93 . . . S FDA(1,713.2,EASIEN_",",12)="NO",FIN=1
94 . . . D FILE^DIE("E","FDA(1)")
95 . . I $P(NODE4,U)<DT D Q
96 . . . S EASCNT("30D")=EASCNT("30D")+1
97 . . . S ^TMP("EAS155P",$J,"30D",EASIEN)=""
98 . . . S FDA(1,713.2,EASIEN_",",12)="YES"
99 . . . S FDA(1,713.2,EASIEN_",",9)="NO"
100 . . . S FDA(1,713.2,EASIEN_",",18)="NO",FIN=1
101 . . . D FILE^DIE("E","FDA(1)")
102 . . S EASCNT("60D")=EASCNT("6OD")+1
103 . . S ^TMP("EAS155P",$J,"60D",EASIEN)=""
104 . . S FDA(1,713.2,EASIEN_",",9)="YES"
105 . . S FDA(1,713.2,EASIEN_",",12)="NO"
106 . . S FDA(1,713.2,EASIEN_",",18)="NO",FIN=1
107 . . D FILE^DIE("E","FDA(1)")
108 ;
109 ; Check 2, check if 60d ltrs have not been printed, but 30d ltrs are flagged to print.
110 I '$P(NODE6,U,3)&($P(NODE4,U,2))&($P(NODE4,U,1)>DT) D Q:$G(FIN)
111 . S EASCNT("60D")=EASCNT("60D")+1
112 . S ^TMP("EAS155P",$J,"60D",EASIEN)=""
113 . S FDA(1,713.2,EASIEN_",",9)="YES"
114 . S FDA(1,713.2,EASIEN_",",12)="NO"
115 . D FILE^DIE("E","FDA(1)")
116 . S FIN=1
117 ;
118 ; Check 3, if the 60d ltr has been printed AND the 30d ltr has not AND the
119 ; 0d ltr is flagged to print.
120 I $P(NODE6,U,3)&('$P(NODE4,U,3))&($P(NODEZ,U,2))&($P(NODEZ,U,1)>DT) D Q:$G(FIN)
121 . S EASCNT("30D")=EASCNT("30D")+1
122 . S ^TMP("EAS155P",$J,"30D",EASIEN)=""
123 . S FDA(1,713.2,EASIEN_",",12)="YES"
124 . S FDA(1,713.2,EASIEN_",",18)="NO"
125 . D FILE^DIE("E","FDA(1)")
126 . S FIN=1
127 ;
128 ; Check 4, if the 30d ltr has been printed and the 0d has not AND is not flagged.
129 I $P(NODE4,U,3)&('$P(NODEZ,U,3))&('$P(NODEZ,U,2)) D Q
130 . S EASCNT("0D")=EASCNT("0D")+1
131 . S ^TMP("EAS155P",$J,"0D",EASIEN)=""
132 . S FDA(1,713.2,EASIEN_",",18)="YES"
133 . D FILE^DIE("E","FDA(1)")
134 ;
135 S ^TMP("EAS155P",$J,"NOCHANGE")=^TMP("EAS155P",$J,"NOCHANGE")+1
136 Q
137 ;
138UPD(FDA) ; Update file entry
139 N ERR
140 ;
141 D FILE^DIE("E","FDA(1)","ERR")
142 Q
143 ;
144MAIL ;
145 N MSG,XMDUZ,XMSUB,XMTEXT,XMY,XX
146 ;
147 S (XMDUZ,XMSUB)="EAS*1*55 CLEANUP"
148 S XMY(.5)="",XMY(DUZ)=""
149 S XMTEXT="MSG("
150 S MSG(10)="Begin: "_$$HTE^XLFDT(^TMP("EAS155P",$J,"START"))
151 S MSG(20)="End: "_$$HTE^XLFDT(^TMP("EAS155P",$J,"END"))
152 S MSG(30)="Processing Time: "_$$HDIFF^XLFDT(^TMP("EAS155P",$J,"END"),^TMP("EAS155P",$J,"START"),3)
153 S MSG(31)=""
154 S MSG(35)=" Turned Off: "_EASCNT("OFF")
155 S MSG(40)="60-Day Letters: "_EASCNT("60D")
156 S MSG(50)="30-Day Letters: "_EASCNT("30D")
157 S MSG(60)=" 0-Day Letters: "_EASCNT("0D")
158 S MSG(65)=""
159 S MSG(70)="No action required: "_^TMP("EAS155P",$J,"NOCHANGE")
160 D ^XMD
161 Q
162 ;
163REPORT ;
164 N EAX,PAGE,EANAME,EASIEN,EASLTR
165 ;
166 U IO
167 S (PAGE,EAX)=0
168 F EASLTR="60D","30D","0D" D
169 . D HDR
170 . I EASCNT(EASLTR)'>0 D Q
171 . . W !!,"There were no letters reset for this letter type"
172 . S EASIEN=0
173 . F S EASIEN=$O(^TMP("EAS155P",$J,EASLTR,EASIEN)) Q:EASIEN']"" D
174 . . W !,$$GET1^DIQ(713.2,EASIEN,2),?35,EASIEN,?55,$$GET1^DIQ(713.2,EASIEN,.01)
175 . . I ($Y+6)>IOSL D HDR
176 D FTR
177 Q
178 ;
179HDR ;
180 N DDASH,LINE,PART1,PART2,SPACE
181 ;
182 W @IOF
183 S PAGE=PAGE+1
184 W !,"Patch EAS*1*55 MT Letter Cleanup Results"
185 S PART1="Run Date: "_$$FMTE^XLFDT(DT)
186 S PART2="Page: "_PAGE
187 S SPACE=IOM,SPACE=SPACE-($L(PART1)+$L(PART2))
188 S $P(LINE," ",SPACE)=""
189 W !,PART1,LINE,PART2
190 W !!,$S(EASLTR="60D":"60-Day",EASLTR="30D":"30-Day",EASLTR="0D":"0-Day",1:"")," Letters for the following Veterans have been reset"
191 W !?5,"Name",?35,"File 713.2 IEN",?55,"Processing Date"
192 S $P(DDASH,"=",IOM)="" W !,DDASH
193 Q
194 ;
195FTR ;
196 W !!!!?5,"60-Day Letters: "_EASCNT("60D")
197 W !?5,"30-Day Letters: "_EASCNT("30D")
198 W !?5," 0-Day Letters: "_EASCNT("0D")
199 Q
Note: See TracBrowser for help on using the repository browser.