source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDXPRG0.m@ 1361

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

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1SCDXPRG0 ;ALB/JRP - ACRP PURGING;04-SEP-97 ; 19 Oct 98 1:16 PM
2 ;;5.3;Scheduling;**128,163**;AUG 13, 1993
3 ;
4MAIN ;Main entry point (used by option)
5 ;Declare variables
6 N SCDXBEG,SCDXEND,SCDXH,X
7 N ZTSK,ZTIO,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
8 ;Get date range for purge
9 ; Earliest purge date allowed is ACRP cut-over date
10 S SCDXBEG=2961001
11 ; Latest purge date allowed is last day of month prior to previous FY
12 ; database close-out date
13 S SCDXEND=$E(DT,1,3)_"0930"
14 S SCDXEND=$S(DT>SCDXEND:SCDXEND-10000,1:SCDXEND-20000)
15 ;Begin date help text
16 S SCDXH("B",1)="Enter encounter date to begin purging from"
17 S SCDXH("B",2)=" "
18 S SCDXH("B",3)=$$FMTE^XLFDT(SCDXBEG)_" is the earliest date allowed"
19 S SCDXH("B",4)=$$FMTE^XLFDT(SCDXEND)_" will be the latest date allowed"
20 S SCDXH("B",5)=" "
21 S SCDXH("B",6)="Note: The latest date allowed is the last day of the"
22 S SCDXH("B")=" month prior to the previous Fiscal Year."
23 ;End date help text
24 S SCDXH("E",1)="Enter encounter date to end purging at"
25 S SCDXH("E",2)=" "
26 S SCDXH("E",3)=$$FMTE^XLFDT(SCDXEND)_" is the latest date allowed"
27 S SCDXH("E",4)=$$FMTE^XLFDT(SCDXBEG)_" was the earliest date allowed"
28 S SCDXH("E",5)=" "
29 S SCDXH("E",6)="Note: The latest date allowed is the last day of the"
30 S SCDXH("E")=" month prior to the previous Fiscal Year."
31 S X=$$GETDTRNG^SCDXUTL1(SCDXBEG,SCDXEND,$NA(SCDXH("B")),$NA(SCDXH("E")))
32 ;User aborted - quit
33 I (X<0) W !!,"** Purging of ACRP files not queued **",!! Q
34 K SCDXH
35 S SCDXBEG=+$P(X,"^",1)
36 S SCDXEND=+$P(X,"^",2)
37 ;Task purging
38 S ZTDESC="Purging of ACRP files from "_$$FMTE^XLFDT(SCDXBEG,2)_" to "_$$FMTE^XLFDT(SCDXEND,2)
39 S ZTRTN="TASK^SCDXPRG0"
40 S ZTSAVE("SCDXBEG")=SCDXBEG
41 S ZTSAVE("SCDXEND")=SCDXEND
42 S ZTIO=""
43 S ZTDTH=""
44 S ZTSK=""
45 D ^%ZTLOAD
46 S ZTSK=+$G(ZTSK)
47 ;Error tasking
48 W:('ZTSK) !!,"** Purging of ACRP files not queued **",!!
49 ;Tasked
50 W:(ZTSK) !!,"Purging of ACRP files queued as task number ",ZTSK,!!
51 ;Done
52 Q
53 ;
54TASK ;Task entry point
55 ;
56 ;Input : SCDXBEG - Begin date (FileMan)
57 ; SCDXEND - End date (FileMan)
58 ;Output : None
59 ;Notes : Existance and validity of input is assumed
60 ;
61 ;Don't purge if task was asked to stop
62 I ('$$S^%ZTLOAD()) D PURGE(SCDXBEG,SCDXEND)
63 ;Done
64 S:($D(ZTQUEUED)) ZTREQ="@"
65 Q
66 ;
67PURGE(BEGDATE,ENDDATE) ;Purge ACRP files over a given date range
68 ;
69 ;Input : BEGDATE - Encounter date to begin purging from (FileMan)
70 ; Defaults to beginning of last fiscal year
71 ; ENDDATE - Encounter date to end purging at (FileMan)
72 ; Defaults to end of last fiscal year
73 ;Output : None
74 ;Notes : Purging affects the following files
75 ; - Transmitted Outpatient Encounter file (#409.73)
76 ; - Deleted Outpatient Encounter file (#409.74)
77 ; - Transmitted Outpatient Encounter Error file (#409.75)
78 ; - ACRP Transmission History file (#409.77)
79 ;
80 ;Check input
81 S BEGDATE=+$G(BEGDATE)
82 S:('BEGDATE) BEGDATE=+$P($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",1)
83 S ENDDATE=+$G(ENDDATE)
84 S:('ENDDATE) ENDDATE=+$P($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",2)
85 ;Declare variables
86 N TMP,DATE,ENCPTR,XMITPTR,DELPTR,ENCPRG,DELPRG
87 ;Initialize purge counts
88 S (ENCPRG,DELPRG)=0
89 ;Make begin and end dates opposing midnights
90 S BEGDATE=$P(BEGDATE,".",1)
91 S ENDDATE=$P(ENDDATE,".",1)_".235959"
92 ;Loop through Outpatient Encounter file (#409.68)
93 S DATE=BEGDATE
94 F S DATE=+$O(^SCE("B",DATE)) Q:(('DATE)!(DATE>ENDDATE)) D Q:($$S^%ZTLOAD())
95 .S ENCPTR=0
96 .F S ENCPTR=+$O(^SCE("B",DATE,ENCPTR)) Q:('ENCPTR) D
97 ..;Find associated entry in Transmitted Outpatient Encounter file
98 ..S XMITPTR=+$$FINDXMIT^SCDXFU01(ENCPTR)
99 ..Q:('XMITPTR)
100 ..;Increment purge count
101 ..S ENCPRG=ENCPRG+1
102 ..;Delete from Transmitted Outpatient Encounter file
103 ..S TMP=$$DELXMIT^SCDXFU03(XMITPTR)
104 ;Task asked to stop (jump to message generation)
105 I ($$S^%ZTLOAD()) G MSG
106 ;Loop through Deleted Outpatient Encounter file (#409.74)
107 S DATE=BEGDATE
108 F S DATE=+$O(^SD(409.74,"B",DATE)) Q:(('DATE)!(DATE>ENDDATE)) D Q:($$S^%ZTLOAD())
109 .S DELPTR=0
110 .F S DELPTR=+$O(^SD(409.74,"B",DATE,DELPTR)) Q:('DELPTR) D
111 ..;Find associated entry in Transmitted Outpatient Encounter file
112 ..S XMITPTR=+$$FINDXMIT^SCDXFU01(0,DELPTR)
113 ..Q:('XMITPTR)
114 ..;Increment purge count
115 ..S DELPRG=DELPRG+1
116 ..;Delete from Transmitted Outpatient Encounter file
117 ..S TMP=$$DELXMIT^SCDXFU03(XMITPTR)
118MSG ;Generate completion message
119 K TMP
120 N XMSUB,XMTEXT,XMDUZ,XMY,XMZ
121 ;Build message text
122 I ($$S^%ZTLOAD()) D
123 .;Asked to stop
124 .S TMP(1,0)="** Purging was asked to stop **"
125 .S TMP(2,0)=" "
126 S TMP(3,0)=(ENCPRG+DELPRG)_" entries were purged from the Transmitted Outpatient Encounter file"
127 S TMP(4,0)="(#409.73). "_ENCPRG_" of them pointed to entries in the Outpatient Encounter"
128 S TMP(5,0)="file (#409.68) and "_DELPRG_" of them pointed to entries in the Deleted Outpatient"
129 S TMP(6,0)="Encounter file (#409.74)."
130 ;Send to current user
131 S XMSUB="Purging of ACRP files from "_$$FMTE^XLFDT(BEGDATE,"2D")_" to "_$$FMTE^XLFDT(ENDDATE,"2D")
132 S XMTEXT="TMP("
133 S XMDUZ="ACRP PURGER"
134 S XMY(DUZ)=""
135 D ^XMD
136 ;Done
137 Q
Note: See TracBrowser for help on using the repository browser.