source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTL2.m@ 1150

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

initial load of WorldVistAEHR

File size: 6.8 KB
Line 
1EASMTL2 ;MIN/TCM ALB/SCK/AEG - AUTOMATED MEANS TEST LETTER - SEARCH ; 7/3/01
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,14,20,22,55**;MAR 15,2001
3 ;
4EN60 ; Entry point for inital 60-day letter search for candidates
5 N EASIEN,DFN,VADM,CNT,ANNVDT,EASLAST
6 ;
7 K ^TMP("EASERR",$J)
8 S CNT=0 ; Initialize counter
9 S ANNVDT=EASDT("ANV")
10 ; Check for means test data to process, quit if none found
11 Q:'$D(^DGMT(408.31,"B",ANNVDT))
12 ;
13 ; Retieve data for each Means Test entry being processed
14 S EASIEN=0
15 F S EASIEN=$O(^DGMT(408.31,"B",ANNVDT,EASIEN)) Q:EASIEN'>0 D
16 . ; Quit further processing if means test is not MEANS TEST type
17 . Q:'$$GET1^DIQ(408.31,EASIEN,.019,"I")=1
18 . S DFN=$$GET1^DIQ(408.31,EASIEN,.02,"I") ; get patient's DFN
19 . ; Check conditions; if all passed, add new entry to worklist file, #713.2
20 . Q:'DFN ; Safety check for DFN
21 . Q:'$$CHKDFN(DFN,EASIEN) ; Check for valid PATIENT File entry, **55**
22 . Q:$$TEST(DFN) ; Quit if test patient
23 . S EASLAST=$$LST^DGMTU(DFN) ; Get last MT on file
24 . Q:'(+EASLAST=EASIEN) ; Not the latest MT record for patient
25 . Q:"L,N"[$P(EASLAST,U,4) ; Quit, patient no longer requires means test (No Longer Applicable or No Longer Required)
26 . Q:$$DECEASED^EASMTUTL("",DFN) ; Quit if patient deceased
27 . ; If passed through all condition checks, update files
28 . Q:$$CHKSTAT(EASIEN,DFN) ; Check current MT status
29 . Q:$$FUTURE(DFN) ; Quit if a future means test is on file
30 . D NEWSTAT(DFN,.EASPT)
31 . Q:EASPT'>0 ; Safety check
32 . Q:'$$NEWLTR(EASPT,.EASDT) ; Quit if letter status was not updated
33 . ; Finally, Update the counters
34 . S CNT=CNT+1
35 S EAS6CNT(EASPRCDT)=CNT,EAS6CNT=EAS6CNT+CNT
36 D ERRMSG
37 K ^TMP("EASERR",$J),^TMP("EASBDPTR",$J)
38 Q
39 ;
40NEWLTR(EASPT,EASDT) ; Add new entry to the work list file #713.2.
41 ; Input
42 ; EASPT - Ptr to 713.1 file
43 ; EASDT - Worklist date array
44 ;
45 ; Output
46 ; RSLT - 1 if new letter status entry added
47 ; 0 if new letter status was not added
48 ;
49 N ANNVDT,FDA,RSLT
50 ;
51 S ANNVDT=EASDT("ANV")
52 ;
53 ; Check for an existing entry for patient and anniversary date
54 I $D(^EAS(713.2,"AN",EASPT,ANNVDT)) Q 0 ; Quit if duplicate entry
55 ;
56 ; Add new entry to the letter status file, #713.2
57 S FDA(1,713.2,"+1,",.01)=EADT
58 S FDA(1,713.2,"+1,",2)=EASPT
59 S FDA(1,713.2,"+1,",3)=ANNVDT
60 S FDA(1,713.2,"+1,",4)=0
61 S FDA(1,713.2,"+1,",8)=EASDT("60")
62 S FDA(1,713.2,"+1,",11)=EASDT("30")
63 S FDA(1,713.2,"+1,",17)=EASDT("0")
64 S FDA(1,713.2,"+1,",9)=1
65 ; Modification for DCD sites which are required to print only the 0-day letters
66 ;; EAS*1*12
67 I $$VERSION^XPDUTL("IVMC"),$G(DT)'>3021014 D
68 . K FDA(1,713.2,"+1,",9)
69 . S FDA(1,713.2,"+1,",18)=1
70 ; ***
71 D UPDATE^DIE("","FDA(1)","","ERRMSG")
72 Q 1
73 ;
74UPDLTR(EAS1,TYPE) ; Update Flagged to print field for letter type
75 ; Input
76 ; EAS1 - Ptr to file 713.2
77 ; TYPE - Letter type (1:60d, 2:30d, 4:0d)
78 ;
79 N DGFDA,ERRMSG
80 ;
81 S DGFDA(1,713.2,EAS1_",",$S(TYPE=2:12,1:18))=1
82 D UPDATE^DIE("","DGFDA(1)","","ERRMSG")
83 Q
84 ;
85NEWSTAT(DFN,EASPT) ; Update the Patient status file, #713.1
86 ; Input
87 ; DFN - Patient's DFN
88 ; EASPT - Return Var, New IEN to 713.1 file
89 ;
90 N EASIEN,DGFDA,FDAIEN,ERROUT
91 ;
92 ; Create new entry in the patient status file
93 ;
94 I '$D(^EAS(713.1,"B",DFN)) D Q
95 . S DGFDA(1,713.1,"+1,",.01)=DFN
96 . S DGFDA(1,713.1,"+1,",2)=0
97 . D UPDATE^DIE("","DGFDA(1)","FDAIEN","ERROUT(1)")
98 . I $D(ERROUT) D
99 . . S ^TMP("EASERR",$J,DFN)=ERROUT(1,"DIERR",1)_" - "_ERROUT(1,"DIERR",1,"TEXT",1)
100 . . S:+$G(FDAIEN(1))'>0 ^TMP("EASERR",$J,DFN)="Unable to generate entry in EAS MT PATIENT STATUS File, #713.1"
101 . S EASPT=+$G(FDAIEN(1))
102 ;
103 I $D(^EAS(713.1,"B",DFN)) D
104 . Q:'DFN
105 . S EASPT=$O(^EAS(713.1,"B",DFN,0))
106 Q
107 ;
108PRNTDT(EARY,ETYPE) ; Retrieve Print date and flagged to print status for letter type
109 ; Input
110 ; EARY - Data array from Patient Status file, #713.1, MT Anniversary date field, #11
111 ; ETYPE - Search type, 30 or 0 day
112 ;
113 ; Output
114 ; RSLT = Print date ^ Flagged to print status
115 ; will be 0^0 if nothing found to return
116 ;
117 N RSLT
118 ;
119 S RSLT=$S(ETYPE=2:EARY(11,"I"),ETYPE=4:EARY(17,"I"),1:0)
120 S RSLT=RSLT_"^"_+$S(ETYPE=2:EARY(12,"I"),ETYPE=4:EARY(18,"I"),1:0)
121 Q RSLT
122 ;
123CHKSTAT(EASIEN,DFN) ; Check for means test status, still required or not
124 ; Input
125 ; EASIEN - Internal Entry Number to the ANNUAL MEANS TEST File, #408.31
126 ;
127 ; Output
128 ; 1 - if means test is no longer required or applicable
129 ; 0 - if means test is still required
130 ;
131 N RSLT,EASTAT
132 ;
133 ; If status = "NO LONGER REQUIRED" or "NO LONGER APPLICABLE" then set result to 1
134 ; The .03 field is a pointer to the MEANS TEST STATUS File, #408.32, checks
135 ; IEN=3 and IEN=10, NO LONGER REQUIRED and NO LONGER APPLICABLE entries respectively
136 ; If the 408.32 file is changed, this code will need to be reviewed and updated if necessary.
137 ;
138 S RSLT=0,DFN=$G(DFN)
139 ;
140 S EASTAT=$$GET1^DIQ(408.31,EASIEN,.03,"I")
141 I (EASTAT=3)!(EASTAT=10) S RSLT=1
142 ;
143 ;; Check current MT Status from API (Looking for Cat-C, Agree to Pay Dedct, MT later than 10-5-99
144 I 'RSLT D
145 . S:'$$MTCHK^EASMTCHK(DFN,"L") RSLT=1
146 ;
147 Q $G(RSLT)
148 ;
149FUTURE(DFN) ; Future Means Test available?
150 N RSLT
151 ;
152 S RSLT=$$FUT^DGMTU(DFN)
153 Q $G(RSLT)
154 ;
155TEST(DFN) ; Test Patient?
156 N VAROOT,ZSSN,EASDEM
157 ;
158 S VAROOT="EASDEM"
159 D DEM^VADPT
160 S ZSSN=$P(EASDEM(2),U,1)
161 I $E(ZSSN,1,5)["00000" Q 1
162 ;
163 Q 0
164 ;
165CHKDFN(DFN,MTIEN) ; Checks for a valid zero node in the patient file entry.
166 ; If no valid zero node, sets bad ptr entry
167 ;
168 N RSLT
169 ;
170 S DFN=$G(DFN),MTIEN=$G(MTIEN)
171 S RSLT=$D(^DPT(DFN,0))
172 I 'RSLT D
173 . S ^TMP("EASBDPTR",$J,DFN)=MTIEN
174 ;
175 Q $G(RSLT)
176 ;
177ERRMSG ; Send mail message if any errors were generated during processing
178 I $D(^TMP("EASERR",$J)) D ERRORS
179 I $D(^TMP("EASBDPTR",$J)) D BADPTR
180 Q
181 ;
182ERRORS ;
183 N EASDFN,EASERR,MSG,DFN,VA
184 ;
185 S MSG(.1)="The following issues were reported by the Means Test Letter Search Process:"
186 S MSG(.9)=""
187 ;
188 S EASDFN=0
189 F S EASDFN=$O(^TMP("EASERR",$J,EASDFN)) Q:'EASDFN D
190 . S DFN=EASDFN D PID^VADPT
191 . S MSG(EASDFN)=$$GET1^DIQ(2,EASDFN,.01)_" ("_VA("BID")_") "_$G(^TMP("EASERR",$J,EASDFN))
192 . K VA
193 ;
194 D SEND(.MSG)
195 Q
196 ;
197BADPTR ;
198 N EASDFN,EASERR,MSG,X
199 ;
200 S MSG(.1)="During the MT Letter Search, the following Annual Means Test "
201 S MSG(.2)="File entries (#408.31) were found which may point to a non-existent"
202 S MSG(.3)="Patient entry in the PATIENT File (#2):"
203 S MSG(.4)=""
204 S X=$$SETSTR^VALM1("PATIENT FILE (#2)","",5,20)
205 S X=$$SETSTR^VALM1("MT FILE (#408.31)",X,35,20)
206 S MSG(.5)=X
207 S X=$$SETSTR^VALM1("=================","",5,20)
208 S X=$$SETSTR^VALM1("=================",X,35,20)
209 S MSG(.6)=X
210 ;
211 S EASDFN=0
212 F S EASDFN=$O(^TMP("EASBDPTR",$J,EASDFN)) Q:'EASDFN D
213 . S X=$$SETSTR^VALM1(EASDFN,"",5,20)
214 . S X=$$SETSTR^VALM1($G(^TMP("EASBDPTR",$J,EASDFN)),X,35,20)
215 . S MSG(EASDFN)=X
216 ;
217 D SEND(.MSG)
218 Q
219 ;
220SEND(MSG) ;
221 S XMSUB="MT LETTERS SEARCH ISSUES - "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
222 S XMTEXT="MSG("
223 S XMY("G.EAS MTLETTERS")=""
224 S XMDUZ="AUTOMATED MT LETTERS"
225 D ^XMD
226 Q
Note: See TracBrowser for help on using the repository browser.