source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53285.m@ 724

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

initial load of WorldVistAEHR

File size: 7.5 KB
Line 
1DG53285 ;ALB/PAK-DG*5.3*285 POST-INSTALL TO CLEAN MEANS TEST ;4/24/2000
2 ;;5.3;Registration;**285**;Aug 13, 1993
3 ;
4 ; This routine is the post installation for patch DG*5.3*285
5 ;
6 ; The clean up is required as there is a number of redundant entries
7 ; with a STATUS (#.03) of 'NO LONGER REQUIRED' in the Annual Means
8 ; Test file (408.31). These were created due to the presence of a
9 ; REQUIRED test which was primary for the current income year at the
10 ; time the means test was uploaded.
11 ;
12 ; In addition, if there is a REQUIRED test present within 365 days of
13 ; the means test under review which is primary then this is set to
14 ; NON primary.
15 ;
16 ; Finally, the DG MEANS TEST DRIVER protocol is called.
17 ;
18 ;
19 ; ^XTMP("DG-MTIY",MTIY) track number of records processed:
20 ; ^XTMP("DG-MTERR") contains error messages returned from FM DBS calls:
21 ; ^XTMP("DG-MTERR",file#,record#,field#,n)=error message
22 ;
23POST ;
24 ; post-install set up checkpoints and tracking global...
25 N %,I,X,X1,X2
26 I $D(XPDNM) D
27 .; checkpoints
28 .I $$VERCP^XPDUTL("DGMTIDT")'>0 D
29 ..S %=$$NEWCP^XPDUTL("DGMTIDT","","-9999999")
30 .I $$VERCP^XPDUTL("DGDFN")'>0 D
31 ..S %=$$NEWCP^XPDUTL("DGDFN","",0)
32 .;
33 ;
34 ; initialize tracking global (see text above for description)...
35 F I="MTIY","MTERR" D
36 .I $D(^XTMP(I)) Q
37 .S X1=DT
38 .S X2=30
39 .D C^%DTC
40 .S ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*285 POST-INSTALL "_$S(I="MTIY":"record count",1:"filing errors")
41 ;
42EN ; begin processing...
43 N %
44 ; check status and if root checkpoint has not completed start clean up
45 I $D(XPDNM) S %=$$VERCP^XPDUTL("DGMTIDT")
46 I $G(%)="" S %=0
47 I %=0 D EN1
48 Q
49 ;
50EN1 ; begin purge...
51 ; write message to installation device and to INSTALL file (#9.7)
52 D BMES^XPDUTL("POST INSTALLATION PROCESSING")
53 D MES^XPDUTL("Once the post-install is completed, a mail message will")
54 D MES^XPDUTL("be sent that will report the count of records, by income")
55 D MES^XPDUTL("year, from which means test entries were purged.")
56 D MES^XPDUTL("Additionally, the report will contain notes")
57 D MES^XPDUTL("about any errors encountered during the post-installation.")
58 D BMES^XPDUTL("Beginning purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
59 ;
60 ; process control body
61 N DGMTIDT,DGDFN,STA,YR,FILERR,MTIEN
62 ;
63 I '$D(XPDNM) S DGMTIDT=-99999999
64 I $D(XPDNM) S DGMTIDT=$$PARCP^XPDUTL("DGMTIDT"),DGDFN=$$PARCP^XPDUTL("DGDFN")
65 S STA=$P($$SITE^VASITE,"^",3)
66 F S DGMTIDT=$O(^DGMT(408.31,"AS",1,3,DGMTIDT)) Q:'DGMTIDT!(DGMTIDT>-2980101) D
67 . S:'$D(DGDFN) DGDFN=0
68 . S YR=$E(DGMTIDT,2,4) ; get current mean test year
69 . F S DGDFN=$O(^DGMT(408.31,"AS",1,3,DGMTIDT,DGDFN)) Q:DGDFN="" D
70 . . N FILERR
71 . . ;
72 . . ; get primary means test for this year
73 . . S NODE=$$LST^DGMTU(DGDFN,YR_"1231")
74 . . ;
75 . . ; - if primary means test has a STATUS of 'No Longer Required' and
76 . . ; it has the same MEANS TEST DATE as the current test then delete
77 . . ; all 'No Longer Required' tests for this date except the primary
78 . . ; test.
79 . . ; - otherwise, delete all 'No Longer Required' means test for this
80 . . ; date except the last entry.
81 . . I $P(NODE,U,4)="N",($P(NODE,U,2)=-DGMTIDT) S MTIEN=+NODE
82 . . E S MTIEN=$O(^DGMT(408.31,"AS",1,3,DGMTIDT,DGDFN,""),-1)
83 . . D DELMT(DGMTIDT,DGDFN,MTIEN,.FILERR)
84 . . ;
85 . . ; If 'No Longer Required' test then change 'Required'
86 . . ; primary test for next Means Test year to Non-Primary and update
87 . . ; STATUS of means test for current date
88 . . D RQ2NPRM(-DGMTIDT,DGDFN,STA,YR,NODE,.FILERR)
89 . . ;
90 . . ; if error then update temporary store
91 . . I $G(FILERR) M ^XTMP("DG-MTERR")=FILERR
92 . . ; update check point with patient ID
93 . . I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
94 . ; update check point with means test inverse date
95 . I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
96 ;
97 ; send mailman msg to user/HEC with results
98 D MAIL^DG53285M
99 I $D(XPDNM) S %=$$COMCP^XPDUTL("DGMTIDT")
100 D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
101 Q
102 ;
103DELMT(MTIDT,DFN,ENTR,ERRS) ;
104 ; Input:
105 ; MTIDT - Inverse Means Tets Date
106 ; DFN - Patient identifier
107 ; ENTR - Entry # to ignore
108 ; ERRS - DBS file error {by reference}
109 ;
110 N IEN,ERR
111 ;
112 S IEN=0
113 F S IEN=$O(^DGMT(408.31,"AS",1,3,MTIDT,DFN,IEN)) Q:IEN="" D
114 . Q:IEN=ENTR
115 . I '$$EN^IVMCMD(IEN) S ERRS(408.31,IEN,"ALL")="Unable to delete means test" Q
116 . ; increment purged count for income year
117 . D COUNT(MTIDT)
118 Q
119 ;
120RQ2NPRM(IDT,DFN,STA,YR,NODE,ERRS) ; change Required test to NON primary
121 ;
122 ; Input:
123 ; IDT - Means Test Date
124 ; DFN - Patient identifier
125 ; ERRS - DBS file error {by reference}
126 ; STA - Station number
127 ; YR - Means Test year
128 ; NODE - Last Primary test prior to end of Means Test year (YR)
129 ;
130 N NODE1,NODE2,DATA,REC31,ERR,DGADDF,DGREQF
131 ;
132 ; get primary test for next year
133 S NODE1=$$LST^DGMTU(DFN,YR+1_"1231")
134 ;
135 ; 1. if there is no Primary test for the year in which the
136 ; remaining 'No Longer Required' test began then make it
137 ; primary.
138 ; 2. if primary means test for for subsequent year is Required,
139 ; is within 365 days of current means test date and this site
140 ; conducted test then make primary means test NON primary.
141 ; 3. if this site conducted test then change check if test
142 ; is required. If it is required then the STATUS of the
143 ; single remaining No Longer Required means test for this date
144 ; will equal the value of the TEST-DETERMINED STATUS.
145 ;
146 ; (1) determine is 'No Longer Required' test should be primary
147 S REC31=$O(^DGMT(408.31,"AS",1,3,-IDT,DFN,""))
148 I +REC31,(+$E($P(NODE,U,2),1,3)<$E($P(^DGMT(408.31,REC31,0),U),1,3)) D
149 . S DATA(2)=1
150 . I '$$UPD^DGENDBS(408.31,REC31,.DATA,.ERR) S:$D(ERR) ERRS(408.31,REC31,2)=ERR
151 .
152 ; (2) determine if subsequent year test should be Non primary
153 I $P(NODE1,U,2)>(YR_1231),($P(NODE1,U,4)="R"),$$SCOPE($P(NODE1,U,2),IDT) D
154 . ; set REQUIRED test to NON primary
155 . S DATA(2)=0
156 . I '$$UPD^DGENDBS(408.31,+NODE1,.DATA,.ERR) S:$D(ERR) ERRS(408.31,+NODE1,2)=ERR Q
157 ;
158 ; (3) Check if remaining No Longer Required test for this date is
159 ; Required
160 Q:REC31=""
161 S NODE2=$G(^DGMT(408.31,REC31,2))
162 Q:$P(NODE2,U,5)'=STA
163 D REQ(DFN,REC31,3,IDT)
164 Q
165 ;
166SCOPE(X1,X2) ; Check if dates within 365 days of one another
167 D ^%DTC
168 I X>365 Q 0
169 E Q 1
170 Q
171 ;
172COUNT(DATE) ; update process tracking mechanisms...
173 ; Input:
174 ; DATE = inverse date from "AS" x-ref in 408.31
175 ;
176 N %,IY
177 S IY=$E(DATE,2,4)-1
178 S ^XTMP("DG-MTIY",IY)=+$G(^XTMP("DG-MTIY",IY))+1
179 Q
180 ;
181REQ(DFN,DGMTI,DGCS,IDT) ; Determine if test is Required
182 ;
183 ; ** amended copy of EN^DGMTR as check for latest Primary **
184 ; ** test is not valid for this cleanup. **
185 ;
186 ; Input:
187 ; DFN - Patient ID
188 ; DGMTI - Annual Means Test IEN
189 ; DGCS - Annual Means Test Status
190 ; IDT - Means Test Date
191 ;
192 ; Output:
193 ; DGREQF - Means Test Require Flag
194 ; (1 if required and 0 if not required)
195 ; DGDOM1 - DOM Patient Flag (defined and set to 1 if
196 ; patient currently on a DOM ward)
197 ;
198 N DGDOM,DGMT0,DGMTYPT,OLD,DGRGAUTO,DGQSENT,DGMSGF
199 ;
200 S (DGMSGF,DGQSENT,DGREQF)=0,(OLD,DGMTYPT)=1
201 I $D(^DPT(DFN,.36)) S X=^(.36) D
202 . I $P($G(^DIC(8,+X,0)),"^",9)=5!($$SC^DGMTR(DFN)) S DGREQF=1
203 . I $P(X,"^",2),$P(X,"^",2)<3 S DGREQF=0
204 I DGREQF S:$G(^DPT(DFN,.38)) DGREQF=0
205 I DGREQF D DOM^DGMTR S:$G(DGDOM) DGREQF=0
206 S DGMT0=$G(^DGMT(408.31,DGMTI,0))
207 I DGCS S OLD=$$OLD^DGMTU4(IDT)
208 ;
209 D
210 .I DGREQF,DGCS=3,'OLD D REQ^DGMTR Q
211 .I DGREQF,'$G(DGADDF),(('DGCS)!(OLD)) D ADD^DGMTR Q
212 .I 'DGREQF,DGCS,DGCS'=3,'$G(DGDOM) D NOL^DGMTR Q
213 ;
214 ;be sure to check whether or not patient is subject to RX copay!
215 ;
216 D EN^DGMTCOR
217 Q
Note: See TracBrowser for help on using the repository browser.