SCDXPRG0 ;ALB/JRP - ACRP PURGING;04-SEP-97 ; 19 Oct 98 1:16 PM
;;5.3;Scheduling;**128,163**;AUG 13, 1993
;
MAIN ;Main entry point (used by option)
;Declare variables
N SCDXBEG,SCDXEND,SCDXH,X
N ZTSK,ZTIO,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
;Get date range for purge
; Earliest purge date allowed is ACRP cut-over date
S SCDXBEG=2961001
; Latest purge date allowed is last day of month prior to previous FY
; database close-out date
S SCDXEND=$E(DT,1,3)_"0930"
S SCDXEND=$S(DT>SCDXEND:SCDXEND-10000,1:SCDXEND-20000)
;Begin date help text
S SCDXH("B",1)="Enter encounter date to begin purging from"
S SCDXH("B",2)=" "
S SCDXH("B",3)=$$FMTE^XLFDT(SCDXBEG)_" is the earliest date allowed"
S SCDXH("B",4)=$$FMTE^XLFDT(SCDXEND)_" will be the latest date allowed"
S SCDXH("B",5)=" "
S SCDXH("B",6)="Note: The latest date allowed is the last day of the"
S SCDXH("B")=" month prior to the previous Fiscal Year."
;End date help text
S SCDXH("E",1)="Enter encounter date to end purging at"
S SCDXH("E",2)=" "
S SCDXH("E",3)=$$FMTE^XLFDT(SCDXEND)_" is the latest date allowed"
S SCDXH("E",4)=$$FMTE^XLFDT(SCDXBEG)_" was the earliest date allowed"
S SCDXH("E",5)=" "
S SCDXH("E",6)="Note: The latest date allowed is the last day of the"
S SCDXH("E")=" month prior to the previous Fiscal Year."
S X=$$GETDTRNG^SCDXUTL1(SCDXBEG,SCDXEND,$NA(SCDXH("B")),$NA(SCDXH("E")))
;User aborted - quit
I (X<0) W !!,"** Purging of ACRP files not queued **",!! Q
K SCDXH
S SCDXBEG=+$P(X,"^",1)
S SCDXEND=+$P(X,"^",2)
;Task purging
S ZTDESC="Purging of ACRP files from "_$$FMTE^XLFDT(SCDXBEG,2)_" to "_$$FMTE^XLFDT(SCDXEND,2)
S ZTRTN="TASK^SCDXPRG0"
S ZTSAVE("SCDXBEG")=SCDXBEG
S ZTSAVE("SCDXEND")=SCDXEND
S ZTIO=""
S ZTDTH=""
S ZTSK=""
D ^%ZTLOAD
S ZTSK=+$G(ZTSK)
;Error tasking
W:('ZTSK) !!,"** Purging of ACRP files not queued **",!!
;Tasked
W:(ZTSK) !!,"Purging of ACRP files queued as task number ",ZTSK,!!
;Done
Q
;
TASK ;Task entry point
;
;Input : SCDXBEG - Begin date (FileMan)
; SCDXEND - End date (FileMan)
;Output : None
;Notes : Existance and validity of input is assumed
;
;Don't purge if task was asked to stop
I ('$$S^%ZTLOAD()) D PURGE(SCDXBEG,SCDXEND)
;Done
S:($D(ZTQUEUED)) ZTREQ="@"
Q
;
PURGE(BEGDATE,ENDDATE) ;Purge ACRP files over a given date range
;
;Input : BEGDATE - Encounter date to begin purging from (FileMan)
; Defaults to beginning of last fiscal year
; ENDDATE - Encounter date to end purging at (FileMan)
; Defaults to end of last fiscal year
;Output : None
;Notes : Purging affects the following files
; - Transmitted Outpatient Encounter file (#409.73)
; - Deleted Outpatient Encounter file (#409.74)
; - Transmitted Outpatient Encounter Error file (#409.75)
; - ACRP Transmission History file (#409.77)
;
;Check input
S BEGDATE=+$G(BEGDATE)
S:('BEGDATE) BEGDATE=+$P($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",1)
S ENDDATE=+$G(ENDDATE)
S:('ENDDATE) ENDDATE=+$P($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",2)
;Declare variables
N TMP,DATE,ENCPTR,XMITPTR,DELPTR,ENCPRG,DELPRG
;Initialize purge counts
S (ENCPRG,DELPRG)=0
;Make begin and end dates opposing midnights
S BEGDATE=$P(BEGDATE,".",1)
S ENDDATE=$P(ENDDATE,".",1)_".235959"
;Loop through Outpatient Encounter file (#409.68)
S DATE=BEGDATE
F S DATE=+$O(^SCE("B",DATE)) Q:(('DATE)!(DATE>ENDDATE)) D Q:($$S^%ZTLOAD())
.S ENCPTR=0
.F S ENCPTR=+$O(^SCE("B",DATE,ENCPTR)) Q:('ENCPTR) D
..;Find associated entry in Transmitted Outpatient Encounter file
..S XMITPTR=+$$FINDXMIT^SCDXFU01(ENCPTR)
..Q:('XMITPTR)
..;Increment purge count
..S ENCPRG=ENCPRG+1
..;Delete from Transmitted Outpatient Encounter file
..S TMP=$$DELXMIT^SCDXFU03(XMITPTR)
;Task asked to stop (jump to message generation)
I ($$S^%ZTLOAD()) G MSG
;Loop through Deleted Outpatient Encounter file (#409.74)
S DATE=BEGDATE
F S DATE=+$O(^SD(409.74,"B",DATE)) Q:(('DATE)!(DATE>ENDDATE)) D Q:($$S^%ZTLOAD())
.S DELPTR=0
.F S DELPTR=+$O(^SD(409.74,"B",DATE,DELPTR)) Q:('DELPTR) D
..;Find associated entry in Transmitted Outpatient Encounter file
..S XMITPTR=+$$FINDXMIT^SCDXFU01(0,DELPTR)
..Q:('XMITPTR)
..;Increment purge count
..S DELPRG=DELPRG+1
..;Delete from Transmitted Outpatient Encounter file
..S TMP=$$DELXMIT^SCDXFU03(XMITPTR)
MSG ;Generate completion message
K TMP
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ
;Build message text
I ($$S^%ZTLOAD()) D
.;Asked to stop
.S TMP(1,0)="** Purging was asked to stop **"
.S TMP(2,0)=" "
S TMP(3,0)=(ENCPRG+DELPRG)_" entries were purged from the Transmitted Outpatient Encounter file"
S TMP(4,0)="(#409.73). "_ENCPRG_" of them pointed to entries in the Outpatient Encounter"
S TMP(5,0)="file (#409.68) and "_DELPRG_" of them pointed to entries in the Deleted Outpatient"
S TMP(6,0)="Encounter file (#409.74)."
;Send to current user
S XMSUB="Purging of ACRP files from "_$$FMTE^XLFDT(BEGDATE,"2D")_" to "_$$FMTE^XLFDT(ENDDATE,"2D")
S XMTEXT="TMP("
S XMDUZ="ACRP PURGER"
S XMY(DUZ)=""
D ^XMD
;Done
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXPRG0 5222 printed Dec 13, 2024@02:39:25 Page 2
SCDXPRG0 ;ALB/JRP - ACRP PURGING;04-SEP-97 ; 19 Oct 98 1:16 PM
+1 ;;5.3;Scheduling;**128,163**;AUG 13, 1993
+2 ;
MAIN ;Main entry point (used by option)
+1 ;Declare variables
+2 NEW SCDXBEG,SCDXEND,SCDXH,X
+3 NEW ZTSK,ZTIO,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
+4 ;Get date range for purge
+5 ; Earliest purge date allowed is ACRP cut-over date
+6 SET SCDXBEG=2961001
+7 ; Latest purge date allowed is last day of month prior to previous FY
+8 ; database close-out date
+9 SET SCDXEND=$EXTRACT(DT,1,3)_"0930"
+10 SET SCDXEND=$SELECT(DT>SCDXEND:SCDXEND-10000,1:SCDXEND-20000)
+11 ;Begin date help text
+12 SET SCDXH("B",1)="Enter encounter date to begin purging from"
+13 SET SCDXH("B",2)=" "
+14 SET SCDXH("B",3)=$$FMTE^XLFDT(SCDXBEG)_" is the earliest date allowed"
+15 SET SCDXH("B",4)=$$FMTE^XLFDT(SCDXEND)_" will be the latest date allowed"
+16 SET SCDXH("B",5)=" "
+17 SET SCDXH("B",6)="Note: The latest date allowed is the last day of the"
+18 SET SCDXH("B")=" month prior to the previous Fiscal Year."
+19 ;End date help text
+20 SET SCDXH("E",1)="Enter encounter date to end purging at"
+21 SET SCDXH("E",2)=" "
+22 SET SCDXH("E",3)=$$FMTE^XLFDT(SCDXEND)_" is the latest date allowed"
+23 SET SCDXH("E",4)=$$FMTE^XLFDT(SCDXBEG)_" was the earliest date allowed"
+24 SET SCDXH("E",5)=" "
+25 SET SCDXH("E",6)="Note: The latest date allowed is the last day of the"
+26 SET SCDXH("E")=" month prior to the previous Fiscal Year."
+27 SET X=$$GETDTRNG^SCDXUTL1(SCDXBEG,SCDXEND,$NAME(SCDXH("B")),$NAME(SCDXH("E")))
+28 ;User aborted - quit
+29 IF (X<0)
WRITE !!,"** Purging of ACRP files not queued **",!!
QUIT
+30 KILL SCDXH
+31 SET SCDXBEG=+$PIECE(X,"^",1)
+32 SET SCDXEND=+$PIECE(X,"^",2)
+33 ;Task purging
+34 SET ZTDESC="Purging of ACRP files from "_$$FMTE^XLFDT(SCDXBEG,2)_" to "_$$FMTE^XLFDT(SCDXEND,2)
+35 SET ZTRTN="TASK^SCDXPRG0"
+36 SET ZTSAVE("SCDXBEG")=SCDXBEG
+37 SET ZTSAVE("SCDXEND")=SCDXEND
+38 SET ZTIO=""
+39 SET ZTDTH=""
+40 SET ZTSK=""
+41 DO ^%ZTLOAD
+42 SET ZTSK=+$GET(ZTSK)
+43 ;Error tasking
+44 if ('ZTSK)
WRITE !!,"** Purging of ACRP files not queued **",!!
+45 ;Tasked
+46 if (ZTSK)
WRITE !!,"Purging of ACRP files queued as task number ",ZTSK,!!
+47 ;Done
+48 QUIT
+49 ;
TASK ;Task entry point
+1 ;
+2 ;Input : SCDXBEG - Begin date (FileMan)
+3 ; SCDXEND - End date (FileMan)
+4 ;Output : None
+5 ;Notes : Existance and validity of input is assumed
+6 ;
+7 ;Don't purge if task was asked to stop
+8 IF ('$$S^%ZTLOAD())
DO PURGE(SCDXBEG,SCDXEND)
+9 ;Done
+10 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
+11 QUIT
+12 ;
PURGE(BEGDATE,ENDDATE) ;Purge ACRP files over a given date range
+1 ;
+2 ;Input : BEGDATE - Encounter date to begin purging from (FileMan)
+3 ; Defaults to beginning of last fiscal year
+4 ; ENDDATE - Encounter date to end purging at (FileMan)
+5 ; Defaults to end of last fiscal year
+6 ;Output : None
+7 ;Notes : Purging affects the following files
+8 ; - Transmitted Outpatient Encounter file (#409.73)
+9 ; - Deleted Outpatient Encounter file (#409.74)
+10 ; - Transmitted Outpatient Encounter Error file (#409.75)
+11 ; - ACRP Transmission History file (#409.77)
+12 ;
+13 ;Check input
+14 SET BEGDATE=+$GET(BEGDATE)
+15 if ('BEGDATE)
SET BEGDATE=+$PIECE($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",1)
+16 SET ENDDATE=+$GET(ENDDATE)
+17 if ('ENDDATE)
SET ENDDATE=+$PIECE($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",2)
+18 ;Declare variables
+19 NEW TMP,DATE,ENCPTR,XMITPTR,DELPTR,ENCPRG,DELPRG
+20 ;Initialize purge counts
+21 SET (ENCPRG,DELPRG)=0
+22 ;Make begin and end dates opposing midnights
+23 SET BEGDATE=$PIECE(BEGDATE,".",1)
+24 SET ENDDATE=$PIECE(ENDDATE,".",1)_".235959"
+25 ;Loop through Outpatient Encounter file (#409.68)
+26 SET DATE=BEGDATE
+27 FOR
SET DATE=+$ORDER(^SCE("B",DATE))
if (('DATE)!(DATE>ENDDATE))
QUIT
Begin DoDot:1
+28 SET ENCPTR=0
+29 FOR
SET ENCPTR=+$ORDER(^SCE("B",DATE,ENCPTR))
if ('ENCPTR)
QUIT
Begin DoDot:2
+30 ;Find associated entry in Transmitted Outpatient Encounter file
+31 SET XMITPTR=+$$FINDXMIT^SCDXFU01(ENCPTR)
+32 if ('XMITPTR)
QUIT
+33 ;Increment purge count
+34 SET ENCPRG=ENCPRG+1
+35 ;Delete from Transmitted Outpatient Encounter file
+36 SET TMP=$$DELXMIT^SCDXFU03(XMITPTR)
End DoDot:2
End DoDot:1
if ($$S^%ZTLOAD())
QUIT
+37 ;Task asked to stop (jump to message generation)
+38 IF ($$S^%ZTLOAD())
GOTO MSG
+39 ;Loop through Deleted Outpatient Encounter file (#409.74)
+40 SET DATE=BEGDATE
+41 FOR
SET DATE=+$ORDER(^SD(409.74,"B",DATE))
if (('DATE)!(DATE>ENDDATE))
QUIT
Begin DoDot:1
+42 SET DELPTR=0
+43 FOR
SET DELPTR=+$ORDER(^SD(409.74,"B",DATE,DELPTR))
if ('DELPTR)
QUIT
Begin DoDot:2
+44 ;Find associated entry in Transmitted Outpatient Encounter file
+45 SET XMITPTR=+$$FINDXMIT^SCDXFU01(0,DELPTR)
+46 if ('XMITPTR)
QUIT
+47 ;Increment purge count
+48 SET DELPRG=DELPRG+1
+49 ;Delete from Transmitted Outpatient Encounter file
+50 SET TMP=$$DELXMIT^SCDXFU03(XMITPTR)
End DoDot:2
End DoDot:1
if ($$S^%ZTLOAD())
QUIT
MSG ;Generate completion message
+1 KILL TMP
+2 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ
+3 ;Build message text
+4 IF ($$S^%ZTLOAD())
Begin DoDot:1
+5 ;Asked to stop
+6 SET TMP(1,0)="** Purging was asked to stop **"
+7 SET TMP(2,0)=" "
End DoDot:1
+8 SET TMP(3,0)=(ENCPRG+DELPRG)_" entries were purged from the Transmitted Outpatient Encounter file"
+9 SET TMP(4,0)="(#409.73). "_ENCPRG_" of them pointed to entries in the Outpatient Encounter"
+10 SET TMP(5,0)="file (#409.68) and "_DELPRG_" of them pointed to entries in the Deleted Outpatient"
+11 SET TMP(6,0)="Encounter file (#409.74)."
+12 ;Send to current user
+13 SET XMSUB="Purging of ACRP files from "_$$FMTE^XLFDT(BEGDATE,"2D")_" to "_$$FMTE^XLFDT(ENDDATE,"2D")
+14 SET XMTEXT="TMP("
+15 SET XMDUZ="ACRP PURGER"
+16 SET XMY(DUZ)=""
+17 DO ^XMD
+18 ;Done
+19 QUIT
