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

DG714.m

Go to the documentation of this file. 
  1. DG714 ;ALB/GAH - Deceased Patient Means Test Cleanup ; 18-SEP-2006 15:41
  1.  ;;5.3;Registration;**714**;14-AUG-2006;Build 5
  1.  ;
  1.  ; This program will loop through all veterans on the system that
  1.  ; have means tests.  For those people that are deceased, their last
  1.  ; means test will be deleted if it has a status of REQUIRED.
  1.  ; 
  1.  ; ^XTMP("DG714",0,0)=DELRECS^DFNLST^STATUS^STARTTM^ENDTIME^TOTRECS
  1.  ;    where   DELRECS = Number of patients that had means tests deleted
  1.  ;            DFNLST  = Last record number examined
  1.  ;            STATUS  = RUNNING   - Job is still processing
  1.  ;                      COMPLETED - Job processed all records
  1.  ;                      STOPPED   - Job was stopped before completion
  1.  ;            STARTTM = Date/Time when job was started in FM format
  1.  ;            ENDTIME = Date/Time when job stopped or completed in FM format
  1.  ;            TOTRECS = Total number of record examined
  1.  ;
  1.  ; ^XTMP("DG714",1,"TASK")=ZTSK
  1.  ;    where   ZTSK    = Taskman task number
  1.  ;
  1.  ; ^XTMP("DG714",1,"STOP")=ZTSTOP
  1.  ;    where   ZTSTOP    = 1 to stop the job
  1.  ;
  1.  ; ^XTMP("DG714","TEST")=""
  1.  ;    This node is set to send mail to a test account during testing
  1.  ;    It will not be set in production
  1.  ;
  1.  ; Must be run from line tag
  1.  Q
  1.  ;
  1. START ;Start process
  1.  N NAMSPC,TASK,U
  1.  S U="^"
  1.  S NAMSPC=$$NAMSPC
  1.  S TASK=$P($G(^XTMP(NAMSPC,1,"TASK")),U,3)
  1.  Q:TASK&$$ACTIVE(TASK)   ; Quit if already running
  1.  D QUEUE($$QTIME)
  1.  Q
  1. QUEUE(ZTDTH)    ; Queue the process
  1.  N NAMSPC,ZTRTN,ZTDESC,ZTIO,ZTSK
  1.  S NAMSPC=$$NAMSPC
  1.  S ZTRTN="QUE^"_NAMSPC
  1.  S ZTDESC=NAMSPC_" - Remove REQUIRED MT for deceased patients"
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  K ^XTMP(NAMSPC,1,"TASK")
  1.  I '$D(ZTSK) S ^XTMP(NAMSPC,1,"TASK")="Unable to queue post-install process."
  1.  I $D(ZTSK) S ^XTMP(NAMSPC,1,"TASK")=$G(ZTSK)
  1.  D HOME^%ZIS
  1.  Q
  1. QTIME() ; Get the run time for queuing
  1.  N %,%H,%I,X
  1.  D NOW^%DTC
  1.  Q $P(%,".")_"."_$E($P(%,".",2),1,4)
  1.  ;
  1. TEST(START,END,PROCESS) ;Entry point for testing
  1.  ; There is a range given so no need for the old data in ^XTMP
  1.  K ^XTMP($$NAMSPC,0)
  1.  S START=+START
  1.  ; START is the first record to be processed so prime it for $O
  1.  I START'=0 S START=$O(^DGMT(408.31,"AID",1,START),-1)
  1.  I END'="" S END=$O(^DGMT(408.31,"AID",1,END))
  1.  S TESTING=1
  1.  D QUE
  1.  Q
  1. QUE    ;
  1.  N ZTSTOP,X,U,NAMSPC,COMPLETE
  1.  S U="^"
  1.  S NAMSPC=$$NAMSPC
  1.  I '$D(TESTING) N TESTING S TESTING=0
  1.  S X=$$SETUPX(90)
  1.  S X=$G(^XTMP(NAMSPC,0,0))
  1.  S $P(X,U,3)="RUNNING"
  1.  S $P(X,U,4)=$$NOW^XLFDT
  1.  S ^XTMP(NAMSPC,0,0)=X
  1.  ;
  1.  S ZTSTOP=$$CLEAN(TESTING)
  1.  S X=$G(^XTMP(NAMSPC,0,0))
  1.  S $P(X,U,3)=$S(ZTSTOP:"STOPPED",1:"COMPLETED")
  1.  S $P(X,U,5)=$$NOW^XLFDT
  1.  S ^XTMP(NAMSPC,0,0)=X
  1.  D MAIL($P(X,U,4),$P(X,U,5),$P(X,U),$P(X,U,6),'ZTSTOP)
  1.  K TESTING,^XTMP(NAMSPC,1)
  1.  L -^XTMP(NAMSPC)
  1.  Q
  1. SETUPX(EXPDAYS) ;
  1.  ; requires EXPDAYS - number of days to keep XTMP around
  1.  N BEGTIME,PURGDT,NAMSPC,U
  1.  S U="^"
  1.  S NAMSPC=$$NAMSPC
  1.  S BEGTIME=$$NOW^XLFDT()
  1.  S PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAYS)
  1.  S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
  1.  S $P(^XTMP(NAMSPC,0),U,3)="MEANS TEST DATE OF DEATH CLEANUP"
  1.  Q 1
  1. STOP()     ;returns stop flag
  1.  N ZTSTOP,U,X,NAMSPC
  1.  S U="^"
  1.  S NAMSPC=$$NAMSPC
  1.  S ZTSTOP=0
  1.  ; Check to see if the job is set to stop either manually
  1.  ; or through Taskman
  1.  I $$S^%ZTLOAD!$G(^XTMP(NAMSPC,1,"STOP")) D
  1.  . K ^XTMP(NAMSPC,1,"STOP")
  1.  . S ZTSTOP=1
  1.  Q ZTSTOP
  1. ACTIVE(ZTSK)    ;check if job is running, stopped, or complete
  1.  N NAMSPC,STAT,Y
  1.  S NAMSPC=$$NAMSPC
  1.  S ZTSK=+$G(^XTMP(NAMSPC,1,"TASK"))
  1.  D STAT^%ZTLOAD
  1.  S Y=ZTSK(1)
  1.  I Y=0 S STAT=-1
  1.  I ",1,2,4,"[(","_Y_",") S STAT=1
  1.  I ",3,5,"[(","_Y_",") S STAT=0
  1.  ; If the job is not active but the status is running, change status to
  1.  ; STOPPED
  1.  I $P($G(^XTMP(NAMSPC,0,0)),U,3)="RUNNING",STAT'>0 S $P(^XTMP(NAMSPC,0,0),U,3)="STOPPED"
  1.  Q STAT
  1.  ;
  1. NAMSPC() ;
  1.  Q $T(+0)
  1. CLEAN(TESTING) ; Loop through veterans to compare data
  1.  N CRF,DATA,DFN,DGMTI,NAMSPC,DELRECS,HIT,REC11,REC12,REC132,STARTTM,STATUS,TOTRECS,U,ZTSTOP
  1.  S NAMSPC=$$NAMSPC
  1.  S U="^"
  1.  S (DELRECS,ZTSTOP)=0
  1.  S STARTTM=$$NOW^XLFDT
  1.  S DATA=^XTMP(NAMSPC,0,0)
  1.  I 'TESTING S END="",DFN=0
  1.  I TESTING S DFN=START   ;If testing, get range
  1.  N STOP
  1.  S STOP=0
  1.  K ^XTMP(NAMSPC,"TEST","AUDIT")
  1.  ;
  1.  ; Loop through the means test cross reference
  1.  F TOTRECS=0:1 S DFN=$O(^DGMT(408.31,"AID",1,DFN)) D  Q:ZTSTOP!STOP
  1.  . I DFN=END!(DFN'?1.N.1(1"."1.N)) S STOP=1 Q
  1.  . ; Keep track of the last DFN processes
  1.  . S $P(^XTMP(NAMSPC,0,0),U,2)=DFN
  1.  . ; Check that there is a date of death and that the last means test
  1.  . ; has a status of REQUIRED
  1.  . S $P(^XTMP(NAMSPC,0,0),U,2)=DFN
  1.  . S HIT=0
  1.  . F  Q:'$$OK2DEL^DGMTDELS(DFN,.DGMTI)  D
  1.  . . S HIT=1
  1.  . . ; Save the audit info if testing
  1.  . . I TESTING S ^XTMP(NAMSPC,"TEST","AUDIT",DFN)=DGMTI
  1.  . . ; Delete the means test
  1.  . . D:'TESTING!(TESTING&$G(PROCESS)) DELMT^DGMTDELS(DGMTI)
  1.  . ; Check to see if the job has been signalled to stop
  1.  . I TOTRECS,TOTRECS#1000=0 S ZTSTOP=$$STOP
  1.  . S:HIT DELRECS=DELRECS+1  ;increment new record counter if means test deleted
  1.  ;
  1.  I TESTING S ^XTMP(NAMSPC,"TEST","TOT")="PROCESSED:"_TOTRECS_"  DELETED:"_DELRECS
  1.  ; Do some recordkeeping
  1.  S DATA=^XTMP(NAMSPC,0,0)
  1.  S $P(DATA,U,1)=DELRECS
  1.  S $P(DATA,U,4)=STARTTM
  1.  S $P(DATA,U,6)=TOTRECS
  1.  S ^XTMP(NAMSPC,0,0)=DATA
  1.  Q ZTSTOP
  1. MAIL(STARTTM,ENDTIME,DELRECS,TOTRECS,COMPLETE)  ; Send mail message
  1.  N XMDUZ,XMY,XMSUB,XMTEXT
  1.  S NAMSPC=$$NAMSPC
  1.  S U="^"
  1.  ; Set FROM duz
  1.  S XMDUZ=.5
  1.  ; Send completion message to developer
  1.  S XMY(DUZ)=""
  1.  S XMSUB="DG MEANS TEST DATE OF DEATH CLEANUP"
  1.  I COMPLETE D
  1.  . S ^TMP(NAMSPC,$J,"MSG",0)=6
  1.  . S ^TMP(NAMSPC,$J,"MSG",1)="   Means Test Date of Death Cleanup"
  1.  . S ^TMP(NAMSPC,$J,"MSG",2)=""
  1.  . S ^TMP(NAMSPC,$J,"MSG",3)="      Started at: "_$TR($$FMTE^XLFDT(STARTTM,2),"@"," ")
  1.  . S ^TMP(NAMSPC,$J,"MSG",4)="    Completed at: "_$TR($$FMTE^XLFDT(ENDTIME,2),"@"," ")
  1.  . S ^TMP(NAMSPC,$J,"MSG",5)="Records Examined: "_TOTRECS
  1.  . S ^TMP(NAMSPC,$J,"MSG",6)=" Records Deleted: "_DELRECS
  1.  . S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
  1.  I 'COMPLETE D
  1.  . S ^TMP(NAMSPC,$J,"MSG",0)=8
  1.  . S ^TMP(NAMSPC,$J,"MSG",1)="        Means Test Date of Death Cleanup"
  1.  . S ^TMP(NAMSPC,$J,"MSG",2)="          ***Processing not complete***"
  1.  . S ^TMP(NAMSPC,$J,"MSG",3)=""
  1.  . S ^TMP(NAMSPC,$J,"MSG",4)="           Started at: "_$TR($$FMTE^XLFDT(STARTTM,2),"@"," ")
  1.  . S ^TMP(NAMSPC,$J,"MSG",5)="           Stopped at: "_$TR($$FMTE^XLFDT(ENDTIME,2),"@"," ")
  1.  . S ^TMP(NAMSPC,$J,"MSG",6)="     Records Examined: "_TOTRECS
  1.  . S ^TMP(NAMSPC,$J,"MSG",7)="      Records Deleted: "_DELRECS
  1.  . S ^TMP(NAMSPC,$J,"MSG",8)="Last Record Processed: "_$P($G(^XTMP(NAMSPC,0,0)),U,2)
  1.  . S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
  1.  D ^XMD
  1.  K ^TMP(NAMSPC)
  1.  Q