source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SD53105A.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1SD53105A ;ALB/JRP - XMIT, DELETE, AND ERROR FILE CLEAN UP;12-MAR-1997
2 ;;5.3;Scheduling;**105**;Aug 13, 1993
3 ;
4SCAN ;Entry point to scan only (prints what would have been deleted)
5 N ZTRTN,ZTDESC
6 D INTRO
7 W !
8 W !,"You are running this routine in scan mode, which will only identify"
9 W !,"the problems corrected. Please select a device (queueing allowed) so"
10 W !,"that a listing of what would have been done can be obtained."
11 W !!
12 S ZTRTN="EN^SD53105A(1)"
13 S ZTDESC="ACRP cleanup of files 409.73, 409.74, and 409.75"
14 D EN^XUTMDEVQ(ZTRTN,ZTDESC)
15 Q
16 ;
17FIX ;Entry point to schedule clean up
18 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,TXT
19 D INTRO
20 W !
21 W !,"Please enter the date/time that you would like this clean up queued to"
22 W !,"run. A summary of what was done will be sent to you and the"
23 W !,"recipients of the SCDX AMBCARE TO NPCDB SUMMARY bulletin."
24 W !!
25 S ZTRTN="EN^SD53105A(0)"
26 S ZTDESC="ACRP cleanup of files 409.73, 409.74, and 409.75"
27 S ZTDTH=""
28 S ZTIO=""
29 D ^%ZTLOAD
30 W:(+$G(ZTSK)) !,"Scheduled as task number ",ZTSK
31 W:('$G(ZTSK)) !,"** Unable to schedule correction **"
32 Q
33 ;
34INTRO ;Print intro text
35 W !!,"This routine will clean up dangling pointers and orphan entries within"
36 W !,"the ACRP transmission files. The following actions/checks will be"
37 W !,"performed:"
38 W !
39 W !,"(1) Entries in the Transmitted Outpatient Encounter file (409.73)"
40 W !," that do not have a valid pointer to the Outpatient Encounter"
41 W !," file (#409.68) or the Deleted Outpatient Encounter file"
42 W !," (#409.74) are deleted."
43 W !
44 W !,"(2) Entries in the Transmitted Outpatient Encounter file that have"
45 W !," been rejected by the Austin Automation Center and do not have an"
46 W !," entry in the Transmitted Outpatient Encounter Error file"
47 W !," (#409.75) are marked for re-transmission."
48 W !
49 W !,"(3) Entries in the Deleted Outpatient Encounter file that do not"
50 W !," have a corresponding entry in the Transmitted Outpatient"
51 W !," Encounter file are deleted."
52 W !
53 W !,"(4) Entries in the Transmitted Outpatient Encounter Error file that"
54 W !," do not have a valid pointer to the Transmitted Outpatient"
55 W !," Encounter file are deleted."
56 Q
57 ;
58EN(SCANMODE) ;Main entry point
59 ; Routine deletes entries in the Transmitted Outpatient Encounter file
60 ; (409.73) that do not have a valid pointer to the Outpatient Encounter
61 ; file (#409.68) or the Deleted Outpatient Encounter file (#409.74).
62 ;
63 ; Routine marks entries in the Transmitted Outpatient Encounter file
64 ; that have been rejected by the Austin Automation Center and do not
65 ; have an entry in the Transmitted Outpatient Encounter Error file
66 ; (#409.75) for re-transmission.
67 ;
68 ; Routine deletes entries in the Deleted Outpatient Encounter file that
69 ; do not have a corresponding entry in the Transmitted Outpatient
70 ; Encounter file.
71 ;
72 ; Routine deletes entries in the Transmitted Outpatient Encounter Error
73 ; file that do not have a valid pointer to the Transmitted Outpatient
74 ; Encounter file.
75 ;
76 ;Input : SCANMODE - Flag denoting if routine should only scan
77 ; for errors and not fix them
78 ; 0 = No - scan and fix (default)
79 ; 1 = Yes - scan but don't fix
80 ;Output : None
81 ;Notes : A completion/summary bulletin will be sent to the current
82 ; user and the recipients of the SCDX AMBCARE TO NPCDB SUMMARY
83 ; bulletin. This bulletin will not be sent if in scan mode.
84 ;
85 ;Declare variables
86 N XMITPTR,XMITTOT,XMITDEL,XMITXMIT,ENCPTR,DELPTR,DELTOT,DELDEL,ERRPTR
87 N ERRTOT,ERRDEL,NODE,TMP,DIK,DA,X,Y
88 S SCANMODE=+$G(SCANMODE)
89 ;Initialize counters
90 S (XMITTOT,XMITDELE,XMITDELD,XMITXMIT,DELTOT,DELDEL,ERRTOT,ERRDEL)=0
91 ;Initialize summary location
92 K ^TMP($J,"SD53105A")
93 S ^TMP($J,"SD53105A","XMIT")="^^^"
94 S ^TMP($J,"SD53105A","DEL")="^"
95 S ^TMP($J,"SD53105A","ERR")="^"
96 S ^TMP($J,"SD53105A","STOP")=0
97 ;Remember starting time
98 S ^TMP($J,"SD53105A","TIME")=$$NOW^XLFDT()
99 I (SCANMODE) D
100 .W !
101 .W !,"Scanning of the Transmitted Outpatient Encounter, Deleted Outpatient"
102 .W !,"Encounter, and Transmitted Outpatient Encounter Error files for known"
103 .W !,"problems started on "_$$FMTE^XLFDT($$NOW^XLFDT())
104 .W !
105 ;Loop through Transmitted Outpatient Encounter file (#409.73)
106 I (SCANMODE) D
107 .W !!
108 .W !,"The following entries in the Transmitted Outpatient Encounter"
109 .W !,"file (#409.73) will be acted upon when run in fix mode"
110 .W !,$$REPEAT^SCDXUTL1("=",70)
111 S XMITPTR=0
112 F S XMITPTR=+$O(^SD(409.73,XMITPTR)) Q:('XMITPTR) D Q:($G(ZTSTOP))
113 .;Increment total entries checked
114 .S XMITTOT=XMITTOT+1
115 .;Grab zero node
116 .S NODE=$G(^SD(409.73,XMITPTR,0))
117 .;Get Outpatient Encounter & Deleted Outpatient Encounter pointers
118 .S ENCPTR=+$P(NODE,"^",2)
119 .S DELPTR=+$P(NODE,"^",3)
120 .;Validate pointer to Outpatient Encounter
121 .I (ENCPTR) D
122 ..Q:($D(^SCE(ENCPTR,0)))
123 ..;Invalid - delete entry and increment deletion count
124 ..S:('SCANMODE) TMP=$$DELXMIT^SCDXFU03(XMITPTR,0)
125 ..W:(SCANMODE) !,"^SD(409.73,",XMITPTR,",0) has bad pointer to Outpatient Encounter file"
126 ..S XMITDELE=XMITDELE+1
127 .;Validate pointer to Deleted Outpatient Encounter
128 .I (DELPTR) D
129 ..Q:($D(^SD(409.74,DELPTR,0)))
130 ..;Invalid - delete entry and increment deletion count
131 ..S:('SCANMODE) TMP=$$DELXMIT^SCDXFU03(XMITPTR,0)
132 ..W:(SCANMODE) !,"^SD(409.73,",XMITPTR,",0) has bad pointer to Deleted Outpatient Encounter file"
133 ..S XMITDELD=XMITDELD+1
134 .;Check for rejection without entry in Transmitted Outpatient Encounter
135 .; Error file (#409.75)
136 .S TMP=$G(^SD(409.73,XMITPTR,1))
137 .I ($P(TMP,"^",5)="R") D:('$D(^SD(409.75,"B",XMITPTR)))
138 ..;Mark for retransmission
139 ..D:('SCANMODE) STREEVNT^SCDXFU01(XMITPTR)
140 ..D:('SCANMODE) XMITFLAG^SCDXFU01(XMITPTR)
141 ..W:(SCANMODE) !,"^SD(409.73,",XMITPTR,",0) rejected with no reason on file (entry in 409.75)"
142 ..;Increment retransmission counter
143 ..S XMITXMIT=XMITXMIT+1
144 .;Check for request to stop
145 .S:($$S^%ZTLOAD("Last entry in Transmitted Outpatient Encounter file checked >> "_XMITPTR)) ZTSTOP=1
146 ;Remember totals
147 S ^TMP($J,"SD53105A","XMIT")=XMITTOT_"^"_XMITDELE_"^"_XMITDELD_"^"_XMITXMIT
148 I (SCANMODE) D
149 .W !
150 .W !,XMITTOT," entries where checked"
151 .W !,?2,XMITXMIT," would have been marked for retransmission"
152 .W !,?2,(XMITDELE+XMITDELD)," would have been deleted"
153 .W !,?4,(XMITDELE)," have bad Outpatient Encounter pointers"
154 .W !,?4,(XMITDELD)," have bad Deleted Outpatient Encounter pointers"
155 ;Asked to stop
156 I $G(ZTSTOP) G EN1
157 ;Loop through Deleted Outpatient Encounter file (#409.74)
158 I (SCANMODE) D
159 .W !!!
160 .W !,"The following entries in the Deleted Outpatient Encounter"
161 .W !,"file (#409.74) will be deleted when run in fix mode"
162 .W !,$$REPEAT^SCDXUTL1("=",70)
163 S DELPTR=0
164 F S DELPTR=+$O(^SD(409.74,DELPTR)) Q:('DELPTR) D Q:($G(ZTSTOP))
165 .;Increment total entries checked
166 .S DELTOT=DELTOT+1
167 .;Check for entry in Transmitted Outpatient Encounter file
168 .I ('$D(^SD(409.73,"ADEL",DELPTR))) D
169 ..;Not found - delete entry and increment deletion count
170 ..I ('SCANMODE) S DA=DELPTR,DIK="^SD(409.74," D ^DIK K DA,DIK,X,Y
171 ..W:(SCANMODE) !,"^SD(409.74,",DELPTR,",0) not in Transmitted Outpatient Encounter file"
172 ..S DELDEL=DELDEL+1
173 .;Check for request to stop
174 .S:($$S^%ZTLOAD("Last entry in Deleted Outpatient Encounter file checked >> "_DELPTR)) ZTSTOP=1
175 ;Remember totals
176 S ^TMP($J,"SD53105A","DEL")=DELTOT_"^"_DELDEL
177 W:(SCANMODE) !!,DELTOT," entries where checked and ",DELDEL," would have been deleted"
178 ;Asked to stop
179 I $G(ZTSTOP) G EN1
180 ;Loop through Transmitted Outpatient Encounter Error file (#409.75)
181 I (SCANMODE) D
182 .W !!!
183 .W !,"The following entries in the Transmitted Outpatient Encounter"
184 .W !,"Error file (#409.75) will be deleted when run in fix mode"
185 .W !,$$REPEAT^SCDXUTL1("=",70)
186 S ERRPTR=0
187 F S ERRPTR=+$O(^SD(409.75,ERRPTR)) Q:('ERRPTR) D Q:($G(ZTSTOP))
188 .;Increment total entries checked
189 .S ERRTOT=ERRTOT+1
190 .;Get pointer to Transmitted Outpatient Encounter file
191 .S XMITPTR=+$G(^SD(409.75,ERRPTR,0))
192 .;Validate pointer
193 .I ('$D(^SD(409.73,XMITPTR,0))) D
194 ..;Invalid - delete entry and increment deletion count
195 ..S:('SCANMODE) TMP=$$DELERR^SCDXFU02(ERRPTR)
196 ..W:(SCANMODE) !,"^SD(409.75,",ERRPTR,",0) has bad pointer to Transmitted Outpatient Encounter file"
197 ..S ERRDEL=ERRDEL+1
198 .;Check for request to stop
199 .S:($$S^%ZTLOAD("Last entry in Transmitted Outpatient Encounter Error file checked >> "_ERRPTR)) ZTSTOP=1
200 ;Remember totals
201 S ^TMP($J,"SD53105A","ERR")=ERRTOT_"^"_ERRDEL
202 W:(SCANMODE) !!,ERRTOT," entries where checked and ",ERRDEL," would have been deleted"
203EN1 ;Remember ending time
204 S $P(^TMP($J,"SD53105A","TIME"),"^",2)=$$NOW^XLFDT()
205 I (SCANMODE) D
206 .W !!!,"Scan ended on ",$$FMTE^XLFDT($$NOW^XLFDT())
207 .W !!!,"Use the entry point FIX^SD53105A to run in fix mode"
208 .W !,"Use the entry point SCAN^SD53105A to re-run in scan mode"
209 ;Remember if requested to stop
210 S ^TMP($J,"SD53105A","STOP")=+$G(ZTSTOP)
211 ;Send completion/summary bulletin
212 D:('SCANMODE) BULL1^SD53105C
213 ;Done - clean up and quit
214 K ^TMP($J,"SD53105A")
215 S:($D(ZTQUEUED)) ZTREQ="@"
216 Q
Note: See TracBrowser for help on using the repository browser.