Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCDXPRG0

SCDXPRG0.m

Go to the documentation of this file. 
  1. SCDXPRG0 ;ALB/JRP - ACRP PURGING;04-SEP-97 ; 19 Oct 98  1:16 PM
  1.  ;;5.3;Scheduling;**128,163,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. MAIN ;Main entry point (used by option)
  1.  ;Declare variables
  1.  N SCDXBEG,SCDXEND,SCDXH,X
  1.  N ZTSK,ZTIO,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
  1.  ;Get date range for purge
  1.  ; Earliest purge date allowed is ACRP cut-over date
  1.  S SCDXBEG=2961001
  1.  ; Latest purge date allowed is last day of month prior to previous FY
  1.  ;  database close-out date
  1.  S SCDXEND=$E(DT,1,3)_"0930"
  1.  S SCDXEND=$S(DT>SCDXEND:SCDXEND-10000,1:SCDXEND-20000)
  1.  ;Begin date help text
  1.  S SCDXH("B",1)="Enter encounter date to begin purging from"
  1.  S SCDXH("B",2)=" "
  1.  S SCDXH("B",3)=$$FMTE^XLFDT(SCDXBEG)_" is the earliest date allowed"
  1.  S SCDXH("B",4)=$$FMTE^XLFDT(SCDXEND)_" will be the latest date allowed"
  1.  S SCDXH("B",5)=" "
  1.  S SCDXH("B",6)="Note: The latest date allowed is the last day of the"
  1.  S SCDXH("B")="      month prior to the previous Fiscal Year."
  1.  ;End date help text
  1.  S SCDXH("E",1)="Enter encounter date to end purging at"
  1.  S SCDXH("E",2)=" "
  1.  S SCDXH("E",3)=$$FMTE^XLFDT(SCDXEND)_" is the latest date allowed"
  1.  S SCDXH("E",4)=$$FMTE^XLFDT(SCDXBEG)_" was the earliest date allowed"
  1.  S SCDXH("E",5)=" "
  1.  S SCDXH("E",6)="Note: The latest date allowed is the last day of the"
  1.  S SCDXH("E")="      month prior to the previous Fiscal Year."
  1.  S X=$$GETDTRNG^SCDXUTL1(SCDXBEG,SCDXEND,$NA(SCDXH("B")),$NA(SCDXH("E")))
  1.  ;User aborted - quit
  1.  I (X<0) W !!,"** Purging of ACRP files not queued **",!! Q
  1.  K SCDXH
  1.  S SCDXBEG=+$P(X,"^",1)
  1.  S SCDXEND=+$P(X,"^",2)
  1.  ;Task purging
  1.  S ZTDESC="Purging of ACRP files from "_$$FMTE^XLFDT(SCDXBEG,2)_" to "_$$FMTE^XLFDT(SCDXEND,2)
  1.  S ZTRTN="TASK^SCDXPRG0"
  1.  S ZTSAVE("SCDXBEG")=SCDXBEG
  1.  S ZTSAVE("SCDXEND")=SCDXEND
  1.  S ZTIO=""
  1.  S ZTDTH=""
  1.  S ZTSK=""
  1.  D ^%ZTLOAD
  1.  S ZTSK=+$G(ZTSK)
  1.  ;Error tasking
  1.  W:('ZTSK) !!,"** Purging of ACRP files not queued **",!!
  1.  ;Tasked
  1.  W:(ZTSK) !!,"Purging of ACRP files queued as task number ",ZTSK,!!
  1.  ;Done
  1.  Q
  1.  ;
  1. TASK ;Task entry point
  1.  ;
  1.  ;Input  : SCDXBEG - Begin date (FileMan)
  1.  ;         SCDXEND - End date (FileMan)
  1.  ;Output : None
  1.  ;Notes  : Existance and validity of input is assumed
  1.  ;
  1.  ;Don't purge if task was asked to stop
  1.  I ('$$S^%ZTLOAD()) D PURGE(SCDXBEG,SCDXEND)
  1.  ;Done
  1.  S:($D(ZTQUEUED)) ZTREQ="@"
  1.  Q
  1.  ;
  1. PURGE(BEGDATE,ENDDATE) ;Purge ACRP files over a given date range
  1.  ;
  1.  ;Input  : BEGDATE - Encounter date to begin purging from (FileMan)
  1.  ;                   Defaults to beginning of last fiscal year
  1.  ;         ENDDATE - Encounter date to end purging at (FileMan)
  1.  ;                   Defaults to end of last fiscal year
  1.  ;Output : None
  1.  ;Notes  : Purging affects the following files
  1.  ;          - Transmitted Outpatient Encounter file (#409.73)
  1.  ;          - Deleted Outpatient Encounter file (#409.74)
  1.  ;          - Transmitted Outpatient Encounter Error file (#409.75)
  1.  ;          - ACRP Transmission History file (#409.77)
  1.  ;
  1.  ;Check input
  1.  S BEGDATE=+$G(BEGDATE)
  1.  S:('BEGDATE) BEGDATE=+$P($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",1)
  1.  S ENDDATE=+$G(ENDDATE)
  1.  S:('ENDDATE) ENDDATE=+$P($$DR4FY^SCDXPRGD($$PREVFY^SCDXPRGD()),"^",2)
  1.  ;Declare variables
  1.  N TMP,DATE,ENCPTR,XMITPTR,DELPTR,ENCPRG,DELPRG
  1.  ;Initialize purge counts
  1.  S (ENCPRG,DELPRG)=0
  1.  ;Make begin and end dates opposing midnights
  1.  S BEGDATE=$P(BEGDATE,".",1)
  1.  S ENDDATE=$P(ENDDATE,".",1)_".235959"
  1.  ;Loop through Outpatient Encounter file (#409.68)
  1.  S DATE=BEGDATE
  1.  F  S DATE=+$O(^SCE("B",DATE)) Q:(('DATE)!(DATE>ENDDATE))  D  Q:($$S^%ZTLOAD())
  1.  .S ENCPTR=0
  1.  .F  S ENCPTR=+$O(^SCE("B",DATE,ENCPTR)) Q:('ENCPTR)  D
  1.  ..;Find associated entry in Transmitted Outpatient Encounter file
  1.  ..S XMITPTR=+$$FINDXMIT^SCDXFU01(ENCPTR)
  1.  ..Q:('XMITPTR)
  1.  ..;Increment purge count
  1.  ..S ENCPRG=ENCPRG+1
  1.  ..;Delete from Transmitted Outpatient Encounter file
  1.  ..S TMP=$$DELXMIT^SCDXFU03(XMITPTR)
  1.  ;Task asked to stop (jump to message generation)
  1.  I ($$S^%ZTLOAD()) G MSG
  1.  ;Loop through Deleted Outpatient Encounter file (#409.74)
  1.  S DATE=BEGDATE
  1.  F  S DATE=+$O(^SD(409.74,"B",DATE)) Q:(('DATE)!(DATE>ENDDATE))  D  Q:($$S^%ZTLOAD())
  1.  .S DELPTR=0
  1.  .F  S DELPTR=+$O(^SD(409.74,"B",DATE,DELPTR)) Q:('DELPTR)  D
  1.  ..;Find associated entry in Transmitted Outpatient Encounter file
  1.  ..S XMITPTR=+$$FINDXMIT^SCDXFU01(0,DELPTR)
  1.  ..Q:('XMITPTR)
  1.  ..;Increment purge count
  1.  ..S DELPRG=DELPRG+1
  1.  ..;Delete from Transmitted Outpatient Encounter file
  1.  ..S TMP=$$DELXMIT^SCDXFU03(XMITPTR)
  1. MSG ;Generate completion message
  1.  K TMP
  1.  N XMSUB,XMTEXT,XMDUZ,XMY,XMZ
  1.  ;Build message text
  1.  I ($$S^%ZTLOAD()) D
  1.  .;Asked to stop
  1.  .S TMP(1,0)="** Purging was asked to stop **"
  1.  .S TMP(2,0)=" "
  1.  S TMP(3,0)=(ENCPRG+DELPRG)_" entries were purged from the Transmitted Outpatient Encounter file"
  1.  S TMP(4,0)="(#409.73).  "_ENCPRG_" of them pointed to entries in the Outpatient Encounter"
  1.  S TMP(5,0)="file (#409.68) and "_DELPRG_" of them pointed to entries in the Deleted Outpatient"
  1.  S TMP(6,0)="Encounter file (#409.74)."
  1.  ;Send to current user
  1.  S XMSUB="Purging of ACRP files from "_$$FMTE^XLFDT(BEGDATE,"2D")_" to "_$$FMTE^XLFDT(ENDDATE,"2D")
  1.  S XMTEXT="TMP("
  1.  S XMDUZ="ACRP PURGER"
  1.  S XMY(DUZ)=""
  1.  D ^XMD
  1.  ;Done
  1.  Q