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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1DG53355A ;ALB/TM - NON TREATING PREFERRED FACILITY CLEAN UP ; 1/29/01 2:55pm
2 ;;5.3;REGISTRATION;**355**;01/19/01
3 ;
4 ; This process will find all entries in the PATIENT file (#2) that
5 ; have a PREFERRED FACILITY (#27.02) on file that is NOT a valid
6 ; treating facility. The $$TF^XUAF4(IEN) API will be used to
7 ; determine if a PREFERRED FACILITY is a treating facility.
8 ;
9 ; The process reads through all entries in the PATIENT file and
10 ; excludes any entries that have no PREFERRED FACILITY on file.
11 ; Only patient's with a non treating PREFERRED FACILITY will be
12 ; included.
13 ;
14 ; This clean up process will be completed in the steps listed below.
15 ; 1) Compiling the report
16 ; 2) Printing the results
17 ;
18 ; A MailMan message will be sent to the user after the job completes.
19 ; The purge date for the ^XTMP global is set for 30 days after the
20 ; report is processed.
21 ;
22GBLDOC ;-----------------------------------------------------------------
23 ; The report uses the ^XTMP("DG53355A") global to store the results.
24 ; The format of the ^XTMP global is described below.
25 ;
26 ; XPFAC = IEN from the INSTITUTION file (#4)
27 ; XIEN = IEN from the PATIENT file (#2)
28 ;
29 ; ^XTMP("DG53355A",0)=P1^P2^...
30 ; P1 = Purge Date
31 ; P2 = Date Processed
32 ; P3 = Description
33 ;
34 ; ^XTMP("DG53355A",0,0)=P1^P2^...
35 ; P1 = Status (0=Uncompiled,1=Compiling,2=Compile Complete)
36 ; P2 = TaskMan Task #
37 ; P3 = Compile Start Date/Time (FM format)
38 ; P4 = Compile Finish Date/Time (FM format)
39 ; P5 = Last IEN viewed from PATIENT file (#2)
40 ; P6 = Last IEN filed in ^XTMP from PATIENT file (#2)
41 ;
42 ; ^XTMP("DG53355A",XPFAC,0)=P1^P2^...
43 ; P1 = Total PATIENT file (#2) records for this NON treating
44 ; Preferred Facility.
45 ;
46 ; ^XTMP("DG53355A",XPFAC,XIEN)=""
47 ;-----------------------------------------------------------------
48EP N DIFROM,XSTAT,XNODE,XDESC
49 ;
50 S XDESC="NON TREATING PREFERRED FACILITY CLEAN UP REPORT"
51 S XNODE=$G(^XTMP("DG53355A",0,0))
52 S XSTAT=+$P(XNODE,U)
53 ;
54 W @IOF ; clearn the screen
55 W !!," ",XDESC
56 W !,$$REPEAT^XLFSTR("*",65)
57 ;
58 I 'XSTAT D Q ;Not compiled
59 . S X="ERROR^DG53355A" ;Error Trap
60 . Q:'$$USERDESC ;Display User Description
61 . D TASK Q:'$G(ZTSK) ;Task job
62 ;
63 I XSTAT D ASKPRINT Q ;Compiled
64 Q
65 ;
66COMPILE ; Look at all entries in the PATIENT file (#2).
67 N XCTR,XIEN,XPFAC
68 ;
69 K ^XTMP("DG53355A") ;Clean up old compile
70 S $P(XNODE,U)=1 ;Status=compiling
71 S $P(XNODE,U,2)=$G(ZTSK) ;TaskMan Task #
72 S $P(XNODE,U,3)=$$NOWDTTM() ;Compile Start Date/Time
73 S ^XTMP("DG53355A",0,0)=XNODE
74 ;
75 ; set up 0 node of ^XTMP to allow the system to purge after 30 days
76 S ^XTMP("DG53355A",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_ZTDESC
77 ;
78 S (XIEN,XCTR,ZTSTOP)=0
79 F S XIEN=$O(^DPT(XIEN)) Q:XIEN<1 D Q:ZTSTOP
80 . S $P(^XTMP("DG53355A",0,0),U,5)=XIEN ;last XIEN viewed
81 . S XCTR=XCTR+1 S:XCTR#1000=0 ZTSTOP=$$S^ZTLOAD("") ;Stop Request
82 . S XPFAC=$P($G(^DPT(XIEN,"ENR")),U,2) Q:XPFAC=""
83 . Q:$$TF^XUAF4(XPFAC) ;Quit if valid 'treating' Preferred Facility
84 . S ^XTMP("DG53355A",XPFAC,0)=$G(^XTMP("DG53355A",XPFAC,0))+1
85 . S ^XTMP("DG53355A",XPFAC,XIEN)=""
86 . S $P(^XTMP("DG53355A",0,0),U,6)=XIEN ;last XIEN filed in ^XTMP
87 ;
88 S $P(^XTMP("DG53355A",0,0),U,4)=$$NOWDTTM() ;Compile Stop Date/Time
89 S:'ZTSTOP $P(^XTMP("DG53355A",0,0),U)=2 ;Set status = compiled
90 ;
91 D SNDMSG(ZTSTOP)
92 S ZTREQ="@" ; remove job from TaskMan task log
93 ;
94 ; return to default error trap
95 S X="" S:$G(ZTSK)'="" X=^%ZOSF("ERRTN")
96 S @^%ZOSF("TRAP")
97 Q
98 ;
99ASKPRINT ; Prompt user to print detail report.
100 N DIR,DTOUT,DUOUT,DIRUT,DIROUT
101 W !!,"Compile Start Date/Time: ",$$FMTE^XLFDT($P(XNODE,U,3))
102 I XSTAT=1 D Q
103 . W !!,"Report is currently compiling!"
104 . W !,"A MailMan message will be sent when the compile is complete."
105 . W !
106 W !," Compile Stop Date/Time: ",$$FMTE^XLFDT($P(XNODE,U,4))
107 W !
108 ;
109 S DIR(0)="Y",DIR("A")="Print Detail Report",DIR("B")="YES"
110 D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!'Y Q
111 ;
112 ; Prompt user for device and to task job to TaskMan.
113 W ! D EN^XUTMDEVQ("PRINT^DG53355A(ZTDESC)",XDESC)
114 I $G(ZTQUEUED) W !!,"TaskMan Task: ",$G(ZTSK)
115 Q
116 ;
117PRINT(XDESC) ; Print detail report.
118 N XPFAC,XIEN,XNODE,XLNCNT,XPGNUM
119 S XPGNUM=0
120 D PRNHEAD
121 ;
122 I $D(^XTMP("DG53355A")) D
123 . S XPFAC=0 F S XPFAC=$O(^XTMP("DG53355A",XPFAC)) Q:XPFAC="" D
124 . . S XIEN=0 F S XIEN=$O(^XTMP("DG53355A",XPFAC,XIEN)) Q:XIEN="" D
125 . . . S XNODE=$G(^DPT(XIEN,0))
126 . . . W !,$P(XNODE,U,9)
127 . . . W ?15,$E($P(XNODE,U),1,30)
128 . . . W ?47,$E((XPFAC_" ("_$P($G(^DIC(4,XPFAC,0)),U)),1,30)_")"
129 . . . S XLNCNT=XLNCNT+1 D:XLNCNT=62 PRNHEAD
130 W !!,"*** END OF REPORT ***"
131 S ZTREQ="@" ; remove job from TaskMan task log
132 Q
133 ;
134SNDMSG(STAT) ; send MailMan message
135 N MSGDTM,QUIT,XLN,XMDUZ,XMSUB,XMTEXT,XMY,XTXT
136 ;
137 S STAT=+$G(STAT)
138 S MSGDTM=$$HTE^XLFDT($H) ;Current Date/Time
139 S XMTEXT="^TMP(""DG53355A"",$J,"
140 S XMSUB="Patch DG*5.3*355 ("_ZTDESC_")"
141 S XMDUZ=.5 ;indicate PostMaster is the sender
142 S XMY(DUZ)="" ;Send message to user starting job
143 ;
144 K ^TMP("DG53355A",$J)
145 D MSGADD(XMSUB)
146 D MSGADD("")
147 D MSGADD($S(STAT=-1:"Errored",STAT=1:"Stopped",1:"Finished")_" @ "_MSGDTM)
148 I STAT>-1 D
149 . D MSGADD("")
150 . D MSGADD("The compile process has completed. The detail report ")
151 . D MSGADD("can be viewed by returning to the original menu option.")
152 . D MSGADD("After 30 days the compiled data will be purged and the ")
153 . D MSGADD("report will have to be recompiled.")
154 . D MSGADD("")
155 . D MSGADD("Number of records for each non-treating Preferred Facility:")
156 . D MSGADD("")
157 . I $O(^XTMP("DG53355A",0))="" D MSGADD(" No Entries Found")
158 . S XPFAC=0 F S XPFAC=$O(^XTMP("DG53355A",XPFAC)) Q:XPFAC="" D
159 . . D MSGADD(" "_$P($G(^DIC(4,XPFAC,0)),U)_": "_+$G(^XTMP("DG53355A",XPFAC,0)))
160 D MSGADD("")
161 D MSGADD("*** End ***")
162 D ^XMD ;send Mailman message
163 K ^TMP("DG53355A",$J)
164 Q
165 ;
166MSGADD(XLINE) N MSGLINE
167 S MSGLINE=$O(^TMP("DG53355A",$J,""),-1)+1
168 S ^TMP("DG53355A",$J,MSGLINE)=$G(XLINE)
169 Q
170 ;
171TASK ;Task job using TaskMan
172 N ZTDESC,ZTIO,ZTRTN
173 S ZTIO="",ZTRTN="COMPILE^DG53355A",ZTDESC=XDESC
174 W ! D ^%ZTLOAD
175 W:$G(ZTSK) !!,"TaskMan Task: ",$G(ZTSK)
176 Q
177 ;
178NOWDTTM() N %,%H,%I,X D NOW^%DTC Q %
179 ;
180PRNHEAD ; Print report heading
181 N X
182 S XLNCNT=8,XPGNUM=XPGNUM+1
183 W @IOF,!!!,?(80-$L(XDESC)/2),XDESC
184 W !!,"Run Date: ",$$HTE^XLFDT($H),?68,"Page: ",XPGNUM
185 W !!,"Veteran SSN",?15,"Veteran Name"
186 W ?47,"Current Preferred Facility"
187 W !,"===========",?15,"============"
188 W ?47,"=========================="
189 Q
190 ;
191ERROR ; Record error and send MailMan message
192 N X S X=""
193 D SNDMSG(-1)
194 S:$G(ZTSK)'="" X=^%ZOSF("ERRTN")
195 S @^%ZOSF("TRAP")
196 D ^%ZTER ;call Kernel error trap
197 Q
198 ;
199USERDESC() ;Write description to the screen for the user
200 W !!,"This process will find all patients that have a non-treating"
201 W !,"Preferred Facility on file. All identified patients will need"
202 W !,"to have their Preferred Facility changed to a valid treating"
203 W !,"facility.",!
204 W !,"The clean up process will perform the following steps in order:"
205 W !," 1) Compile the patient data. (This step looks at "
206 W !," every patient in the PATIENT (#2) file.) A summary"
207 W !," MailMan message will be sent to the user when the"
208 W !," compile is complete."
209 W !," 2) The user will need to return to this option to print"
210 W !," the detail report within 30 days to avoid recompiling."
211 W !," NOTE: The system will purge the compiled data after 30"
212 W !," days!"
213 W !!,"All compiled data will be stored in the ^XTMP(""DG53355A"") "
214 W "global.",!
215 ;
216 K DIR S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO"
217 D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!'Y Q 0
218 Q 1
Note: See TracBrowser for help on using the repository browser.