DG53514 ;ALB/PHH - DG*5.3*514 DOD Cleanup ; 4/25/03
 ;;5.3;Registration;**514**;Aug 13, 1993
 Q
RESET ; Reset the data for the cleanup process
 K ^XTMP($$NAMESPC)
 Q
TEST ; Simulate Live Run
 N MODE
 S MODE=0
START ; Start Processor
 N NAMESPC,QTIME
 S NAMESPC=$$NAMESPC
 Q:$$RUNCHK(NAMESPC)   ; Quit if already running or has run to completion
 Q:$$QTIME(.QTIME)
 S:$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) MODE=^XTMP(NAMESPC,"CONFIG","RUN MODE")
 S:'$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) ^XTMP(NAMESPC,"CONFIG","RUN MODE")=$S($G(MODE)=0:0,1:1)
 S ^XTMP(NAMESPC,"CONFIG","USER")=$S($G(DUZ)'="":DUZ,1:"UNKNOWN")
 S:'$$QUEUE(QTIME) ^XTMP(NAMESPC,"CONFIG","RUNNING")=""
 Q
NAMESPC() ; API returns the name space for this patch
 Q "DG514"
RUNCHK(NAMESPC) ; Check to see if clean up is already running
 Q:NAMESPC="" 1                   ; Name Space must be defined
 Q:$D(^XTMP(NAMESPC,"CONFIG","RUNNING")) 1
 Q:$D(^XTMP(NAMESPC,"CONFIG","COMPLETE")) 1
 Q 0
QTIME(WHEN) ; Get the run time for queuing
 N %,%H,%I,X
 D NOW^%DTC
 S WHEN=$P(%,".")_"."_$E($P(%,".",2),1,4)
 Q 0
QUEUE(ZTDTH) ; Queue the process
 N NAMESPC,QUEERR,ZTDESC,ZTRTN,ZTSK
 S NAMESPC=$$NAMESPC
 S QUEERR=0
 S ZTRTN="CLEAN^DG53"_$P(NAMESPC,"DG",2)
 S ZTDESC=NAMESPC_" - DOD Cleanup Process"
 S ZTIO=""
 D ^%ZTLOAD
 K ^XTMP(NAMESPC,"CONFIG","ZTSK")
 I '$D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Unable to queue post-install process.",QUEERR=1
 I $D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Post-install queued. Task ID: "_$G(ZTSK)
 D HOME^%ZIS
 Q QUEERR
CLEAN ; Actual cleanup process
 N NAMESPC,MODE,USER,TASKID,%,%H,%I,X,X1,X2,CHKCNT,TMSWT,TOTDPT,DFN
 S NAMESPC=$$NAMESPC
 K ^XTMP(NAMESPC,"CONFIG","ABORT TIME")
 S MODE=$G(^XTMP(NAMESPC,"CONFIG","RUN MODE"),0)
 S USER=$G(^XTMP(NAMESPC,"CONFIG","USER"),"UNKNOWN")
 S TASKID=$G(^XTMP(NAMESPC,"CONFIG","ZTSK"),"UNKNOWN")
 ;
 I '$D(^XTMP(NAMESPC,0)) D
 .K ^XTMP(NAMESPC)
 .S ^XTMP(NAMESPC,"CONFIG","DFN")=0
 .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=0
 .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=0
 .S ^XTMP(NAMESPC,"CONFIG","RUN MODE")=MODE
 .S ^XTMP(NAMESPC,"CONFIG","USER")=USER
 .S ^XTMP(NAMESPC,"CONFIG","ZTSK")=TASKID
 .D NOW^%DTC
 .S ^XTMP(NAMESPC,"CONFIG","START TIME")=%
 .S X1=$$DT^XLFDT,X2=90
 .D C^%DTC
 .S ^XTMP(NAMESPC,0)=X_U_$$DT^XLFDT_U_NAMESPC_" - DOD CLEANUP"
 ;
 S CHKCNT=250,(ZTSTOP,TMSWT)=0,TOTDPT=+$P($G(^DPT(0)),"^",4)
 S DFN=$G(^XTMP(NAMESPC,"CONFIG","DFN"))
 F  S DFN=$O(^DPT(DFN)) Q:'DFN!(TMSWT)  D
 .D PROC(DFN)
 .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))+1
 .S ^XTMP(NAMESPC,"CONFIG","DFN")=DFN
 .I TOTDPT D
 ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))/TOTDPT
 ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$P((^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")*100),".")
 .I +$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))#CHKCNT=0 D
 ..S TMSWT=$$STOPIT()
 ..I TMSWT D
 ...S ZTSTOP=1
 ...N %,%H,%I,X
 ...D NOW^%DTC
 ...S ^XTMP(NAMESPC,"CONFIG","ABORT TIME")=%
 ...D ABORTMSG
 ;
 I 'DFN,'TMSWT D
 .N %,%H,%I,X
 .D NOW^%DTC
 .S ^XTMP(NAMESPC,"CONFIG","COMPLETE")=%
 .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=100
 .D DONEMSG
 ;
 K ^XTMP(NAMESPC,"CONFIG","RUNNING")
 Q
PROC(DFN) ; Process the DFN
 N NAMESPC,DOD,CURENR,ENRSTAT,QLOGIEN,SUCCESS
 S NAMESPC=$$NAMESPC
 S DOD=$P($G(^DPT(DFN,.35)),"^")
 Q:DOD=""
 S CURENR=$P($G(^DPT(DFN,"ENR")),"^")  ; Get Current Enr Record
 Q:CURENR=""
 S ENRSTAT=$P($G(^DGEN(27.11,CURENR,0)),"^",4)
 Q:ENRSTAT'=1     ; Quit if it's not an 'Unverified' status
 ;
 S ^XTMP(NAMESPC,"DATA",DFN)=""
 S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
 S ^XTMP(NAMESPC,"CONFIG","DFN")=DFN
 ;
 S SUCCESS=0
 I MODE S SUCCESS=$$SEND(DFN)   ; Resend the Z11 query
 S $P(^XTMP(NAMESPC,"DATA",DFN),"^")=SUCCESS
 ;
 I SUCCESS=0 S ^XTMP(NAMESPC,"CONFIG","FAILED")=$G(^XTMP(NAMESPC,"CONFIG","FAILED"))+1
 I SUCCESS=1 S ^XTMP(NAMESPC,"CONFIG","SUCCESS")=$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))+1
 Q
STOPIT() ; Checks if user requested task to stop
 N X,STOPIT
 S STOPIT=0
 S X=$$S^%ZTLOAD
 I X D  ;
 .S STOPIT=1
 .I $G(ZTSK) S ZTSTOP=1
 Q STOPIT
SEND(DFN) ; Send an ENROLLMENT/ELIGIBILITY QUERY to HEC for a veteran
 ;Output: returns 1 on success, 0 on failure.
 ;
 I '$$ON^DGENQRY Q 0
 N LAST,DGQRY,MSGID,SUCCESS,SENT,ERROR
 S SUCCESS=1,ERROR=""
 I '$$LOCK^DGENQRY($G(DFN)) S SUCCESS=0
 S LAST=$$FINDLAST^DGENQRY(DFN)   ; Find latest Enr. Query Log IEN
 I LAST,$$GET^DGENQRY(LAST,.DGQRY) ;
 D:SUCCESS
 .S SENT=$$MSG^DGENQRY1(DFN,.MSGID,.ERROR)
 .I 'SENT S SUCCESS=0 Q
 .S DGQRY("DFN")=DFN
 .S DGQRY("SENT")=SENT
 .S DGQRY("STATUS")=0
 .S DGQRY("MSGID")=MSGID
 .S DGQRY("NOTIFY")=$G(NOTIFY)
 .S DGQRY("FIRST")=$S($G(FIRST):FIRST,1:SENT)
 .S DGQRY("RESPONSE")=""
 .S DGQRY("RESPONSEID")=""
 .I '$$LOG^DGENQRY(.DGQRY) S SUCCESS=0 Q
 D UNLOCK^DGENQRY($G(DFN))
 Q SUCCESS
ABORTMSG ; Send the user aborted message:
 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
 S NAMESPC=$$NAMESPC
 S NAMESPCN=$P(NAMESPC,"DG",2)
 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
 S XMSUB="DG*5.3*"_NAMESPCN_": DOD CLEANUP - PROCESS STOPPED BY USER"
 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
 S TMP(NAMESPCN,2)="------------------"
 S TMP(NAMESPCN,3)=""
 S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely.  Here is the current status:"
 S TMP(NAMESPCN,5)=""
 S TMP(NAMESPCN,6)="  Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
 S TMP(NAMESPCN,7)="    End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
 S TMP(NAMESPCN,8)=""
 S TMP(NAMESPCN,9)="Current Counts: "
 S TMP(NAMESPCN,10)="       Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
 S TMP(NAMESPCN,11)="             Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
 S TMP(NAMESPCN,12)="                  Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
 S TMP(NAMESPCN,13)=""
 S TMP(NAMESPCN,14)=""
 D ^XMD
 Q
DONEMSG ; Send the user aborted message:
 N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
 S NAMESPC=$$NAMESPC
 S NAMESPCN=$P(NAMESPC,"DG",2)
 S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
 S XMSUB="DG*5.3*"_NAMESPCN_": DOD CLEANUP - SUMMARY REPORT"
 S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
 S TMP(NAMESPCN,2)="------------------"
 S TMP(NAMESPCN,3)=""
 S TMP(NAMESPCN,4)="The cleanup has run to completion.  Here are the results:"
 S TMP(NAMESPCN,5)=""
 S TMP(NAMESPCN,6)="  Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
 S TMP(NAMESPCN,7)="    End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
 S TMP(NAMESPCN,8)=""
 S TMP(NAMESPCN,9)="Current Counts: "
 S TMP(NAMESPCN,10)="       Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
 S TMP(NAMESPCN,11)="             Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","SUCCESS"))
 S TMP(NAMESPCN,12)="                  Percentage Completed: 100%"
 S TMP(NAMESPCN,13)=""
 S TMP(NAMESPCN,14)=""
 D ^XMD
 Q