LA66 ;DALOI/JMC - LA*5.2*66 PATCH ENVIRONMENT CHECK ROUTINE ;May 7, 2008
;;5.2;AUTOMATED LAB INSTRUMENTS;**66**;Sep 27, 1994;Build 30
;
; Pre, Post, and Environment checks for LA*5.2*66
;
ENV ;
; Environment checks
S XPDNOQUE=1 ; no queuing
N LAERR,LAADL
K ^TMP($$RTNNM(),$J)
I '$G(XPDENV) D ;
. N MSG
. S MSG="Transport global for patch "_$G(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($H)
. D ALERT(MSG)
. D BMES("Sending transport global loaded alert to mail group G.LMI")
;
I $G(XPDENV) D ;
. N MSG
. S MSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H)
. D ALERT(MSG)
. D BMES("Sending install started alert to mail group G.LMI")
;
S LAERR=0
I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D ;
. D BMES("Terminal Device is not defined.")
. S LAERR=2
;
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D ;
. D BMES("Please login to set local DUZ variables.")
. S LAERR=2
;
I 'LAERR,$P($$ACTIVE^XUSER(DUZ),"^")'=1 D ;
. D BMES("You are not a valid user on this system.")
. S LAERR=2
;
; If installing, run system config
I 'LAERR,$G(XPDENV) D ;
. S LAADL=$G(^LA("ADL","STOP"))
. D ENV2
. I $P(LAADL,"^")=0 D ;
. . D BMES("N O T E: If you abort this installation")
. . D MES("restart the Lab Universal Interface background job.")
;
I LAERR!$D(XPDABORT)!$D(XPDQUIT) D ;
. S LAERR=1
. S XPDABORT=2 S XPDQUIT=2
. W !,$C(7) W ! D BMES("* * * Environment check FAILED * * *")
;
I 'LAERR W ! D BMES("--- Environment is okay ---")
;
I $G(XPDENV) S XPDDIQ("XPZ1","B")="NO"
Q
;
;
PRE ;
; Pre install
D BMES("*** Pre install started ***")
D BMES("--- No action required for pre-install ---")
D BMES("*** Pre install completed ***")
Q
;
;
POST ;
; Post install
N LAERR,LAFDA,LA7DIE,LA7FAC,LA7I,LA7X,LA7Y,LAMSG,LAPOST,DIERR
S (LAERR,LAPOST)=0
D BMES("*** Post install started ***")
;
; Set facility station number into FACILITY NAME field in file #771.
S LA7FAC=$P($$SITE^VASITE(DT),"^",3)
I 'LA7FAC D ;
. S LAERR=1
. D BMES("ERROR: Could not determine Facility Number.")
. D BMES("Edit file #771, FACILITY NAME field for LA7UI*")
I LA7FAC'="" D
. D BMES("*** Updating facility name for LA7UI* entries in file #771 ***")
. ; Okayed by Thomas Grohowski
. F LA7I=1:1:10 D ;
. . I LA7I S LA7X="LA7UI"_LA7I
. . K DIERR
. . S LA7Y=$$FIND1^DIC(771,"","OX",LA7X,"B")
. . I LA7Y<1 D Q
. . . S LAERR=1
. . . D BMES("ERROR: "_LA7X_" not found in file #771")
. . K LAFDA,DIERR,LAMSG
. . S LAFDA(1,771,LA7Y_",",3)=LA7FAC
. . D FILE^DIE("","LAFDA(1)","LAMSG")
. . ; notify if could not update
. . S LAERR=$$FMERR("LAMSG","ERROR: unable to update "_LA7X_" in file #771")
. ; delete facility ID for LA7LAB
. K LAFDA,LAMSG,DIERR
. S LA7Y=$$FIND1^DIC(771,"","OX","LA7LAB","B")
. I 'LA7Y D
. . S LAERR=1
. . D BMES("*** Missing 'LA7LAB' entry in HL7 APPLICATION PARAMETER (#771) file ***")
. I LA7Y D
. . K DIERR,LAFDA,LAMSG
. . S LAFDA(1,771,LA7Y_",",3)="@"
. . D FILE^DIE("","LAFDA(1)","LAMSG")
. . S LAERR=$$FMERR("LAMSG","ERROR: Failed to update LA7LAB entry in file #771.")
. S LAPOST=1
. D BMES("*** Updating facility name completed"_$S(LAERR:" but with errors",1:"")_" ***")
;
;
I $D(^TMP("LA66",$J,"62.48")) D
. D BMES("*** Restoring existing LA7UI* entries to ACTIVE in file #62.48 ***")
. S LA7I=0,LAPOST=1
. F S LA7I=$O(^TMP("LA66",$J,"62.48",LA7I)) Q:'LA7I D
. . K DIERR,LAFDA,LAMSG
. . S LA7Y=$P(^LAHM(62.48,LA7I,0),"^")
. . D BMES("*** Updating entry "_LA7Y_" to ACTIVE in file #62.48 ***")
. . S LAFDA(2,62.48,LA7I_",",2)=^TMP("LA66",$J,"62.48",LA7I)
. . D FILE^DIE("","LAFDA(2)","LAMSG")
. . S LAERR=$$FMERR("LAMSG","ERROR: Failed to update "_LA7Y_" entry in file #62.48.")
. D BMES("*** Updating existing LA7UI* entries to ACTIVE completed ***")
;
I 'LAERR,'LAPOST D BMES("--- No actions required for post install ---")
;
D RESTORE
D BMES("*** Post install completed"_$S(LAERR:" but with errors",1:"")_" ***")
;
N MSG
S MSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)
D ALERT(MSG)
D BMES("Sending install completion alert to mail group G.LMI")
;
K ^TMP($$RTNNM(),$J),^TMP("LA66",$J)
Q
;
;
BMES(STR,POS) ;
; Display messages using BMES^XPDUTL or MES^XPDUTL
; Accepts single string or string array
; Input
; STR The string to display (byRef or byValue)
; POS <opt> value for $$CJ^XLFSTR (80=default)
;
N I,X
S POS=$G(POS,80)
; If an array, step through it and pass each node to MES since $$CJ^XLFSTR can't handle arrays
I $D(STR)>9 D
. S I=0
. F S I=$O(STR(I)) Q:'I S X=STR(I) D MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(X,POS),"R"," "))
;
I $D(STR)<2 D MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,POS),"R"," "))
Q
;
;
MES(STR,CJ,LM) ;
; Displays a string using MES^XPDUTL
; Inputs
; STR: String to display
; CJ: Center text? 1=yes 0=1 <dflt=1>
; LM: Left Margin (padding)
N X
S STR=$G(STR)
S CJ=$G(CJ,1)
S LM=$G(LM)
I LM<0 S LM=0
I CJ S STR=$$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," ")
I 'CJ I LM S X="" S $P(X," ",LM)=" " S STR=X_STR
D MES^XPDUTL(STR)
Q
;
;
FMERR(LAREF,MSG) ;
; Checks if a FileMan error occurred and displays help message
; and error text message.
; Input
; LAREF Name of array that has the FM DIERR subscripts
; ie FILE^DIE msg_root variable
; MSG <opt> Additional help text
; Output
; 1 if an error occurred, 0 if no error
; Also writes the messages to the device
N LAERRMSG,OK,FMERR
S LAREF=$G(LAREF)
S MSG=$G(MSG)
S FMERR=0
D MSG^DIALOG("AE",.LAERRMSG,,,LAREF)
I $D(LAERRMSG) D ;
. I MSG'="" D BMES(MSG)
. D BMES(.LAERRMSG)
. S FMERR=1
Q FMERR
;
;
ENV2 ;
; Secondary Environment checks
N X,I
; check and shutdown Auto Download job.
S X=$G(^LA("ADL","STOP"))
I $P(X,"^")=0 D ;
. D SETSTOP^LA7ADL1(2,DUZ)
. D BMES("Shutting down Lab Universal Interface Auto Download Job")
. S ^TMP($$RTNNM(),$J,"ADL")=1
. F I=1:1:10 W "." H 1
;
;
; If previously installed then save current ACTIVE LA7UI* entries.
K ^TMP("LA66",$J,"62.48")
S I=0
F S I=$O(^LAHM(62.48,I)) Q:'I I $E($P(^LAHM(62.48,I,0),"^"),1,5)="LA7UI",$P(^LAHM(62.48,I,0),"^",3)=1 S ^TMP("LA66",$J,"62.48",I)=1
Q
;
;
RESTORE ;
; Restore system after install
N LAADL,X
; Restart auto download process status if stopped by install
S LAADL=$G(^TMP($$RTNNM(),$J,"ADL"))
I LAADL=1 D ;
. D ZTSK^LA7ADL
. D SETSTOP^LA7ADL1(1,DUZ)
. D BMES("Restarting Lab Universal Interface Auto Download Job")
. K ^TMP($$RTNNM(),$J,"ADL")
. H 3
;
; If ADL not started, notify user to restart
S X=$G(^LA("ADL","STOP"))
S X=$P(X,"^")
I X'=0 D BMES("Be sure to restart the Lab Universal Interface Auto Download Job")
K ^TMP($$RTNNM(),$J)
Q
;
;
ALERT(MSG,RECIPS) ;
N DA,DIK,XQA,XQAMSG
S XQAMSG=$G(MSG)
S XQA("G.LMI")=""
I $D(RECIPS) M XQA=RECIPS
D SETUP^XQALERT
Q
;
;
RTNNM() ;
Q $T(+0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA66 7105 printed Aug 26, 2025@21:54:36 Page 2
LA66 ;DALOI/JMC - LA*5.2*66 PATCH ENVIRONMENT CHECK ROUTINE ;May 7, 2008
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**66**;Sep 27, 1994;Build 30
+2 ;
+3 ; Pre, Post, and Environment checks for LA*5.2*66
+4 ;
ENV ;
+1 ; Environment checks
+2 ; no queuing
SET XPDNOQUE=1
+3 NEW LAERR,LAADL
+4 KILL ^TMP($$RTNNM(),$JOB)
+5 ;
IF '$GET(XPDENV)
Begin DoDot:1
+6 NEW MSG
+7 SET MSG="Transport global for patch "_$GET(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($HOROLOG)
+8 DO ALERT(MSG)
+9 DO BMES("Sending transport global loaded alert to mail group G.LMI")
End DoDot:1
+10 ;
+11 ;
IF $GET(XPDENV)
Begin DoDot:1
+12 NEW MSG
+13 SET MSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($HOROLOG)
+14 DO ALERT(MSG)
+15 DO BMES("Sending install started alert to mail group G.LMI")
End DoDot:1
+16 ;
+17 SET LAERR=0
+18 ;
IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
Begin DoDot:1
+19 DO BMES("Terminal Device is not defined.")
+20 SET LAERR=2
End DoDot:1
+21 ;
+22 ;
IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
Begin DoDot:1
+23 DO BMES("Please login to set local DUZ variables.")
+24 SET LAERR=2
End DoDot:1
+25 ;
+26 ;
IF 'LAERR
IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
Begin DoDot:1
+27 DO BMES("You are not a valid user on this system.")
+28 SET LAERR=2
End DoDot:1
+29 ;
+30 ; If installing, run system config
+31 ;
IF 'LAERR
IF $GET(XPDENV)
Begin DoDot:1
+32 SET LAADL=$GET(^LA("ADL","STOP"))
+33 DO ENV2
+34 ;
IF $PIECE(LAADL,"^")=0
Begin DoDot:2
+35 DO BMES("N O T E: If you abort this installation")
+36 DO MES("restart the Lab Universal Interface background job.")
End DoDot:2
End DoDot:1
+37 ;
+38 ;
IF LAERR!$DATA(XPDABORT)!$DATA(XPDQUIT)
Begin DoDot:1
+39 SET LAERR=1
+40 SET XPDABORT=2
SET XPDQUIT=2
+41 WRITE !,$CHAR(7)
WRITE !
DO BMES("* * * Environment check FAILED * * *")
End DoDot:1
+42 ;
+43 IF 'LAERR
WRITE !
DO BMES("--- Environment is okay ---")
+44 ;
+45 IF $GET(XPDENV)
SET XPDDIQ("XPZ1","B")="NO"
+46 QUIT
+47 ;
+48 ;
PRE ;
+1 ; Pre install
+2 DO BMES("*** Pre install started ***")
+3 DO BMES("--- No action required for pre-install ---")
+4 DO BMES("*** Pre install completed ***")
+5 QUIT
+6 ;
+7 ;
POST ;
+1 ; Post install
+2 NEW LAERR,LAFDA,LA7DIE,LA7FAC,LA7I,LA7X,LA7Y,LAMSG,LAPOST,DIERR
+3 SET (LAERR,LAPOST)=0
+4 DO BMES("*** Post install started ***")
+5 ;
+6 ; Set facility station number into FACILITY NAME field in file #771.
+7 SET LA7FAC=$PIECE($$SITE^VASITE(DT),"^",3)
+8 ;
IF 'LA7FAC
Begin DoDot:1
+9 SET LAERR=1
+10 DO BMES("ERROR: Could not determine Facility Number.")
+11 DO BMES("Edit file #771, FACILITY NAME field for LA7UI*")
End DoDot:1
+12 IF LA7FAC'=""
Begin DoDot:1
+13 DO BMES("*** Updating facility name for LA7UI* entries in file #771 ***")
+14 ; Okayed by Thomas Grohowski
+15 ;
FOR LA7I=1:1:10
Begin DoDot:2
+16 IF LA7I
SET LA7X="LA7UI"_LA7I
+17 KILL DIERR
+18 SET LA7Y=$$FIND1^DIC(771,"","OX",LA7X,"B")
+19 IF LA7Y<1
Begin DoDot:3
+20 SET LAERR=1
+21 DO BMES("ERROR: "_LA7X_" not found in file #771")
End DoDot:3
QUIT
+22 KILL LAFDA,DIERR,LAMSG
+23 SET LAFDA(1,771,LA7Y_",",3)=LA7FAC
+24 DO FILE^DIE("","LAFDA(1)","LAMSG")
+25 ; notify if could not update
+26 SET LAERR=$$FMERR("LAMSG","ERROR: unable to update "_LA7X_" in file #771")
End DoDot:2
+27 ; delete facility ID for LA7LAB
+28 KILL LAFDA,LAMSG,DIERR
+29 SET LA7Y=$$FIND1^DIC(771,"","OX","LA7LAB","B")
+30 IF 'LA7Y
Begin DoDot:2
+31 SET LAERR=1
+32 DO BMES("*** Missing 'LA7LAB' entry in HL7 APPLICATION PARAMETER (#771) file ***")
End DoDot:2
+33 IF LA7Y
Begin DoDot:2
+34 KILL DIERR,LAFDA,LAMSG
+35 SET LAFDA(1,771,LA7Y_",",3)="@"
+36 DO FILE^DIE("","LAFDA(1)","LAMSG")
+37 SET LAERR=$$FMERR("LAMSG","ERROR: Failed to update LA7LAB entry in file #771.")
End DoDot:2
+38 SET LAPOST=1
+39 DO BMES("*** Updating facility name completed"_$SELECT(LAERR:" but with errors",1:"")_" ***")
End DoDot:1
+40 ;
+41 ;
+42 IF $DATA(^TMP("LA66",$JOB,"62.48"))
Begin DoDot:1
+43 DO BMES("*** Restoring existing LA7UI* entries to ACTIVE in file #62.48 ***")
+44 SET LA7I=0
SET LAPOST=1
+45 FOR
SET LA7I=$ORDER(^TMP("LA66",$JOB,"62.48",LA7I))
if 'LA7I
QUIT
Begin DoDot:2
+46 KILL DIERR,LAFDA,LAMSG
+47 SET LA7Y=$PIECE(^LAHM(62.48,LA7I,0),"^")
+48 DO BMES("*** Updating entry "_LA7Y_" to ACTIVE in file #62.48 ***")
+49 SET LAFDA(2,62.48,LA7I_",",2)=^TMP("LA66",$JOB,"62.48",LA7I)
+50 DO FILE^DIE("","LAFDA(2)","LAMSG")
+51 SET LAERR=$$FMERR("LAMSG","ERROR: Failed to update "_LA7Y_" entry in file #62.48.")
End DoDot:2
+52 DO BMES("*** Updating existing LA7UI* entries to ACTIVE completed ***")
End DoDot:1
+53 ;
+54 IF 'LAERR
IF 'LAPOST
DO BMES("--- No actions required for post install ---")
+55 ;
+56 DO RESTORE
+57 DO BMES("*** Post install completed"_$SELECT(LAERR:" but with errors",1:"")_" ***")
+58 ;
+59 NEW MSG
+60 SET MSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)
+61 DO ALERT(MSG)
+62 DO BMES("Sending install completion alert to mail group G.LMI")
+63 ;
+64 KILL ^TMP($$RTNNM(),$JOB),^TMP("LA66",$JOB)
+65 QUIT
+66 ;
+67 ;
BMES(STR,POS) ;
+1 ; Display messages using BMES^XPDUTL or MES^XPDUTL
+2 ; Accepts single string or string array
+3 ; Input
+4 ; STR The string to display (byRef or byValue)
+5 ; POS <opt> value for $$CJ^XLFSTR (80=default)
+6 ;
+7 NEW I,X
+8 SET POS=$GET(POS,80)
+9 ; If an array, step through it and pass each node to MES since $$CJ^XLFSTR can't handle arrays
+10 IF $DATA(STR)>9
Begin DoDot:1
+11 SET I=0
+12 FOR
SET I=$ORDER(STR(I))
if 'I
QUIT
SET X=STR(I)
DO MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(X,POS),"R"," "))
End DoDot:1
+13 ;
+14 IF $DATA(STR)<2
DO MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,POS),"R"," "))
+15 QUIT
+16 ;
+17 ;
MES(STR,CJ,LM) ;
+1 ; Displays a string using MES^XPDUTL
+2 ; Inputs
+3 ; STR: String to display
+4 ; CJ: Center text? 1=yes 0=1 <dflt=1>
+5 ; LM: Left Margin (padding)
+6 NEW X
+7 SET STR=$GET(STR)
+8 SET CJ=$GET(CJ,1)
+9 SET LM=$GET(LM)
+10 IF LM<0
SET LM=0
+11 IF CJ
SET STR=$$TRIM^XLFSTR($$CJ^XLFSTR(STR,$GET(IOM,80)),"R"," ")
+12 IF 'CJ
IF LM
SET X=""
SET $PIECE(X," ",LM)=" "
SET STR=X_STR
+13 DO MES^XPDUTL(STR)
+14 QUIT
+15 ;
+16 ;
FMERR(LAREF,MSG) ;
+1 ; Checks if a FileMan error occurred and displays help message
+2 ; and error text message.
+3 ; Input
+4 ; LAREF Name of array that has the FM DIERR subscripts
+5 ; ie FILE^DIE msg_root variable
+6 ; MSG <opt> Additional help text
+7 ; Output
+8 ; 1 if an error occurred, 0 if no error
+9 ; Also writes the messages to the device
+10 NEW LAERRMSG,OK,FMERR
+11 SET LAREF=$GET(LAREF)
+12 SET MSG=$GET(MSG)
+13 SET FMERR=0
+14 DO MSG^DIALOG("AE",.LAERRMSG,,,LAREF)
+15 ;
IF $DATA(LAERRMSG)
Begin DoDot:1
+16 IF MSG'=""
DO BMES(MSG)
+17 DO BMES(.LAERRMSG)
+18 SET FMERR=1
End DoDot:1
+19 QUIT FMERR
+20 ;
+21 ;
ENV2 ;
+1 ; Secondary Environment checks
+2 NEW X,I
+3 ; check and shutdown Auto Download job.
+4 SET X=$GET(^LA("ADL","STOP"))
+5 ;
IF $PIECE(X,"^")=0
Begin DoDot:1
+6 DO SETSTOP^LA7ADL1(2,DUZ)
+7 DO BMES("Shutting down Lab Universal Interface Auto Download Job")
+8 SET ^TMP($$RTNNM(),$JOB,"ADL")=1
+9 FOR I=1:1:10
WRITE "."
HANG 1
End DoDot:1
+10 ;
+11 ;
+12 ; If previously installed then save current ACTIVE LA7UI* entries.
+13 KILL ^TMP("LA66",$JOB,"62.48")
+14 SET I=0
+15 FOR
SET I=$ORDER(^LAHM(62.48,I))
if 'I
QUIT
IF $EXTRACT($PIECE(^LAHM(62.48,I,0),"^"),1,5)="LA7UI"
IF $PIECE(^LAHM(62.48,I,0),"^",3)=1
SET ^TMP("LA66",$JOB,"62.48",I)=1
+16 QUIT
+17 ;
+18 ;
RESTORE ;
+1 ; Restore system after install
+2 NEW LAADL,X
+3 ; Restart auto download process status if stopped by install
+4 SET LAADL=$GET(^TMP($$RTNNM(),$JOB,"ADL"))
+5 ;
IF LAADL=1
Begin DoDot:1
+6 DO ZTSK^LA7ADL
+7 DO SETSTOP^LA7ADL1(1,DUZ)
+8 DO BMES("Restarting Lab Universal Interface Auto Download Job")
+9 KILL ^TMP($$RTNNM(),$JOB,"ADL")
+10 HANG 3
End DoDot:1
+11 ;
+12 ; If ADL not started, notify user to restart
+13 SET X=$GET(^LA("ADL","STOP"))
+14 SET X=$PIECE(X,"^")
+15 IF X'=0
DO BMES("Be sure to restart the Lab Universal Interface Auto Download Job")
+16 KILL ^TMP($$RTNNM(),$JOB)
+17 QUIT
+18 ;
+19 ;
ALERT(MSG,RECIPS) ;
+1 NEW DA,DIK,XQA,XQAMSG
+2 SET XQAMSG=$GET(MSG)
+3 SET XQA("G.LMI")=""
+4 IF $DATA(RECIPS)
MERGE XQA=RECIPS
+5 DO SETUP^XQALERT
+6 QUIT
+7 ;
+8 ;
RTNNM() ;
+1 QUIT $TEXT(+0)