OR3P453 ;SLC/RBD - Post Install 453 ;Nov 04, 2020@18:43:11
;;3.0;ORDER ENTRY/RESULTS REPORTING;**453**;Dec 17, 1997;Build 47
;
;
POST ; Post-Install for OR*3.0*453
; Rebuild EPRTRDT cross reference
D BMES^XPDUTL("Rebuilding 'EPRTRDT' cross-reference.")
D RBRDT
D BMES^XPDUTL("'EPRTRDT' cross-reference rebuild completed.")
N ORMSG
S ORMSG(1)="This patch will create a new New Style cross reference"
S ORMSG(2)="called 'EPRACDT' which will be at the ORDER file level"
S ORMSG(3)="but on PROVIDER & DATE/TIME ORDERED sub-fields of the"
S ORMSG(4)="ORDER ACTIONS Multiple."
S ORMSG(5)=" "
S ORMSG(6)="Creation of 'EPRACDT' will now go forward in the"
S ORMSG(7)="Background."
S ORMSG(8)=" "
S ORMSG(9)="You will be given a TaskMan task # to check on or,"
S ORMSG(10)="alternately, you can check your mail on MailMan for a"
S ORMSG(11)="message expressing Completion of this Task with"
S ORMSG(12)="appropriate details."
S ORMSG(13)=" "
S ORMSG(14)="Note Install of this Patch cannot be considered"
S ORMSG(15)="Complete unless and until this Task is Completed."
S ORMSG(16)=" "
S ORMSG(17)="Note also that the Status of the 'EPRACDT' Creation"
S ORMSG(18)="can be checked by requesting IT to run 'D CHECK^OR3P453'"
S ORMSG(19)="at the Command Prompt."
S ORMSG(20)=" "
D BMES^XPDUTL(.ORMSG)
I $D(^XTMP("OR3P453","START")) D
. D MES^XPDUTL("Task to Create 'EPRACDT' Already Begun "_$$HTE^XLFDT(^XTMP("OR3P453","START"))_".")
. D MES^XPDUTL("")
I $D(^XTMP("OR3P453","FINISH")) D Q
. D MES^XPDUTL("...and Completed "_$$HTE^XLFDT(^XTMP("OR3P453","FINISH"))_".")
. D MES^XPDUTL("")
I $D(^XTMP("OR3P453","STOPPED")) D G SKPQUIT
. D MES^XPDUTL("...and Stopped "_$$HTE^XLFDT(^XTMP("OR3P453","STOPPED"))_".")
. D MES^XPDUTL(""),MES^XPDUTL("...Resuming 'EPRACDT' Creation."),MES^XPDUTL("")
Q:$D(^XTMP("OR3P453"))
SKPQUIT ;
S ZTRTN="SETXREF^OR3P453",ZTIO="",ZTDTH=$H
S ZTDESC="Creation of New Style X-Ref 'EPRACDT' in ORDER file" D ^%ZTLOAD
I $G(ZTSK) D MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($G(ZTSK("D")))) I 1
E D MES^XPDUTL("***** UNABLE TO QUEUE CREATION OF 'EPRACDT' ORDER FILE X-REF *****")
K ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSK
Q
;
SETXREF ; Set new EPRACDT New Style cross reference for old data
N CNT,CNT2,DA,DIK,LASTREC,ORIEN,STOP,XTMPCNT,XTMPMSG,ZTREQ
S U="^" S STOP=0 I $G(^XTMP("OR3P453","STOPPED"))]"" D G RESUME
. K ^XTMP("OR3P453","STOPPED") S XTMPCNT=$O(^XTMP("OR3P453"," "),-1)
K ^XTMP("OR3P453")
S ^XTMP("OR3P453",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)
S ^XTMP("OR3P453","START")=$H
S ^XTMP("OR3P453","RECTOTAL")=$P($G(^OR(100,0)),U,4)
S XTMPCNT=0
S XTMPCNT=XTMPCNT+1
S XTMPMSG="Creation of 'EPRACDT' X-Ref for ORDER file Started "
S XTMPMSG=XTMPMSG_$$HTE^XLFDT(^XTMP("OR3P453","START"))_"."
S ^XTMP("OR3P453",XTMPCNT)=XTMPMSG
S XTMPCNT=XTMPCNT+1,^XTMP("OR3P453",XTMPCNT)=" "
RESUME ; Possibly resume here if previously stopped
S LASTREC=$G(^XTMP("OR3P453","LAST_REC_PROCESSED"))
S ORIEN=$P(LASTREC,U,1),CNT=$P(LASTREC,U,2)
I ORIEN="" S ORIEN=" ",CNT=0 K ^OR(100,"EPRACDT")
F S ORIEN=$O(^OR(100,ORIEN),-1) Q:'ORIEN D I STOP Q
. S DIK="^OR(100,"_ORIEN_",8,",DIK(1)=".01^EPRACDT",DA(1)=ORIEN D ENALL^DIK
. S CNT=CNT+1,^XTMP("OR3P453","LAST_REC_PROCESSED")=ORIEN_U_CNT
. I '(CNT#100000) D I STOP Q ;pause after every 100,000 records
.. F CNT2=1:1:300 H 1 S STOP=$$REQ2STOP() I STOP Q ;pause for 5 minutes
. S STOP=$$REQ2STOP() I STOP Q
I STOP Q
S XTMPMSG="Creation of 'EPRACDT' X-Ref Completed."
S XTMPCNT=XTMPCNT+1,^XTMP("OR3P453",XTMPCNT)=XTMPMSG
S XTMPCNT=XTMPCNT+1,^XTMP("OR3P453",XTMPCNT)=" "
S ^XTMP("OR3P453","FINISH")=$H
S XTMPMSG="Background Task Finished "
S XTMPMSG=XTMPMSG_$$HTE^XLFDT(^XTMP("OR3P453","FINISH"))_"."
S XTMPCNT=XTMPCNT+1,^XTMP("OR3P453",XTMPCNT)=XTMPMSG
;
; Send Mail to installer to notify of completion
S XMSUB="OR*3.0*453 post install has run to completion."
S XMDUZ="Patch OR*3.0*453"
S XTMPCNT=0
XRFLOOP S XTMPCNT=$O(^XTMP("OR3P453",XTMPCNT)) G:XTMPCNT'?1N.N FIN
S ^TMP($J,"OR3P453",XTMPCNT,0)=^XTMP("OR3P453",XTMPCNT)
G XRFLOOP
;
FIN S XMTEXT="^TMP($J,""OR3P453"","
S XMY(DUZ)="" D ^XMD K ^TMP($J,"OR3P453") S ZTREQ="@"
K XMDUZ,XMSUB,XMTEXT,XMY
Q
;
REQ2STOP() ;
; Check for task stop request
; Returns 1 if stop request made.
N STATUS,X
S STATUS=0
I '$D(ZTQUEUED) Q 0
S X=$$S^%ZTLOAD()
I X D ;
. S STATUS=1
. S X=$$S^%ZTLOAD("Received shutdown request")
;
I STATUS S ^XTMP("OR3P453","STOPPED")=$H
Q STATUS
;
CHECK ; Check the Status of the Task by looking at XTMP information
S U="^" N CNT,PCNT,RECTOTAL
I '$D(^XTMP("OR3P453")) D Q
. D MES^XPDUTL("Task to Create 'EPRACDT' has either not started or has")
. D MES^XPDUTL("automatically purged from the system.")
. D MES^XPDUTL("")
I $D(^XTMP("OR3P453","START")) D
. D MES^XPDUTL("Task to Create 'EPRACDT' Begun "_$$HTE^XLFDT(^XTMP("OR3P453","START"))_".")
. D MES^XPDUTL("")
I $D(^XTMP("OR3P453","FINISH")) D Q
. D MES^XPDUTL("...and Completed "_$$HTE^XLFDT(^XTMP("OR3P453","FINISH"))_".")
. D MES^XPDUTL("")
I $D(^XTMP("OR3P453","STOPPED")) D
. D MES^XPDUTL("...and Stopped "_$$HTE^XLFDT(^XTMP("OR3P453","STOPPED"))_".")
. D MES^XPDUTL("")
S CNT=$P($G(^XTMP("OR3P453","LAST_REC_PROCESSED")),U,2)
I +$G(CNT)'>0 Q
S RECTOTAL=$G(^XTMP("OR3P453","RECTOTAL"))
S PCNT=$P(((CNT/RECTOTAL)*100),".",1)
D MES^XPDUTL("...Currently, "_PCNT_"% of Records have been Processed.")
D MES^XPDUTL("")
Q
RBRDT ;
N ORS1,ORS2,ORS3,ORS4
S ORS1=0
F S ORS1=$O(^OR(100,"EPRTRDT",ORS1)) Q:'ORS1 D
. S ORS2=0
. F S ORS2=$O(^OR(100,"EPRTRDT",ORS1,ORS2)) Q:'ORS2 D
.. S ORS3=0
.. F S ORS3=$O(^OR(100,"EPRTRDT",ORS1,ORS2,ORS3)) Q:'ORS3 D
... S ORS4=0
... F S ORS4=$O(^OR(100,"EPRTRDT",ORS1,ORS2,ORS3,ORS4)) Q:'ORS4 D
.... K ^OR(100,"EPRTRDT",ORS1,ORS2,ORS3,ORS4)
.... S DIK="^OR(100,ORS3,11,",DIK(1)=".03^EPRTRDT",DA=ORS4,DA(1)=ORS3 D EN1^DIK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOR3P453 6008 printed Sep 23, 2025@20:02:59 Page 2
OR3P453 ;SLC/RBD - Post Install 453 ;Nov 04, 2020@18:43:11
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**453**;Dec 17, 1997;Build 47
+2 ;
+3 ;
POST ; Post-Install for OR*3.0*453
+1 ; Rebuild EPRTRDT cross reference
+2 DO BMES^XPDUTL("Rebuilding 'EPRTRDT' cross-reference.")
+3 DO RBRDT
+4 DO BMES^XPDUTL("'EPRTRDT' cross-reference rebuild completed.")
+5 NEW ORMSG
+6 SET ORMSG(1)="This patch will create a new New Style cross reference"
+7 SET ORMSG(2)="called 'EPRACDT' which will be at the ORDER file level"
+8 SET ORMSG(3)="but on PROVIDER & DATE/TIME ORDERED sub-fields of the"
+9 SET ORMSG(4)="ORDER ACTIONS Multiple."
+10 SET ORMSG(5)=" "
+11 SET ORMSG(6)="Creation of 'EPRACDT' will now go forward in the"
+12 SET ORMSG(7)="Background."
+13 SET ORMSG(8)=" "
+14 SET ORMSG(9)="You will be given a TaskMan task # to check on or,"
+15 SET ORMSG(10)="alternately, you can check your mail on MailMan for a"
+16 SET ORMSG(11)="message expressing Completion of this Task with"
+17 SET ORMSG(12)="appropriate details."
+18 SET ORMSG(13)=" "
+19 SET ORMSG(14)="Note Install of this Patch cannot be considered"
+20 SET ORMSG(15)="Complete unless and until this Task is Completed."
+21 SET ORMSG(16)=" "
+22 SET ORMSG(17)="Note also that the Status of the 'EPRACDT' Creation"
+23 SET ORMSG(18)="can be checked by requesting IT to run 'D CHECK^OR3P453'"
+24 SET ORMSG(19)="at the Command Prompt."
+25 SET ORMSG(20)=" "
+26 DO BMES^XPDUTL(.ORMSG)
+27 IF $DATA(^XTMP("OR3P453","START"))
Begin DoDot:1
+28 DO MES^XPDUTL("Task to Create 'EPRACDT' Already Begun "_$$HTE^XLFDT(^XTMP("OR3P453","START"))_".")
+29 DO MES^XPDUTL("")
End DoDot:1
+30 IF $DATA(^XTMP("OR3P453","FINISH"))
Begin DoDot:1
+31 DO MES^XPDUTL("...and Completed "_$$HTE^XLFDT(^XTMP("OR3P453","FINISH"))_".")
+32 DO MES^XPDUTL("")
End DoDot:1
QUIT
+33 IF $DATA(^XTMP("OR3P453","STOPPED"))
Begin DoDot:1
+34 DO MES^XPDUTL("...and Stopped "_$$HTE^XLFDT(^XTMP("OR3P453","STOPPED"))_".")
+35 DO MES^XPDUTL("")
DO MES^XPDUTL("...Resuming 'EPRACDT' Creation.")
DO MES^XPDUTL("")
End DoDot:1
GOTO SKPQUIT
+36 if $DATA(^XTMP("OR3P453"))
QUIT
SKPQUIT ;
+1 SET ZTRTN="SETXREF^OR3P453"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+2 SET ZTDESC="Creation of New Style X-Ref 'EPRACDT' in ORDER file"
DO ^%ZTLOAD
+3 IF $GET(ZTSK)
DO MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($GET(ZTSK("D"))))
IF 1
+4 IF '$TEST
DO MES^XPDUTL("***** UNABLE TO QUEUE CREATION OF 'EPRACDT' ORDER FILE X-REF *****")
+5 KILL ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSK
+6 QUIT
+7 ;
SETXREF ; Set new EPRACDT New Style cross reference for old data
+1 NEW CNT,CNT2,DA,DIK,LASTREC,ORIEN,STOP,XTMPCNT,XTMPMSG,ZTREQ
+2 SET U="^"
SET STOP=0
IF $GET(^XTMP("OR3P453","STOPPED"))]""
Begin DoDot:1
+3 KILL ^XTMP("OR3P453","STOPPED")
SET XTMPCNT=$ORDER(^XTMP("OR3P453"," "),-1)
End DoDot:1
GOTO RESUME
+4 KILL ^XTMP("OR3P453")
+5 SET ^XTMP("OR3P453",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)
+6 SET ^XTMP("OR3P453","START")=$HOROLOG
+7 SET ^XTMP("OR3P453","RECTOTAL")=$PIECE($GET(^OR(100,0)),U,4)
+8 SET XTMPCNT=0
+9 SET XTMPCNT=XTMPCNT+1
+10 SET XTMPMSG="Creation of 'EPRACDT' X-Ref for ORDER file Started "
+11 SET XTMPMSG=XTMPMSG_$$HTE^XLFDT(^XTMP("OR3P453","START"))_"."
+12 SET ^XTMP("OR3P453",XTMPCNT)=XTMPMSG
+13 SET XTMPCNT=XTMPCNT+1
SET ^XTMP("OR3P453",XTMPCNT)=" "
RESUME ; Possibly resume here if previously stopped
+1 SET LASTREC=$GET(^XTMP("OR3P453","LAST_REC_PROCESSED"))
+2 SET ORIEN=$PIECE(LASTREC,U,1)
SET CNT=$PIECE(LASTREC,U,2)
+3 IF ORIEN=""
SET ORIEN=" "
SET CNT=0
KILL ^OR(100,"EPRACDT")
+4 FOR
SET ORIEN=$ORDER(^OR(100,ORIEN),-1)
if 'ORIEN
QUIT
Begin DoDot:1
+5 SET DIK="^OR(100,"_ORIEN_",8,"
SET DIK(1)=".01^EPRACDT"
SET DA(1)=ORIEN
DO ENALL^DIK
+6 SET CNT=CNT+1
SET ^XTMP("OR3P453","LAST_REC_PROCESSED")=ORIEN_U_CNT
+7 ;pause after every 100,000 records
IF '(CNT#100000)
Begin DoDot:2
+8 ;pause for 5 minutes
FOR CNT2=1:1:300
HANG 1
SET STOP=$$REQ2STOP()
IF STOP
QUIT
End DoDot:2
IF STOP
QUIT
+9 SET STOP=$$REQ2STOP()
IF STOP
QUIT
End DoDot:1
IF STOP
QUIT
+10 IF STOP
QUIT
+11 SET XTMPMSG="Creation of 'EPRACDT' X-Ref Completed."
+12 SET XTMPCNT=XTMPCNT+1
SET ^XTMP("OR3P453",XTMPCNT)=XTMPMSG
+13 SET XTMPCNT=XTMPCNT+1
SET ^XTMP("OR3P453",XTMPCNT)=" "
+14 SET ^XTMP("OR3P453","FINISH")=$HOROLOG
+15 SET XTMPMSG="Background Task Finished "
+16 SET XTMPMSG=XTMPMSG_$$HTE^XLFDT(^XTMP("OR3P453","FINISH"))_"."
+17 SET XTMPCNT=XTMPCNT+1
SET ^XTMP("OR3P453",XTMPCNT)=XTMPMSG
+18 ;
+19 ; Send Mail to installer to notify of completion
+20 SET XMSUB="OR*3.0*453 post install has run to completion."
+21 SET XMDUZ="Patch OR*3.0*453"
+22 SET XTMPCNT=0
XRFLOOP SET XTMPCNT=$ORDER(^XTMP("OR3P453",XTMPCNT))
if XTMPCNT'?1N.N
GOTO FIN
+1 SET ^TMP($JOB,"OR3P453",XTMPCNT,0)=^XTMP("OR3P453",XTMPCNT)
+2 GOTO XRFLOOP
+3 ;
FIN SET XMTEXT="^TMP($J,""OR3P453"","
+1 SET XMY(DUZ)=""
DO ^XMD
KILL ^TMP($JOB,"OR3P453")
SET ZTREQ="@"
+2 KILL XMDUZ,XMSUB,XMTEXT,XMY
+3 QUIT
+4 ;
REQ2STOP() ;
+1 ; Check for task stop request
+2 ; Returns 1 if stop request made.
+3 NEW STATUS,X
+4 SET STATUS=0
+5 IF '$DATA(ZTQUEUED)
QUIT 0
+6 SET X=$$S^%ZTLOAD()
+7 ;
IF X
Begin DoDot:1
+8 SET STATUS=1
+9 SET X=$$S^%ZTLOAD("Received shutdown request")
End DoDot:1
+10 ;
+11 IF STATUS
SET ^XTMP("OR3P453","STOPPED")=$HOROLOG
+12 QUIT STATUS
+13 ;
CHECK ; Check the Status of the Task by looking at XTMP information
+1 SET U="^"
NEW CNT,PCNT,RECTOTAL
+2 IF '$DATA(^XTMP("OR3P453"))
Begin DoDot:1
+3 DO MES^XPDUTL("Task to Create 'EPRACDT' has either not started or has")
+4 DO MES^XPDUTL("automatically purged from the system.")
+5 DO MES^XPDUTL("")
End DoDot:1
QUIT
+6 IF $DATA(^XTMP("OR3P453","START"))
Begin DoDot:1
+7 DO MES^XPDUTL("Task to Create 'EPRACDT' Begun "_$$HTE^XLFDT(^XTMP("OR3P453","START"))_".")
+8 DO MES^XPDUTL("")
End DoDot:1
+9 IF $DATA(^XTMP("OR3P453","FINISH"))
Begin DoDot:1
+10 DO MES^XPDUTL("...and Completed "_$$HTE^XLFDT(^XTMP("OR3P453","FINISH"))_".")
+11 DO MES^XPDUTL("")
End DoDot:1
QUIT
+12 IF $DATA(^XTMP("OR3P453","STOPPED"))
Begin DoDot:1
+13 DO MES^XPDUTL("...and Stopped "_$$HTE^XLFDT(^XTMP("OR3P453","STOPPED"))_".")
+14 DO MES^XPDUTL("")
End DoDot:1
+15 SET CNT=$PIECE($GET(^XTMP("OR3P453","LAST_REC_PROCESSED")),U,2)
+16 IF +$GET(CNT)'>0
QUIT
+17 SET RECTOTAL=$GET(^XTMP("OR3P453","RECTOTAL"))
+18 SET PCNT=$PIECE(((CNT/RECTOTAL)*100),".",1)
+19 DO MES^XPDUTL("...Currently, "_PCNT_"% of Records have been Processed.")
+20 DO MES^XPDUTL("")
+21 QUIT
RBRDT ;
+1 NEW ORS1,ORS2,ORS3,ORS4
+2 SET ORS1=0
+3 FOR
SET ORS1=$ORDER(^OR(100,"EPRTRDT",ORS1))
if 'ORS1
QUIT
Begin DoDot:1
+4 SET ORS2=0
+5 FOR
SET ORS2=$ORDER(^OR(100,"EPRTRDT",ORS1,ORS2))
if 'ORS2
QUIT
Begin DoDot:2
+6 SET ORS3=0
+7 FOR
SET ORS3=$ORDER(^OR(100,"EPRTRDT",ORS1,ORS2,ORS3))
if 'ORS3
QUIT
Begin DoDot:3
+8 SET ORS4=0
+9 FOR
SET ORS4=$ORDER(^OR(100,"EPRTRDT",ORS1,ORS2,ORS3,ORS4))
if 'ORS4
QUIT
Begin DoDot:4
+10 KILL ^OR(100,"EPRTRDT",ORS1,ORS2,ORS3,ORS4)
+11 SET DIK="^OR(100,ORS3,11,"
SET DIK(1)=".03^EPRTRDT"
SET DA=ORS4
SET DA(1)=ORS3
DO EN1^DIK
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
