MDCPURG ;HINES OIFO/DP - CP Nightly Purge Options;27 Jan 2008
;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine uses the following IAs:
; #10063 - %ZTLOAD calls Kernel (supported)
; # 2263 - XPAR calls Toolkit (supported)
;
;
;
EN ; Not called interactively
Q
;
CP ; CP Legacy Cleanup
N ZTREQ
S ZTREQ=$$ZTREQ("CP_CLEANUP")
S MDSTOP=+$$GET^XPAR("SYS","MD PARAMETERS","INSTRUMENT_DATA_RETENTION") Q:'MDSTOP
S MDSTOP=$$FMADD^XLFDT(DT\1,MDSTOP*-1)
S MDDT=""
F S MDDT=$O(^MDD(703.1,"ADTP",MDDT)) Q:MDDT="" D:+MDDT<MDSTOP
.F X1=0:0 S X1=$O(^MDD(703.1,"ADTP",MDDT,X1)) Q:'X1 D
..S MDFDA(703.1,X1_",",.4)="@"
..F X2=0:0 S X2=$O(^MDD(703.1,X1,.1,X2)) Q:'X2 D
...S MDFDA(703.11,X2_","_X1_",",.01)="@"
..D FILE^DIE("","MDFDA") K MDFDA
Q
;
CLIO ; CliO Background Cleanup
S ZTREQ=$$ZTREQ("CLIO_CLEANUP")
S MDSTOP=+$$GET^XPAR("SYS","MD PARAMETERS","UNVERIFIED_OBS_RETENTION") Q:'MDSTOP
S MDSTOP=$$FMADD^XLFDT(DT,MDSTOP*-1)
F MDDT=0:0 S MDDT=$O(^MDC(704.117,"AUV",0,MDDT)) Q:'MDDT!(MDDT>MDSTOP) D
.F MDDA=0:0 S MDDA=$O(^MDC(704.117,"AUV",0,MDDT,MDDA)) Q:'MDDA D
..D PURGEOBS(MDDA)
..; Checking for child observations as well
..S MDGBL=$NA(^MDC(704.117,"AP",MDDA))
..F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,3)'=MDDA D
...D PURGEOBS($QS(MDGBL,5))
..D FILE^DIE("K","MDFDA") ; Bang!
..K MDFDA
Q
;
PURGEOBS(MDDA) ; Gathers the pointers for a single observation
N MDGBL
S MDFDA(704.117,MDDA_",",.01)="@"
;
; Get the SET pointers
S MDGBL=$NA(^MDC(704.1161,"AS",MDDA))
F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,3)'=MDDA D
.S MDFDA(704.1161,$QS(MDGBL,5)_",",.01)="@"
;
; Get the QUALIFIER pointers
S MDGBL=$NA(^MDC(704.118,"PK",MDDA))
F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,3)'=MDDA D
.S MDFDA(704.118,$QS(MDGBL,5)_",",.01)="@"
Q
;
HL7 ; Purges HL7 data from 704.002
S ZTREQ=$$ZTREQ("HL7_CLEANUP")
S MDCSTOP=+$$GET^XPAR("SYS","MD PARAMETERS","GATEWAY_DATA_RETENTION") Q:'MDCSTOP
D NOW^%DTC S MDCSTOP=$$FMADD^XLFDT(%,-MDCSTOP,0,0,0)
N MDCDTTM,MDCIEN S (MDCDTTM,MDCIEN)=0
F S MDCDTTM=$O(^MDC(704.002,"PURGE","4",MDCDTTM)) Q:$G(MDCDTTM)="" Q:(MDCDTTM>MDCSTOP) D
.N MDCIEN S MDCIEN=0
.F S MDCIEN=$O(^MDC(704.002,"PURGE","4",MDCDTTM,MDCIEN)) Q:$G(MDCIEN)="" D
..N MDCFDA,MDCSIEN S MDCSIEN=0
..S MDCFDA(704.002,MDCIEN_",",.01)="@"
..F S MDCSIEN=$O(^MDC(704.004,"B",MDCIEN,MDCSIEN)) Q:$G(MDCSIEN)="" D
...S MDCFDA(704.004,MDCSIEN_",",.01)="@"
..D FILE^DIE("K","MDCFDA")
K MDCSTOP
Q
;
QUERIES ; Clear the cached queries nightly
S ZTREQ=$$ZTREQ("CACHE_QUERIES")
N MDOPT,MDQ,MDCMD,MDERR,MDNAME
; First, clear out all queries
D CLEARQ
; Now re-build them :)
D GETLST^XPAR(.MDOPT,"SYS","MD COMMANDS","Q")
F MDQ=0:0 S MDQ=$O(MDOPT(MDQ)) Q:'MDQ D
.S MDNAME=$P(MDOPT(MDQ),"^",1),MDNODE="MDCACHE_"_MDNAME
.D GETWP^XPAR(.MDCMD,"SYS","MD COMMANDS",MDNAME,.MDERR)
.I $P(MDCMD(1,0),";",7)'=1 Q
.L +(^XTMP(MDNODE)):60 E Q
.K ^XTMP(MDNODE)
.D RPC^MDCLIO(.MDRET,"EXECUTE",MDNAME)
.S ^XTMP(MDNODE,0)=$$FMADD^XLFDT(DT,1)_U_DT
.M ^XTMP(MDNODE,1)=@MDRET
.L -(^XTMP(MDNODE))
Q
;
CLEARQ ; Clear Queries Cache - Ignores script settings
N MDQ
S MDQ="MDCACHE_"
F S MDQ=$O(^XTMP(MDQ)) Q:MDQ'?1"MDCACHE_".E D
.L +(^XTMP(MDQ)):60 E Q ; Will try again next time ...
.K ^XTMP(MDQ)
.L -(^XTMP(MDQ))
Q
;
GETPAR(TASKID) ; Get Task in Parameter File
Q $$GET^XPAR("SYS","MD PARAMETERS","TASK_"_TASKID)
;
SETPAR(TASKID,ZTSK,NAME,RTN,RECUR) ;
D EN^XPAR("SYS","MD PARAMETERS","TASK_"_TASKID,+$G(ZTSK)_";"_$G(NAME,"Task Has No Name")_";"_$TR($G(RTN),"^"," ")_";"_(+$G(RECUR)))
Q
;
ZTSK(TASKID) ; Taskman ID - According to MD PARAMETERS, creates one if missing
N ZTSK
Q:$$GETPAR(TASKID)="" -1 ; Error state, TASKID not in XPAR
S ZTSK=+$P($$GETPAR(TASKID),";")
D STAT^%ZTLOAD I ZTSK(0)=1 Q ZTSK
Q 0
;
DESC(TASKID) ; Task Description
Q $P($$GETPAR(TASKID),";",2)
;
RTN(TASKID) ; Task Routine
Q $TR($P($$GETPAR(TASKID),";",3)," ",U)
;
ZTREQ(TASKID) ; Taskman re-queue identifier
Q $P("@^1H^1D^7D^30D^365D",U,$$RECUR(TASKID)+1)
;
RECUR(TASKID) ; Task Recurrence
Q +$P($$GETPAR(TASKID),";",4)
;
START ; Queue the task to be ran @ P2(0)
; P2(0)=TASK ID as stored in XPAR (i.e. the name of the background task)
N ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO
S ZTSK=$$ZTSK(P2(0))
D:'ZTSK ; Create unscheduled task
.S ZTRTN=$$RTN(P2(0))
.S ZTDESC=$$DESC(P2(0))
.S ZTDTH="@"
.S ZTIO=""
.D ^%ZTLOAD
D ISQED^%ZTLOAD D:ZTSK(0)=1 DQ^%ZTLOAD ; Just to be safe DQ the task first
S ZTDESC=$$DESC(P2(0)),ZTRTN=$$RTN(P2(0)),ZTIO=""
S ZTDTH=$$FMDT^MDCLIO(P2(1))
D REQ^%ZTLOAD
D SETPAR(P2(0),ZTSK,$$DESC(P2(0)),$$RTN(P2(0)),+$G(P2(2)))
S @RESULTS@(0)="1^RESCHEDULED"
Q
;
STOP ; Stop the task (i.e. dequeue)
N ZTSK
S ZTSK=$$ZTSK(P2(0))
D ISQED^%ZTLOAD D:ZTSK(0)=1 DQ^%ZTLOAD
D STAT
Q
;
STAT ; GET THE STATUS OF THE PURGE JOB
D NEWDOC^MDCLIO("RESULTS")
D XMLHDR^MDCLIO("RECORD")
D XMLDATA^MDCLIO("TASK_ID",P2(0))
S ZTSK=$$ZTSK(P2(0))
I ZTSK<0 D Q
.D XMLDATA^MDCLIO("TASK",-1)
.D XMLDATA^MDCLIO("STATUS","-1")
.D XMLDATA^MDCLIO("MESSAGE","No task ID parameter settings.")
.D XMLFTR^MDCLIO("RECORD")
.D ENDDOC^MDCLIO("RESULTS")
;
D XMLDATA^MDCLIO("TASK",ZTSK)
D XMLDATA^MDCLIO("TASK_NAME",$$DESC(P2(0)))
D XMLDATA^MDCLIO("TASK_ROUTINE",$$RTN(P2(0)))
D XMLDATA^MDCLIO("RECURRENCE",$$RECUR(P2(0)))
;
D STAT^%ZTLOAD
I '$G(ZTSK(0)) D Q
.D XMLDATA^MDCLIO("STATUS",0)
.D XMLDATA^MDCLIO("MESSAGE","Task ID not found in Taskman.")
.D XMLFTR^MDCLIO("RECORD")
.D ENDDOC^MDCLIO("RESULTS")
;
D XMLDATA^MDCLIO("STATUS",ZTSK(1))
D XMLDATA^MDCLIO("MESSAGE",ZTSK(2))
I ZTSK(1)=1 D
.D ISQED^%ZTLOAD
.I $G(ZTSK("D"))]"" D XMLDT^MDCLIO("SCHEDULED",$$HTFM^XLFDT(ZTSK("D")))
D XMLFTR^MDCLIO("RECORD")
D ENDDOC^MDCLIO("RESULTS")
Q
;
GETTASKS ; Get list of the known tasks
N MDLIST,MDERR,MDTASK
D BLD
D GETLST^XPAR(.MDLIST,"SYS","MD PARAMETERS","Q",.MDERR)
D NEWDOC^MDCLIO("RESULTS")
F MDTASK=0:0 S MDTASK=$O(MDLIST(MDTASK)) Q:'MDTASK D
.Q:MDLIST(MDTASK)'?1"TASK_".E
.D XMLHDR^MDCLIO("RECORD")
.D XMLDATA^MDCLIO("TASK_ID",$P($P(MDLIST(MDTASK),"^",1),"TASK_",2))
.D XMLDATA^MDCLIO("TASK_NAME",$P(MDLIST(MDTASK),";",2))
.D XMLDATA^MDCLIO("TASK",+$P(MDLIST(MDTASK),"^",2))
.D XMLFTR^MDCLIO("RECORD")
D ENDDOC^MDCLIO("RESULTS")
Q
;
BLD ; Build the known tasks
I $$GETPAR("CLIO_CLEANUP")="" D SETPAR("CLIO_CLEANUP",0,"CliO Cleanup","CLIO^MDCPURG")
I $$GETPAR("CP_CLEANUP")="" D SETPAR("CP_CLEANUP",0,"CP Legacy Cleanup","CP^MDCPURG")
I $$GETPAR("HL7_CLEANUP")="" D SETPAR("HL7_CLEANUP",0,"HL7 Log Cleanup","HL7^MDCPURG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCPURG 6899 printed Sep 23, 2025@19:18:32 Page 2
MDCPURG ;HINES OIFO/DP - CP Nightly Purge Options;27 Jan 2008
+1 ;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine uses the following IAs:
+5 ; #10063 - %ZTLOAD calls Kernel (supported)
+6 ; # 2263 - XPAR calls Toolkit (supported)
+7 ;
+8 ;
+9 ;
EN ; Not called interactively
+1 QUIT
+2 ;
CP ; CP Legacy Cleanup
+1 NEW ZTREQ
+2 SET ZTREQ=$$ZTREQ("CP_CLEANUP")
+3 SET MDSTOP=+$$GET^XPAR("SYS","MD PARAMETERS","INSTRUMENT_DATA_RETENTION")
if 'MDSTOP
QUIT
+4 SET MDSTOP=$$FMADD^XLFDT(DT\1,MDSTOP*-1)
+5 SET MDDT=""
+6 FOR
SET MDDT=$ORDER(^MDD(703.1,"ADTP",MDDT))
if MDDT=""
QUIT
if +MDDT<MDSTOP
Begin DoDot:1
+7 FOR X1=0:0
SET X1=$ORDER(^MDD(703.1,"ADTP",MDDT,X1))
if 'X1
QUIT
Begin DoDot:2
+8 SET MDFDA(703.1,X1_",",.4)="@"
+9 FOR X2=0:0
SET X2=$ORDER(^MDD(703.1,X1,.1,X2))
if 'X2
QUIT
Begin DoDot:3
+10 SET MDFDA(703.11,X2_","_X1_",",.01)="@"
End DoDot:3
+11 DO FILE^DIE("","MDFDA")
KILL MDFDA
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
CLIO ; CliO Background Cleanup
+1 SET ZTREQ=$$ZTREQ("CLIO_CLEANUP")
+2 SET MDSTOP=+$$GET^XPAR("SYS","MD PARAMETERS","UNVERIFIED_OBS_RETENTION")
if 'MDSTOP
QUIT
+3 SET MDSTOP=$$FMADD^XLFDT(DT,MDSTOP*-1)
+4 FOR MDDT=0:0
SET MDDT=$ORDER(^MDC(704.117,"AUV",0,MDDT))
if 'MDDT!(MDDT>MDSTOP)
QUIT
Begin DoDot:1
+5 FOR MDDA=0:0
SET MDDA=$ORDER(^MDC(704.117,"AUV",0,MDDT,MDDA))
if 'MDDA
QUIT
Begin DoDot:2
+6 DO PURGEOBS(MDDA)
+7 ; Checking for child observations as well
+8 SET MDGBL=$NAME(^MDC(704.117,"AP",MDDA))
+9 FOR
SET MDGBL=$QUERY(@MDGBL)
if MDGBL=""
QUIT
if $QSUBSCRIPT(MDGBL,3)'=MDDA
QUIT
Begin DoDot:3
+10 DO PURGEOBS($QSUBSCRIPT(MDGBL,5))
End DoDot:3
+11 ; Bang!
DO FILE^DIE("K","MDFDA")
+12 KILL MDFDA
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
PURGEOBS(MDDA) ; Gathers the pointers for a single observation
+1 NEW MDGBL
+2 SET MDFDA(704.117,MDDA_",",.01)="@"
+3 ;
+4 ; Get the SET pointers
+5 SET MDGBL=$NAME(^MDC(704.1161,"AS",MDDA))
+6 FOR
SET MDGBL=$QUERY(@MDGBL)
if MDGBL=""
QUIT
if $QSUBSCRIPT(MDGBL,3)'=MDDA
QUIT
Begin DoDot:1
+7 SET MDFDA(704.1161,$QSUBSCRIPT(MDGBL,5)_",",.01)="@"
End DoDot:1
+8 ;
+9 ; Get the QUALIFIER pointers
+10 SET MDGBL=$NAME(^MDC(704.118,"PK",MDDA))
+11 FOR
SET MDGBL=$QUERY(@MDGBL)
if MDGBL=""
QUIT
if $QSUBSCRIPT(MDGBL,3)'=MDDA
QUIT
Begin DoDot:1
+12 SET MDFDA(704.118,$QSUBSCRIPT(MDGBL,5)_",",.01)="@"
End DoDot:1
+13 QUIT
+14 ;
HL7 ; Purges HL7 data from 704.002
+1 SET ZTREQ=$$ZTREQ("HL7_CLEANUP")
+2 SET MDCSTOP=+$$GET^XPAR("SYS","MD PARAMETERS","GATEWAY_DATA_RETENTION")
if 'MDCSTOP
QUIT
+3 DO NOW^%DTC
SET MDCSTOP=$$FMADD^XLFDT(%,-MDCSTOP,0,0,0)
+4 NEW MDCDTTM,MDCIEN
SET (MDCDTTM,MDCIEN)=0
+5 FOR
SET MDCDTTM=$ORDER(^MDC(704.002,"PURGE","4",MDCDTTM))
if $GET(MDCDTTM)=""
QUIT
if (MDCDTTM>MDCSTOP)
QUIT
Begin DoDot:1
+6 NEW MDCIEN
SET MDCIEN=0
+7 FOR
SET MDCIEN=$ORDER(^MDC(704.002,"PURGE","4",MDCDTTM,MDCIEN))
if $GET(MDCIEN)=""
QUIT
Begin DoDot:2
+8 NEW MDCFDA,MDCSIEN
SET MDCSIEN=0
+9 SET MDCFDA(704.002,MDCIEN_",",.01)="@"
+10 FOR
SET MDCSIEN=$ORDER(^MDC(704.004,"B",MDCIEN,MDCSIEN))
if $GET(MDCSIEN)=""
QUIT
Begin DoDot:3
+11 SET MDCFDA(704.004,MDCSIEN_",",.01)="@"
End DoDot:3
+12 DO FILE^DIE("K","MDCFDA")
End DoDot:2
End DoDot:1
+13 KILL MDCSTOP
+14 QUIT
+15 ;
QUERIES ; Clear the cached queries nightly
+1 SET ZTREQ=$$ZTREQ("CACHE_QUERIES")
+2 NEW MDOPT,MDQ,MDCMD,MDERR,MDNAME
+3 ; First, clear out all queries
+4 DO CLEARQ
+5 ; Now re-build them :)
+6 DO GETLST^XPAR(.MDOPT,"SYS","MD COMMANDS","Q")
+7 FOR MDQ=0:0
SET MDQ=$ORDER(MDOPT(MDQ))
if 'MDQ
QUIT
Begin DoDot:1
+8 SET MDNAME=$PIECE(MDOPT(MDQ),"^",1)
SET MDNODE="MDCACHE_"_MDNAME
+9 DO GETWP^XPAR(.MDCMD,"SYS","MD COMMANDS",MDNAME,.MDERR)
+10 IF $PIECE(MDCMD(1,0),";",7)'=1
QUIT
+11 LOCK +(^XTMP(MDNODE)):60
IF '$TEST
QUIT
+12 KILL ^XTMP(MDNODE)
+13 DO RPC^MDCLIO(.MDRET,"EXECUTE",MDNAME)
+14 SET ^XTMP(MDNODE,0)=$$FMADD^XLFDT(DT,1)_U_DT
+15 MERGE ^XTMP(MDNODE,1)=@MDRET
+16 LOCK -(^XTMP(MDNODE))
End DoDot:1
+17 QUIT
+18 ;
CLEARQ ; Clear Queries Cache - Ignores script settings
+1 NEW MDQ
+2 SET MDQ="MDCACHE_"
+3 FOR
SET MDQ=$ORDER(^XTMP(MDQ))
if MDQ'?1"MDCACHE_".E
QUIT
Begin DoDot:1
+4 ; Will try again next time ...
LOCK +(^XTMP(MDQ)):60
IF '$TEST
QUIT
+5 KILL ^XTMP(MDQ)
+6 LOCK -(^XTMP(MDQ))
End DoDot:1
+7 QUIT
+8 ;
GETPAR(TASKID) ; Get Task in Parameter File
+1 QUIT $$GET^XPAR("SYS","MD PARAMETERS","TASK_"_TASKID)
+2 ;
SETPAR(TASKID,ZTSK,NAME,RTN,RECUR) ;
+1 DO EN^XPAR("SYS","MD PARAMETERS","TASK_"_TASKID,+$GET(ZTSK)_";"_$GET(NAME,"Task Has No Name")_";"_$TRANSLATE($GET(RTN),"^"," ")_";"_(+$GET(RECUR)))
+2 QUIT
+3 ;
ZTSK(TASKID) ; Taskman ID - According to MD PARAMETERS, creates one if missing
+1 NEW ZTSK
+2 ; Error state, TASKID not in XPAR
if $$GETPAR(TASKID)=""
QUIT -1
+3 SET ZTSK=+$PIECE($$GETPAR(TASKID),";")
+4 DO STAT^%ZTLOAD
IF ZTSK(0)=1
QUIT ZTSK
+5 QUIT 0
+6 ;
DESC(TASKID) ; Task Description
+1 QUIT $PIECE($$GETPAR(TASKID),";",2)
+2 ;
RTN(TASKID) ; Task Routine
+1 QUIT $TRANSLATE($PIECE($$GETPAR(TASKID),";",3)," ",U)
+2 ;
ZTREQ(TASKID) ; Taskman re-queue identifier
+1 QUIT $PIECE("@^1H^1D^7D^30D^365D",U,$$RECUR(TASKID)+1)
+2 ;
RECUR(TASKID) ; Task Recurrence
+1 QUIT +$PIECE($$GETPAR(TASKID),";",4)
+2 ;
START ; Queue the task to be ran @ P2(0)
+1 ; P2(0)=TASK ID as stored in XPAR (i.e. the name of the background task)
+2 NEW ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO
+3 SET ZTSK=$$ZTSK(P2(0))
+4 ; Create unscheduled task
if 'ZTSK
Begin DoDot:1
+5 SET ZTRTN=$$RTN(P2(0))
+6 SET ZTDESC=$$DESC(P2(0))
+7 SET ZTDTH="@"
+8 SET ZTIO=""
+9 DO ^%ZTLOAD
End DoDot:1
+10 ; Just to be safe DQ the task first
DO ISQED^%ZTLOAD
if ZTSK(0)=1
DO DQ^%ZTLOAD
+11 SET ZTDESC=$$DESC(P2(0))
SET ZTRTN=$$RTN(P2(0))
SET ZTIO=""
+12 SET ZTDTH=$$FMDT^MDCLIO(P2(1))
+13 DO REQ^%ZTLOAD
+14 DO SETPAR(P2(0),ZTSK,$$DESC(P2(0)),$$RTN(P2(0)),+$GET(P2(2)))
+15 SET @RESULTS@(0)="1^RESCHEDULED"
+16 QUIT
+17 ;
STOP ; Stop the task (i.e. dequeue)
+1 NEW ZTSK
+2 SET ZTSK=$$ZTSK(P2(0))
+3 DO ISQED^%ZTLOAD
if ZTSK(0)=1
DO DQ^%ZTLOAD
+4 DO STAT
+5 QUIT
+6 ;
STAT ; GET THE STATUS OF THE PURGE JOB
+1 DO NEWDOC^MDCLIO("RESULTS")
+2 DO XMLHDR^MDCLIO("RECORD")
+3 DO XMLDATA^MDCLIO("TASK_ID",P2(0))
+4 SET ZTSK=$$ZTSK(P2(0))
+5 IF ZTSK<0
Begin DoDot:1
+6 DO XMLDATA^MDCLIO("TASK",-1)
+7 DO XMLDATA^MDCLIO("STATUS","-1")
+8 DO XMLDATA^MDCLIO("MESSAGE","No task ID parameter settings.")
+9 DO XMLFTR^MDCLIO("RECORD")
+10 DO ENDDOC^MDCLIO("RESULTS")
End DoDot:1
QUIT
+11 ;
+12 DO XMLDATA^MDCLIO("TASK",ZTSK)
+13 DO XMLDATA^MDCLIO("TASK_NAME",$$DESC(P2(0)))
+14 DO XMLDATA^MDCLIO("TASK_ROUTINE",$$RTN(P2(0)))
+15 DO XMLDATA^MDCLIO("RECURRENCE",$$RECUR(P2(0)))
+16 ;
+17 DO STAT^%ZTLOAD
+18 IF '$GET(ZTSK(0))
Begin DoDot:1
+19 DO XMLDATA^MDCLIO("STATUS",0)
+20 DO XMLDATA^MDCLIO("MESSAGE","Task ID not found in Taskman.")
+21 DO XMLFTR^MDCLIO("RECORD")
+22 DO ENDDOC^MDCLIO("RESULTS")
End DoDot:1
QUIT
+23 ;
+24 DO XMLDATA^MDCLIO("STATUS",ZTSK(1))
+25 DO XMLDATA^MDCLIO("MESSAGE",ZTSK(2))
+26 IF ZTSK(1)=1
Begin DoDot:1
+27 DO ISQED^%ZTLOAD
+28 IF $GET(ZTSK("D"))]""
DO XMLDT^MDCLIO("SCHEDULED",$$HTFM^XLFDT(ZTSK("D")))
End DoDot:1
+29 DO XMLFTR^MDCLIO("RECORD")
+30 DO ENDDOC^MDCLIO("RESULTS")
+31 QUIT
+32 ;
GETTASKS ; Get list of the known tasks
+1 NEW MDLIST,MDERR,MDTASK
+2 DO BLD
+3 DO GETLST^XPAR(.MDLIST,"SYS","MD PARAMETERS","Q",.MDERR)
+4 DO NEWDOC^MDCLIO("RESULTS")
+5 FOR MDTASK=0:0
SET MDTASK=$ORDER(MDLIST(MDTASK))
if 'MDTASK
QUIT
Begin DoDot:1
+6 if MDLIST(MDTASK)'?1"TASK_".E
QUIT
+7 DO XMLHDR^MDCLIO("RECORD")
+8 DO XMLDATA^MDCLIO("TASK_ID",$PIECE($PIECE(MDLIST(MDTASK),"^",1),"TASK_",2))
+9 DO XMLDATA^MDCLIO("TASK_NAME",$PIECE(MDLIST(MDTASK),";",2))
+10 DO XMLDATA^MDCLIO("TASK",+$PIECE(MDLIST(MDTASK),"^",2))
+11 DO XMLFTR^MDCLIO("RECORD")
End DoDot:1
+12 DO ENDDOC^MDCLIO("RESULTS")
+13 QUIT
+14 ;
BLD ; Build the known tasks
+1 IF $$GETPAR("CLIO_CLEANUP")=""
DO SETPAR("CLIO_CLEANUP",0,"CliO Cleanup","CLIO^MDCPURG")
+2 IF $$GETPAR("CP_CLEANUP")=""
DO SETPAR("CP_CLEANUP",0,"CP Legacy Cleanup","CP^MDCPURG")
+3 IF $$GETPAR("HL7_CLEANUP")=""
DO SETPAR("HL7_CLEANUP",0,"HL7 Log Cleanup","HL7^MDCPURG")
+4 QUIT
