source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMT65.m@ 785

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1EASMT65 ; ALB/SCK - MEANS TEST LETTER PRINT FOR USER ENROLLEE STATUS ; 25-JUL-2007
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**65**;MAR 15,2001;Build 1
3 ;
4QUE ;
5 N UES,LTRGRP,ZTSAVE,RETZTSK,ZTSK
6 ;
7 I '$D(^XUSEC("EAS MT UES OVERRIDE",DUZ)) D Q
8 . W !!,"You have not been assigned the required key to use this option."
9 . W !,"Please contact IRM or the Means Test Coordinator at your site"
10 . W !,"for assistance.",!!
11 ;
12 W:$D(IOF) @IOF
13 S UES=$$GETSITE Q:'UES
14 S LTRGRP=$$LTRS Q:LTRGRP=0
15 ;
16 S RETZTSK=1
17 S ZTSAVE("UES")="",ZTSAVE("LTRGRP")=""
18 D EN^XUTMDEVQ("EN^EASMT65","MT letters, UES print",.ZTSAVE)
19 W !,"Job has been tasked: ",$G(ZTSK)
20 Q
21 ;
22EN ;
23 N LTRCNT,EAX
24 ;
25 Q:'$G(UES)
26 Q:'$G(LTRGRP)
27 ;
28 K ^TMP("EASUE",$J)
29 F EAX=1,2,4 S LTRCNT(EAX)=0
30 ;
31 D BUILD(UES,LTRGRP)
32 D PRINT(LTRGRP)
33 D FINAL(UES,LTRGRP)
34 ;
35 K ^TMP("EASUE",$J)
36 D ^%ZISC
37 Q
38 ;
39GETSITE() ; Select User Enrollee Site
40 N DIR,X,Y,DIRUT,DTOUT,DUOUT,RSLT
41 ;
42 W !,"This option will allow the override of the current filters on the User"
43 W !,"Enrollee site. By selecting a site, letters for veterans that are"
44 W !,"listed as a User Enrollee of that site can be printed."
45 W !,"This option should be used with care!",!
46 ;
47 S DIR(0)="PAO^4:EMZ"
48 S DIR("A")="Select the User Enrollee site to print letters for: "
49 D ^DIR K DIR
50 S RSLT=+Y
51 I $D(DIRUT) S RSLT=0
52 Q $G(RSLT)
53 ;
54LTRS() ; Select letter group to print
55 N DIR,DIRUT,DUOUT,DTOUT,X,Y
56 ;
57 S DIR(0)="SO^1:60-Day Letters;2:30-Day Letters;4:0-Day Letters;ALL:All Letters"
58 S DIR("L",1)="Select the group of Letters to print:"
59 S DIR("L",2)=""
60 S DIR("L",3)=" 1: 60-Day 2: 30-Day Letters 4: 0-Day Letters"
61 S DIR("L")=" ALL: All Letters"
62 S DIR("?",1)=""
63 S DIR("?",2)="Select the group of letters to print: enter 1 for 60 day letters, "
64 S DIR("?",3)="enter 2 for 30 day lettes, or enter 4 for 0 day letters."
65 S DIR("?")="Entering 'All' will print all pending letters for 60, 30, and 0 days."
66 D ^DIR K DIR
67 I $D(DIRUT) S Y=0
68 I Y="ALL" S Y=5
69 Q $G(Y)
70 ;
71BUILD(UES,LTRGRP) ; Build list of letters to print
72 N IEN,DFN,EAX,PFLAGS,ABRT
73 ;
74 I '$D(ZTQUEUED) W !,"Collecting "_$S(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All ")_" letters"
75 S IEN=0
76 F S IEN=$O(^EAS(713.2,"AC",0,IEN)) Q:'IEN D
77 . S EAX=$$GET1^DIQ(713.2,IEN,2,"I")
78 . S DFN=$$GET1^DIQ(713.1,EAX,.01,"I")
79 . Q:'$$UESITE(UES,DFN) ; Check if UE Site matches selected site to print letters for
80 . I $D(^EAS(713.1,"AP",1,EAX)) D Q ; Check for Prohibit flag
81 . . D CLRFLG^EASMTUTL(0,IEN)
82 . . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^1~Prohibit Flag is set for the Veteran"
83 . I $$DECEASED^EASMTUTL(IEN) D Q ; Check if veteran is deceased
84 . . D CLRFLG^EASMTUTL(0,IEN)
85 . . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^2~Veteran is deceased"
86 . I $$FUTMT^EASMTUTL(IEN) D Q ; Check if a future dated MT is in place
87 . . D CLRFLG^EASMTUTL(0,IEN)
88 . . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^3~Veteran has a future dated Means Test"
89 . I $$CHKADR^EASMTL6A(EAX) D Q ; Check for a valid address
90 . . S ^TMP("EASUE",$J,"ERR",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^4~Invalid address or Bad Address Flag"
91 . S PFLAGS=$$LGROUP(IEN,LTRGRP)
92 . S ^TMP("EASUE",$J,"PRNT",$$GET1^DIQ(2,DFN,.01))=IEN_"^"_DFN_"^"_PFLAGS
93 Q
94 ;
95UESITE(UES,DFN) ; Determine UE Status
96 ; Input
97 ; UES - Selected User Enrollee Site
98 ; DFN - Patient DFN
99 ;
100 ; Returns a '1' if UE Status is 'Diff. Site' and USER ENROLLEE SITE, Field #.3618, File #2
101 ; matches the UE Site passed in. otherwise returns a '0'
102 ;
103 N RSLT
104 ;
105 I $$UESTAT^EASUER(DFN)=2 D
106 . S:$$GET1^DIQ(2,DFN,.3618,"I")=UES RSLT=1
107 Q $G(RSLT)
108 ;
109LGROUP(IEN,LTRGRP) ; Check whether the letter group has a pending letter or not.
110 ; Input - Ien in 713.2
111 ; - LTRGRP - Letter group selected: 60/30/0/All
112 ;
113 ; Output - Returns a '1' it there is a pending letter for that letter group and
114 ; a '0' if there is not. Format is: 60-Day~30-Day~0-Day~All
115 ;
116 N NODE6,NODE4,NODEZ,RSLT
117 ;
118 S NODE6=$G(^EAS(713.2,IEN,6))
119 S NODE4=$G(^EAS(713.2,IEN,4))
120 S NODEZ=$G(^EAS(713.2,IEN,"Z"))
121 ;
122 S $P(RSLT,"~",1)=+$P(NODE6,U,2)
123 S $P(RSLT,"~",2)=+$P(NODE4,U,2)
124 S $P(RSLT,"~",4)=+$P(NODEZ,U,2)
125 S $P(RSLT,"~",5)=$S(LTRGRP=5:1,1:0)
126 ;
127 Q $G(RSLT)
128 ;
129PRINT(LTRGRP) ; Print Letter
130 N NAME,IEN,DFN,PFLAGS,EAX,EATYP
131 ;
132 S NAME="",LTRCNT=0
133 F S NAME=$O(^TMP("EASUE",$J,"PRNT",NAME)) Q:NAME']"" D
134 . K IEN,DFN,PFLAGS
135 . S IEN=$P(^TMP("EASUE",$J,"PRNT",NAME),U,1)
136 . S DFN=$P(^TMP("EASUE",$J,"PRNT",NAME),U,2)
137 . S PFLAGS=$P(^TMP("EASUE",$J,"PRNT",NAME),U,3)
138 . I LTRGRP=5 D
139 . . F EAX=1,2,4 D
140 . . . I $P(PFLAGS,"~",EAX) D
141 . . . . D LETTER^EASMTL6A(IEN,EAX)
142 . . . . S LTRCNT(EAX)=LTRCNT(EAX)+1
143 . . . . D UPDSTAT^EASMTL6(IEN,EAX)
144 . E D
145 . . I $P(PFLAGS,"~",LTRGRP) D
146 . . . D LETTER^EASMTL6A(IEN,LTRGRP)
147 . . . S LTRCNT(LTRGRP)=LTRCNT(LTRGRP)+1
148 . . . D UPDSTAT^EASMTL6(IEN,LTRGRP)
149 Q
150 ;
151FINAL(UES,LTRGRP) ; Final wrap up
152 N MSG,LINECNT,XMSUB,XMTEXT,XMY,XMDUZ,TOT
153 ;
154 I $D(^TMP("EASUE",$J,"ERR")) D ERRPT(UES,LTRGRP)
155 ;
156 S MSG(1)="Count of Means Test letters printed for a User Enrollee Site"
157 S MSG(2)=""
158 S MSG(5)="User Enrollee Site: "_$$GET1^DIQ(4,UES,.01)
159 S MSG(10)=" Letter Group: "_$S(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All")_" letters."
160 S MSG(15)=""
161 S MSG(20)=" 60-day letters printed: "_+$G(LTRCNT(1))
162 S MSG(22)=" 30-day letters printed: "_+$G(LTRCNT(2))
163 S MSG(24)=" 0-day letters printed: "_+$G(LTRCNT(4))
164 S TOT=$G(LTRCNT(1))+$G(LTRCNT(2))+$G(LTRCNT(4))
165 S MSG(26)=" Total: "_TOT
166 ;
167 S XMSUB="EAS LETTER RESULTS BY UE SITE "
168 S XMTEXT="MSG("
169 S XMY("G.EAS MTLETTERS")=""
170 S XMDUZ="EAS MT LETTERS"
171 D ^XMD
172 Q
173 ;
174ERRPT(UES,LTRGRP) ; send error report to MT letters mail group
175 N MSG,NAME,DFN,IEN,ERROR,LINE,LINECNT,VA,SPACE,XMSUB,XMTEXT,XMY,XMDUZ
176 ;
177 S NAME="",LINECNT=100
178 F S NAME=$O(^TMP("EASUE",$J,"ERR",NAME)) Q:NAME']"" D
179 . S IEN=$P(^TMP("EASUE",$J,"ERR",NAME),U,1)
180 . S DFN=$P(^TMP("EASUE",$J,"ERR",NAME),U,2)
181 . S ERROR=$P(^TMP("EASUE",$J,"ERR",NAME),U,3)
182 . S LINE=$E(NAME,1,25)
183 . D PID^VADPT6 S LINE=LINE_" ("_VA("BID")_")" K VA
184 . S SPACE="",$P(SPACE," ",32-$L(LINE))=""
185 . S LINE=LINE_SPACE_$P(ERROR,"~",2)
186 . S MSG(LINECNT)=LINE,LINECNT=LINECNT+1
187 ;
188 S MSG(1)="The following errors were encountered during the processing of "
189 S MSG(2)="the Means Test Letters for the "_$$GET1^DIQ(4,UES,.01)_" User Enrollee Site."
190 S MSG(4)=""
191 S MSG(10)="Letter Group: "_$S(LTRGRP=1:"60-Day",LTRGRP=2:"30-Day",LTRGRP=4:"0-Day",1:"All")_" letters."
192 S MSG(30)=""
193 ;
194 S XMSUB="EAS PRINT LETTERS BY UE SITE"
195 S XMTEXT="MSG("
196 S XMY("G.EAS MTLETTERS")=""
197 S XMDUZ="EAS MT LETTERS"
198 D ^XMD
199 Q
Note: See TracBrowser for help on using the repository browser.