| 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
|
|---|