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

DG53695.m

Go to the documentation of this file.
  1. DG53695 ;ALB/PHH - DG*5.3*695 Patient Cleanup ; 2/24/2006
  1. ;;5.3;Registration;**695**;Aug 13, 1993
  1. Q
  1. RESET ; Reset the data for the cleanup process
  1. K ^XTMP($$NAMESPC)
  1. Q
  1. TEST ; Simulate Live Run
  1. N MODE
  1. S MODE=0
  1. START ; Start Processor
  1. N NAMESPC,QTIME
  1. S NAMESPC=$$NAMESPC
  1. Q:$$RUNCHK(NAMESPC) ; Quit if already running or has run to completion
  1. Q:$$QTIME(.QTIME)
  1. S:$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) MODE=^XTMP(NAMESPC,"CONFIG","RUN MODE")
  1. S:'$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) ^XTMP(NAMESPC,"CONFIG","RUN MODE")=$S($G(MODE)=0:0,1:1)
  1. S ^XTMP(NAMESPC,"CONFIG","USER")=$S($G(DUZ)'="":DUZ,1:"UNKNOWN")
  1. S:'$$QUEUE(QTIME) ^XTMP(NAMESPC,"CONFIG","RUNNING")=""
  1. Q
  1. NAMESPC() ; API returns the name space for this patch
  1. Q "DG695"
  1. RUNCHK(NAMESPC) ; Check to see if clean up is already running
  1. Q:NAMESPC="" 1 ; Name Space must be defined
  1. Q:$D(^XTMP(NAMESPC,"CONFIG","RUNNING")) 1
  1. Q:$D(^XTMP(NAMESPC,"CONFIG","COMPLETE")) 1
  1. Q 0
  1. QTIME(WHEN) ; Get the run time for queuing
  1. N %,%H,%I,X
  1. D NOW^%DTC
  1. S WHEN=$P(%,".")_"."_$E($P(%,".",2),1,4)
  1. Q 0
  1. QUEUE(ZTDTH) ; Queue the process
  1. N NAMESPC,QUEERR,ZTDESC,ZTRTN,ZTSK,ZTIO
  1. S NAMESPC=$$NAMESPC
  1. S QUEERR=0
  1. S ZTRTN="CLEAN^DG53"_$P(NAMESPC,"DG",2)
  1. S ZTDESC=NAMESPC_" - Patient Cleanup Process"
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. K ^XTMP(NAMESPC,"CONFIG","ZTSK")
  1. I '$D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Unable to queue post-install process.",QUEERR=1
  1. I $D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Post-install queued. Task ID: "_$G(ZTSK)
  1. D HOME^%ZIS
  1. Q QUEERR
  1. CLEAN ; Actual cleanup process
  1. N NAMESPC,MODE,USER,TASKID,%,%H,%I,X,X1,X2,CHKCNT,ZTSTOP,TMSWT,TOTDPT,DFN
  1. S NAMESPC=$$NAMESPC
  1. K ^XTMP(NAMESPC,"CONFIG","ABORT TIME")
  1. S MODE=$G(^XTMP(NAMESPC,"CONFIG","RUN MODE"),0)
  1. S USER=$G(^XTMP(NAMESPC,"CONFIG","USER"),"UNKNOWN")
  1. S TASKID=$G(^XTMP(NAMESPC,"CONFIG","ZTSK"),"UNKNOWN")
  1. ;
  1. I '$D(^XTMP(NAMESPC,0)) D
  1. .K ^XTMP(NAMESPC)
  1. .S ^XTMP(NAMESPC,"CONFIG","DFN")=0
  1. .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=0
  1. .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=0
  1. .S ^XTMP(NAMESPC,"CONFIG","RUN MODE")=MODE
  1. .S ^XTMP(NAMESPC,"CONFIG","USER")=USER
  1. .S ^XTMP(NAMESPC,"CONFIG","ZTSK")=TASKID
  1. .D NOW^%DTC
  1. .S ^XTMP(NAMESPC,"CONFIG","START TIME")=%
  1. .S X1=$$DT^XLFDT,X2=90
  1. .D C^%DTC
  1. .S ^XTMP(NAMESPC,0)=X_U_$$DT^XLFDT_U_NAMESPC_" - PATIENT CLEANUP"
  1. ;
  1. S CHKCNT=250,(ZTSTOP,TMSWT)=0,TOTDPT=+$P($G(^DPT(0)),"^",4)
  1. S DFN=$G(^XTMP(NAMESPC,"CONFIG","DFN"))
  1. F S DFN=$O(^DPT(DFN)) Q:'DFN!(TMSWT) D
  1. .D PROC(DFN,MODE)
  1. .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))+1
  1. .S ^XTMP(NAMESPC,"CONFIG","DFN")=DFN
  1. .I TOTDPT D
  1. ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))/TOTDPT
  1. ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$P((^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")*100),".")
  1. .I +$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))#CHKCNT=0 D
  1. ..S TMSWT=$$STOPIT()
  1. ..I TMSWT D
  1. ...S ZTSTOP=1
  1. ...N %,%H,%I,X
  1. ...D NOW^%DTC
  1. ...S ^XTMP(NAMESPC,"CONFIG","ABORT TIME")=%
  1. ...D ABORTMSG
  1. ;
  1. I 'DFN,'TMSWT D
  1. .N %,%H,%I,X
  1. .D NOW^%DTC
  1. .S ^XTMP(NAMESPC,"CONFIG","COMPLETE")=%
  1. .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=100
  1. .D DONEMSG
  1. ;
  1. K ^XTMP(NAMESPC,"CONFIG","RUNNING")
  1. Q
  1. PROC(DFN,MODE) ; Process the DFN
  1. ; Check for orphan .3 and .11 nodes without the 0 node
  1. N NAMESPC,FLAG,NODE,DA,DIK
  1. Q:$D(^DPT(DFN,0))
  1. S NAMESPC=$$NAMESPC,FLAG=1,NODE=0
  1. F S NODE=$O(^DPT(DFN,NODE)) Q:'NODE!('FLAG) D
  1. .I NODE'=.3,NODE'=.11 S FLAG=0
  1. ;
  1. ; If it's an orphan .3 and .11, clean it up
  1. I FLAG D
  1. .Q:'$D(^DPT(DFN,.11))
  1. .Q:'$D(^DPT(DFN,.3))
  1. .S DA=DFN,DIK="^DPT("
  1. .S ^XTMP(NAMESPC,"DATA",DFN)=""
  1. .S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
  1. .;
  1. .; Save off old anomalies (just in case...)
  1. .M ^XTMP(NAMESPC,"DATA",DFN,"PREVIOUS")=^DPT(DFN)
  1. .;
  1. .; Only delete if this is running in live mode
  1. .I MODE D
  1. ..D ^DIK
  1. .S ^XTMP(NAMESPC,"CONFIG","SUCCESS")=$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))+1
  1. Q
  1. STOPIT() ; Checks if user requested task to stop
  1. N X,STOPIT
  1. S STOPIT=0
  1. S X=$$S^%ZTLOAD
  1. I X D ;
  1. .S STOPIT=1
  1. .I $G(ZTSK) S ZTSTOP=1
  1. Q STOPIT
  1. ABORTMSG ; Send the user aborted message:
  1. N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
  1. S NAMESPC=$$NAMESPC
  1. S NAMESPCN=$P(NAMESPC,"DG",2)
  1. S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
  1. S XMSUB="DG*5.3*"_NAMESPCN_": PATIENT CLEANUP - PROCESS STOPPED BY USER"
  1. S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
  1. S TMP(NAMESPCN,2)="------------------"
  1. S TMP(NAMESPCN,3)=""
  1. S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely. Here is the current status:"
  1. S TMP(NAMESPCN,5)=""
  1. S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
  1. S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
  1. S TMP(NAMESPCN,8)=""
  1. S TMP(NAMESPCN,9)="Current Counts: "
  1. S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
  1. S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
  1. S TMP(NAMESPCN,12)=" Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
  1. S TMP(NAMESPCN,13)=""
  1. S TMP(NAMESPCN,14)=""
  1. D ^XMD
  1. Q
  1. DONEMSG ; Send the user aborted message:
  1. N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
  1. S NAMESPC=$$NAMESPC
  1. S NAMESPCN=$P(NAMESPC,"DG",2)
  1. S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
  1. S XMSUB="DG*5.3*"_NAMESPCN_": PATIENT CLEANUP - SUMMARY REPORT"
  1. S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
  1. S TMP(NAMESPCN,2)="------------------"
  1. S TMP(NAMESPCN,3)=""
  1. S TMP(NAMESPCN,4)="The cleanup has run to completion. Here are the results:"
  1. S TMP(NAMESPCN,5)=""
  1. S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
  1. S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
  1. S TMP(NAMESPCN,8)=""
  1. S TMP(NAMESPCN,9)="Current Counts: "
  1. S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
  1. S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
  1. S TMP(NAMESPCN,12)=" Percentage Completed: 100%"
  1. S TMP(NAMESPCN,13)=""
  1. S TMP(NAMESPCN,14)=""
  1. D ^XMD
  1. Q