[613] | 1 | EAS126 ;ALB/PHH - EAS*1*26 POST-INSTALL ;05-27-2003
|
---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**26**;MAR 15,2001
|
---|
| 3 | Q
|
---|
| 4 | EN ; Entry point for post-install
|
---|
| 5 | D FIXOPT,START
|
---|
| 6 | Q
|
---|
| 7 | RESET ; Reset the data for the cleanup process
|
---|
| 8 | K ^XTMP($$NAMESPC)
|
---|
| 9 | Q
|
---|
| 10 | TEST ; Simulate Live Run
|
---|
| 11 | N MODE
|
---|
| 12 | S MODE=0
|
---|
| 13 | START ; Start Processor
|
---|
| 14 | N NAMESPC,QTIME
|
---|
| 15 | S NAMESPC=$$NAMESPC
|
---|
| 16 | Q:$$RUNCHK(NAMESPC) ; Quit if already running or has run to completion
|
---|
| 17 | Q:$$QTIME(.QTIME)
|
---|
| 18 | S:$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) MODE=^XTMP(NAMESPC,"CONFIG","RUN MODE")
|
---|
| 19 | S:'$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) ^XTMP(NAMESPC,"CONFIG","RUN MODE")=$S($G(MODE)=0:0,1:1)
|
---|
| 20 | S ^XTMP(NAMESPC,"CONFIG","USER")=$S($G(DUZ)'="":DUZ,1:"UNKNOWN")
|
---|
| 21 | S:'$$QUEUE(QTIME) ^XTMP(NAMESPC,"CONFIG","RUNNING")=""
|
---|
| 22 | Q
|
---|
| 23 | NAMESPC() ; API returns the name space for this patch
|
---|
| 24 | Q "EAS26"
|
---|
| 25 | RUNCHK(NAMESPC) ; Check to see if clean up is already running
|
---|
| 26 | Q:NAMESPC="" 1 ; Name Space must be defined
|
---|
| 27 | Q:$D(^XTMP(NAMESPC,"CONFIG","RUNNING")) 1
|
---|
| 28 | Q:$D(^XTMP(NAMESPC,"CONFIG","COMPLETE")) 1
|
---|
| 29 | Q 0
|
---|
| 30 | QTIME(WHEN) ; Get the run time for queuing
|
---|
| 31 | N %,%H,%I,X
|
---|
| 32 | D NOW^%DTC
|
---|
| 33 | S WHEN=$P(%,".")_"."_$E($P(%,".",2),1,4)
|
---|
| 34 | Q 0
|
---|
| 35 | QUEUE(ZTDTH) ; Queue the process
|
---|
| 36 | N NAMESPC,QUEERR,ZTDESC,ZTRTN,ZTSK
|
---|
| 37 | S NAMESPC=$$NAMESPC
|
---|
| 38 | S QUEERR=0
|
---|
| 39 | S ZTRTN="CLEAN^EAS1"_$P(NAMESPC,"EAS",2)
|
---|
| 40 | S ZTDESC=NAMESPC_" - Patient Merge Cleanup Process"
|
---|
| 41 | S ZTIO=""
|
---|
| 42 | D ^%ZTLOAD
|
---|
| 43 | K ^XTMP(NAMESPC,"CONFIG","ZTSK")
|
---|
| 44 | I '$D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Unable to queue post-install process.",QUEERR=1
|
---|
| 45 | I $D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Post-install queued. Task ID: "_$G(ZTSK)
|
---|
| 46 | D HOME^%ZIS
|
---|
| 47 | Q QUEERR
|
---|
| 48 | CLEAN ; Actual cleanup process
|
---|
| 49 | N NAMESPC,MODE,USER,TASKID,%,%H,%I,X,X1,X2,CHKCNT,TMSWT,TOTPR12,DGPR12
|
---|
| 50 | S NAMESPC=$$NAMESPC
|
---|
| 51 | K ^XTMP(NAMESPC,"CONFIG","ABORT TIME")
|
---|
| 52 | S MODE=$G(^XTMP(NAMESPC,"CONFIG","RUN MODE"),0)
|
---|
| 53 | S USER=$G(^XTMP(NAMESPC,"CONFIG","USER"),"UNKNOWN")
|
---|
| 54 | S TASKID=$G(^XTMP(NAMESPC,"CONFIG","ZTSK"),"UNKNOWN")
|
---|
| 55 | ;
|
---|
| 56 | I '$D(^XTMP(NAMESPC,0)) D
|
---|
| 57 | .K ^XTMP(NAMESPC)
|
---|
| 58 | .S ^XTMP(NAMESPC,"CONFIG","DGPR12")=0
|
---|
| 59 | .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=0
|
---|
| 60 | .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=0
|
---|
| 61 | .S ^XTMP(NAMESPC,"CONFIG","RUN MODE")=MODE
|
---|
| 62 | .S ^XTMP(NAMESPC,"CONFIG","USER")=USER
|
---|
| 63 | .S ^XTMP(NAMESPC,"CONFIG","ZTSK")=TASKID
|
---|
| 64 | .D NOW^%DTC
|
---|
| 65 | .S ^XTMP(NAMESPC,"CONFIG","START TIME")=%
|
---|
| 66 | .S X1=$$DT^XLFDT,X2=90
|
---|
| 67 | .D C^%DTC
|
---|
| 68 | .S ^XTMP(NAMESPC,0)=X_U_$$DT^XLFDT_U_NAMESPC_" - PATIENT MERGE CLEANUP"
|
---|
| 69 | ;
|
---|
| 70 | S CHKCNT=250,(ZTSTOP,TMSWT)=0,TOTPR12=+$P($G(^DGPR(408.12,0)),"^",4)
|
---|
| 71 | S DGPR12=$G(^XTMP(NAMESPC,"CONFIG","DGPR12"))
|
---|
| 72 | F S DGPR12=$O(^DGPR(408.12,DGPR12)) Q:'DGPR12!(TMSWT) D
|
---|
| 73 | .D PROC(DGPR12)
|
---|
| 74 | .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))+1
|
---|
| 75 | .S ^XTMP(NAMESPC,"CONFIG","DGPR12")=DGPR12
|
---|
| 76 | .I TOTPR12 D
|
---|
| 77 | ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))/TOTPR12
|
---|
| 78 | ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$P((^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")*100),".")
|
---|
| 79 | .I +$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))#CHKCNT=0 D
|
---|
| 80 | ..S TMSWT=$$STOPIT()
|
---|
| 81 | ..I TMSWT D
|
---|
| 82 | ...S ZTSTOP=1
|
---|
| 83 | ...N %,%H,%I,X
|
---|
| 84 | ...D NOW^%DTC
|
---|
| 85 | ...S ^XTMP(NAMESPC,"CONFIG","ABORT TIME")=%
|
---|
| 86 | ...D ABORTMSG
|
---|
| 87 | ;
|
---|
| 88 | I 'DGPR12,'TMSWT D
|
---|
| 89 | .N %,%H,%I,X
|
---|
| 90 | .D NOW^%DTC
|
---|
| 91 | .S ^XTMP(NAMESPC,"CONFIG","COMPLETE")=%
|
---|
| 92 | .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=100
|
---|
| 93 | .D DONEMSG
|
---|
| 94 | ;
|
---|
| 95 | K ^XTMP(NAMESPC,"CONFIG","RUNNING")
|
---|
| 96 | Q
|
---|
| 97 | PROC(DGPR12) ; Process the DGPR12
|
---|
| 98 | N NAMESPC,NODE0,DFN,PERSON,DATA,DIE,DA,DR,X
|
---|
| 99 | S NAMESPC=$$NAMESPC()
|
---|
| 100 | S NODE0=$G(^DGPR(408.12,DGPR12,0))
|
---|
| 101 | Q:NODE0=""
|
---|
| 102 | S DFN=$P(NODE0,"^")
|
---|
| 103 | Q:DFN=""
|
---|
| 104 | S PERSON=$P(NODE0,"^",3)
|
---|
| 105 | I PERSON'="",PERSON["DPT",DFN=$P(PERSON,";"),'$D(^DGPR(408.12,"C",PERSON,DGPR12)) D
|
---|
| 106 | .S DATA(.03)=$$GET1^DIQ(408.12,DGPR12_",",.01,"I")_";DPT("
|
---|
| 107 | .S DIE="^DGPR(408.12,",DA=DGPR12,DR=".03////^S X=DATA(.03)"
|
---|
| 108 | .D:MODE ^DIE
|
---|
| 109 | .S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
|
---|
| 110 | .S ^XTMP(NAMESPC,"DATA",DGPR12)=""
|
---|
| 111 | Q
|
---|
| 112 | STOPIT() ; Checks if user requested task to stop
|
---|
| 113 | N X,STOPIT
|
---|
| 114 | S STOPIT=0
|
---|
| 115 | S X=$$S^%ZTLOAD
|
---|
| 116 | I X D ;
|
---|
| 117 | .S STOPIT=1
|
---|
| 118 | .I $G(ZTSK) S ZTSTOP=1
|
---|
| 119 | Q STOPIT
|
---|
| 120 | ABORTMSG ; Send the user aborted message:
|
---|
| 121 | N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
|
---|
| 122 | S NAMESPC=$$NAMESPC
|
---|
| 123 | S NAMESPCN=$P(NAMESPC,"EAS",2)
|
---|
| 124 | S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
|
---|
| 125 | S XMSUB="EAS*1.0*"_NAMESPCN_": PATIENT MERGE CLEANUP - PROCESS STOPPED BY USER"
|
---|
| 126 | S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
|
---|
| 127 | S TMP(NAMESPCN,2)="------------------"
|
---|
| 128 | S TMP(NAMESPCN,3)=""
|
---|
| 129 | S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely. Here is the current status:"
|
---|
| 130 | S TMP(NAMESPCN,5)=""
|
---|
| 131 | S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
|
---|
| 132 | S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
|
---|
| 133 | S TMP(NAMESPCN,8)=""
|
---|
| 134 | S TMP(NAMESPCN,9)="Current Counts: "
|
---|
| 135 | S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
|
---|
| 136 | S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))
|
---|
| 137 | S TMP(NAMESPCN,12)=" Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
|
---|
| 138 | S TMP(NAMESPCN,13)=""
|
---|
| 139 | S TMP(NAMESPCN,14)=""
|
---|
| 140 | D ^XMD
|
---|
| 141 | Q
|
---|
| 142 | DONEMSG ; Send the user done message:
|
---|
| 143 | N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
|
---|
| 144 | S NAMESPC=$$NAMESPC
|
---|
| 145 | S NAMESPCN=$P(NAMESPC,"EAS",2)
|
---|
| 146 | S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
|
---|
| 147 | S XMSUB="EAS*1.0*"_NAMESPCN_": PATIENT MERGE CLEANUP - SUMMARY REPORT"
|
---|
| 148 | S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
|
---|
| 149 | S TMP(NAMESPCN,2)="------------------"
|
---|
| 150 | S TMP(NAMESPCN,3)=""
|
---|
| 151 | S TMP(NAMESPCN,4)="The cleanup has run to completion. Here are the results:"
|
---|
| 152 | S TMP(NAMESPCN,5)=""
|
---|
| 153 | S TMP(NAMESPCN,6)=" Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
|
---|
| 154 | S TMP(NAMESPCN,7)=" End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
|
---|
| 155 | S TMP(NAMESPCN,8)=""
|
---|
| 156 | S TMP(NAMESPCN,9)="Current Counts: "
|
---|
| 157 | S TMP(NAMESPCN,10)=" Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
|
---|
| 158 | S TMP(NAMESPCN,11)=" Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))
|
---|
| 159 | S TMP(NAMESPCN,12)=" Percentage Completed: 100%"
|
---|
| 160 | S TMP(NAMESPCN,13)=""
|
---|
| 161 | S TMP(NAMESPCN,14)=""
|
---|
| 162 | D ^XMD
|
---|
| 163 | Q
|
---|
| 164 | FIXOPT ; Fix 'EAS MT 30 DAY LETTER PRINT' option
|
---|
| 165 | N OPTNAME,OPTIEN,DIE,DA,DR,X
|
---|
| 166 | S OPTNAME="EAS MT 30 DAY LETTER PRINT"
|
---|
| 167 | Q:'$D(^DIC(19,"B",OPTNAME))
|
---|
| 168 | S OPTIEN=0
|
---|
| 169 | F S OPTIEN=$O(^DIC(19,"B",OPTNAME,OPTIEN)) Q:'OPTIEN D
|
---|
| 170 | .S DIE="^DIC(19,",DA=OPTIEN,DR="25///^S X=""@"""
|
---|
| 171 | .D ^DIE
|
---|
| 172 | Q
|
---|