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