Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EAS126

EAS126.m

Go to the documentation of this file. 
  1. EAS126 ;ALB/PHH - EAS*1*26 POST-INSTALL ;05-27-2003
  1.  ;;1.0;ENROLLMENT APPLICATION SYSTEM;**26**;MAR 15,2001
  1.  Q
  1. EN ; Entry point for post-install
  1.  D FIXOPT,START
  1.  Q
  1. RESET ; Reset the data for the cleanup process
  1.  K ^XTMP($$NAMESPC)
  1.  Q
  1. TEST ; Simulate Live Run
  1.  N MODE
  1.  S MODE=0
  1. START ; Start Processor
  1.  N NAMESPC,QTIME
  1.  S NAMESPC=$$NAMESPC
  1.  Q:$$RUNCHK(NAMESPC)   ; Quit if already running or has run to completion
  1.  Q:$$QTIME(.QTIME)
  1.  S:$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) MODE=^XTMP(NAMESPC,"CONFIG","RUN MODE")
  1.  S:'$D(^XTMP(NAMESPC,"CONFIG","RUN MODE")) ^XTMP(NAMESPC,"CONFIG","RUN MODE")=$S($G(MODE)=0:0,1:1)
  1.  S ^XTMP(NAMESPC,"CONFIG","USER")=$S($G(DUZ)'="":DUZ,1:"UNKNOWN")
  1.  S:'$$QUEUE(QTIME) ^XTMP(NAMESPC,"CONFIG","RUNNING")=""
  1.  Q
  1. NAMESPC() ; API returns the name space for this patch
  1.  Q "EAS26"
  1. RUNCHK(NAMESPC) ; Check to see if clean up is already running
  1.  Q:NAMESPC="" 1                   ; Name Space must be defined
  1.  Q:$D(^XTMP(NAMESPC,"CONFIG","RUNNING")) 1
  1.  Q:$D(^XTMP(NAMESPC,"CONFIG","COMPLETE")) 1
  1.  Q 0
  1. QTIME(WHEN) ; Get the run time for queuing
  1.  N %,%H,%I,X
  1.  D NOW^%DTC
  1.  S WHEN=$P(%,".")_"."_$E($P(%,".",2),1,4)
  1.  Q 0
  1. QUEUE(ZTDTH) ; Queue the process
  1.  N NAMESPC,QUEERR,ZTDESC,ZTRTN,ZTSK
  1.  S NAMESPC=$$NAMESPC
  1.  S QUEERR=0
  1.  S ZTRTN="CLEAN^EAS1"_$P(NAMESPC,"EAS",2)
  1.  S ZTDESC=NAMESPC_" - Patient Merge Cleanup Process"
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  K ^XTMP(NAMESPC,"CONFIG","ZTSK")
  1.  I '$D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Unable to queue post-install process.",QUEERR=1
  1.  I $D(ZTSK) S ^XTMP(NAMESPC,"CONFIG","ZTSK")="Post-install queued. Task ID: "_$G(ZTSK)
  1.  D HOME^%ZIS
  1.  Q QUEERR
  1. CLEAN ; Actual cleanup process
  1.  N NAMESPC,MODE,USER,TASKID,%,%H,%I,X,X1,X2,CHKCNT,TMSWT,TOTPR12,DGPR12
  1.  S NAMESPC=$$NAMESPC
  1.  K ^XTMP(NAMESPC,"CONFIG","ABORT TIME")
  1.  S MODE=$G(^XTMP(NAMESPC,"CONFIG","RUN MODE"),0)
  1.  S USER=$G(^XTMP(NAMESPC,"CONFIG","USER"),"UNKNOWN")
  1.  S TASKID=$G(^XTMP(NAMESPC,"CONFIG","ZTSK"),"UNKNOWN")
  1.  ;
  1.  I '$D(^XTMP(NAMESPC,0)) D
  1.  .K ^XTMP(NAMESPC)
  1.  .S ^XTMP(NAMESPC,"CONFIG","DGPR12")=0
  1.  .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=0
  1.  .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=0
  1.  .S ^XTMP(NAMESPC,"CONFIG","RUN MODE")=MODE
  1.  .S ^XTMP(NAMESPC,"CONFIG","USER")=USER
  1.  .S ^XTMP(NAMESPC,"CONFIG","ZTSK")=TASKID
  1.  .D NOW^%DTC
  1.  .S ^XTMP(NAMESPC,"CONFIG","START TIME")=%
  1.  .S X1=$$DT^XLFDT,X2=90
  1.  .D C^%DTC
  1.  .S ^XTMP(NAMESPC,0)=X_U_$$DT^XLFDT_U_NAMESPC_" - PATIENT MERGE CLEANUP"
  1.  ;
  1.  S CHKCNT=250,(ZTSTOP,TMSWT)=0,TOTPR12=+$P($G(^DGPR(408.12,0)),"^",4)
  1.  S DGPR12=$G(^XTMP(NAMESPC,"CONFIG","DGPR12"))
  1.  F  S DGPR12=$O(^DGPR(408.12,DGPR12)) Q:'DGPR12!(TMSWT)  D
  1.  .D PROC(DGPR12)
  1.  .S ^XTMP(NAMESPC,"CONFIG","TOTPR")=$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))+1
  1.  .S ^XTMP(NAMESPC,"CONFIG","DGPR12")=DGPR12
  1.  .I TOTPR12 D
  1.  ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))/TOTPR12
  1.  ..S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=+$P((^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")*100),".")
  1.  .I +$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))#CHKCNT=0 D
  1.  ..S TMSWT=$$STOPIT()
  1.  ..I TMSWT D
  1.  ...S ZTSTOP=1
  1.  ...N %,%H,%I,X
  1.  ...D NOW^%DTC
  1.  ...S ^XTMP(NAMESPC,"CONFIG","ABORT TIME")=%
  1.  ...D ABORTMSG
  1.  ;
  1.  I 'DGPR12,'TMSWT D
  1.  .N %,%H,%I,X
  1.  .D NOW^%DTC
  1.  .S ^XTMP(NAMESPC,"CONFIG","COMPLETE")=%
  1.  .S ^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE")=100
  1.  .D DONEMSG
  1.  ;
  1.  K ^XTMP(NAMESPC,"CONFIG","RUNNING")
  1.  Q
  1. PROC(DGPR12) ; Process the DGPR12
  1.  N NAMESPC,NODE0,DFN,PERSON,DATA,DIE,DA,DR,X
  1.  S NAMESPC=$$NAMESPC()
  1.  S NODE0=$G(^DGPR(408.12,DGPR12,0))
  1.  Q:NODE0=""
  1.  S DFN=$P(NODE0,"^")
  1.  Q:DFN=""
  1.  S PERSON=$P(NODE0,"^",3)
  1.  I PERSON'="",PERSON["DPT",DFN=$P(PERSON,";"),'$D(^DGPR(408.12,"C",PERSON,DGPR12)) D
  1.  .S DATA(.03)=$$GET1^DIQ(408.12,DGPR12_",",.01,"I")_";DPT("
  1.  .S DIE="^DGPR(408.12,",DA=DGPR12,DR=".03////^S X=DATA(.03)"
  1.  .D:MODE ^DIE
  1.  .S ^XTMP(NAMESPC,"CONFIG","ANOMALY")=$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))+1
  1.  .S ^XTMP(NAMESPC,"DATA",DGPR12)=""
  1.  Q
  1. STOPIT() ; Checks if user requested task to stop
  1.  N X,STOPIT
  1.  S STOPIT=0
  1.  S X=$$S^%ZTLOAD
  1.  I X D  ;
  1.  .S STOPIT=1
  1.  .I $G(ZTSK) S ZTSTOP=1
  1.  Q STOPIT
  1. ABORTMSG ; Send the user aborted message:
  1.  N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
  1.  S NAMESPC=$$NAMESPC
  1.  S NAMESPCN=$P(NAMESPC,"EAS",2)
  1.  S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
  1.  S XMSUB="EAS*1.0*"_NAMESPCN_": PATIENT MERGE CLEANUP - PROCESS STOPPED BY USER"
  1.  S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
  1.  S TMP(NAMESPCN,2)="------------------"
  1.  S TMP(NAMESPCN,3)=""
  1.  S TMP(NAMESPCN,4)="The cleanup process was aborted prematurely.  Here is the current status:"
  1.  S TMP(NAMESPCN,5)=""
  1.  S TMP(NAMESPCN,6)="  Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
  1.  S TMP(NAMESPCN,7)="    End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","ABORT TIME")),"P")
  1.  S TMP(NAMESPCN,8)=""
  1.  S TMP(NAMESPCN,9)="Current Counts: "
  1.  S TMP(NAMESPCN,10)="       Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
  1.  S TMP(NAMESPCN,11)="             Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))
  1.  S TMP(NAMESPCN,12)="                  Percentage Completed: "_+$G(^XTMP(NAMESPC,"CONFIG","PERCENT COMPLETE"))_"%"
  1.  S TMP(NAMESPCN,13)=""
  1.  S TMP(NAMESPCN,14)=""
  1.  D ^XMD
  1.  Q
  1. DONEMSG ; Send the user done message:
  1.  N NAMESPC,NAMESPCN,TMP,XMY,XMDUZ,XMTEXT,XMSUB
  1.  S NAMESPC=$$NAMESPC
  1.  S NAMESPCN=$P(NAMESPC,"EAS",2)
  1.  S XMY(DUZ)="",XMDUZ="DG PACKAGE",XMTEXT="TMP("_NAMESPCN_","
  1.  S XMSUB="EAS*1.0*"_NAMESPCN_": PATIENT MERGE CLEANUP - SUMMARY REPORT"
  1.  S TMP(NAMESPCN,1)="CLEANUP PROCESSING"
  1.  S TMP(NAMESPCN,2)="------------------"
  1.  S TMP(NAMESPCN,3)=""
  1.  S TMP(NAMESPCN,4)="The cleanup has run to completion.  Here are the results:"
  1.  S TMP(NAMESPCN,5)=""
  1.  S TMP(NAMESPCN,6)="  Start Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","START TIME")),"P")
  1.  S TMP(NAMESPCN,7)="    End Date/Time: "_$$FMTE^XLFDT(+$G(^XTMP(NAMESPC,"CONFIG","COMPLETE")),"P")
  1.  S TMP(NAMESPCN,8)=""
  1.  S TMP(NAMESPCN,9)="Current Counts: "
  1.  S TMP(NAMESPCN,10)="       Total Patient Records Processed: "_+$G(^XTMP(NAMESPC,"CONFIG","TOTPR"))
  1.  S TMP(NAMESPCN,11)="             Total Anomalies Corrected: "_+$G(^XTMP(NAMESPC,"CONFIG","ANOMALY"))
  1.  S TMP(NAMESPCN,12)="                  Percentage Completed: 100%"
  1.  S TMP(NAMESPCN,13)=""
  1.  S TMP(NAMESPCN,14)=""
  1.  D ^XMD
  1.  Q
  1. FIXOPT ; Fix 'EAS MT 30 DAY LETTER PRINT' option
  1.  N OPTNAME,OPTIEN,DIE,DA,DR,X
  1.  S OPTNAME="EAS MT 30 DAY LETTER PRINT"
  1.  Q:'$D(^DIC(19,"B",OPTNAME))
  1.  S OPTIEN=0
  1.  F  S OPTIEN=$O(^DIC(19,"B",OPTNAME,OPTIEN)) Q:'OPTIEN  D
  1.  .S DIE="^DIC(19,",DA=OPTIEN,DR="25///^S X=""@"""
  1.  .D ^DIE
  1.  Q