LA68 ;DALOI/JMC - LA*5.2*68 PATCH ENVIRONMENT CHECK ROUTINE ;July 28, 2008
;;5.2;AUTOMATED LAB INSTRUMENTS;**68**;Sep 27, 1994;Build 56
;
; Reference to PROTOCOL file (#101) supported by ICR #872
;
EN ; Does not prevent loading of the transport global.
; Environment check is done only during the install.
;
N XQA,XQAMSG
;
I '$G(XPDENV) D Q
. S XQAMSG="Transport global for patch "_$G(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($H),XQA("G.LMI")=""
. D SETUP^XQALERT
. D BMES^XPDUTL($$CJ^XLFSTR("Sending transport global loaded alert to mail group G.LMI",80))
;
S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H)
S XQA("G.LMI")=""
D SETUP^XQALERT
;
D CHECK
D EXIT
Q
;
;
CHECK ; Perform environment check
I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D Q
. D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))
. S XPDQUIT=2
;
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D Q
. D BMES^XPDUTL($$CJ^XLFSTR("Please log in to set local DUZ... variables",80))
. S XPDQUIT=2
;
I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D Q
. D BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80))
. S XPDQUIT=2
;
Q
;
;
EXIT ;
I $G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))
I '$G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))
Q
;
;
;
PRE ; KIDS Pre install for LA*5.2*68
;
; Save status of existing LA7HDR interface in #62.48 and #101
S LA7HDR=$O(^LAHM(62.48,"B","LA7HDR",0))
I LA7HDR S LA7HDR(0)=$G(^LAHM(62.48,LA7HDR,0))
;
S LA7101=$O(^ORD(101,"B","LA7 LAB RESULTS TO HDR (SUB)",0))
I LA7101 S LA7101(774)=$$GET1^DIQ(101,LA7101_",",774)
;
D BMES^XPDUTL($$CJ^XLFSTR("Sending install started alert to mail group G.LMI",80))
D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install started ***",80))
D BMES^XPDUTL($$CJ^XLFSTR("--- No action required---",80))
D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install completed ***",80))
;
Q
;
;
POST ; KIDS Post install for LA*5.2*68
N DA,DIC,DIK,DLAYGO,LA7200,LA7DIE,LA7FAC,LA7FDA,LA7UPD,LA7X,LA7Y,X,Y,XQA,XQAMSG
;
D BMES^XPDUTL($$CJ^XLFSTR("*** Post install started ***",80))
;
; Update flag.
S LA7UPD=0
;
; Restore status of LA7HDR entry in #62.48 if pre-existing and active.
I LA7HDR,$P($G(LA7HDR(0)),"^",3)=1 S $P(^LAHM(62.48,LA7HDR,0),"^",3)=1
;
; Restore status of Lab HDR subscriber protocol entry in #101 if pre-existing and active.
I LA7101,$G(LA7101(774))'="",$E(LA7101(774),1)'=";" D
. D BMES^XPDUTL($$CJ^XLFSTR("*** Restoring protocol LA7 LAB RESULTS TO HDR (SUB) Routing Logic field (#774) ***",80))
. S LA7FDA(1,101,LA7101_",",774)=LA7101(774)
. D FILE^DIE("","LA7FDA(1)","LA7DIE(1)")
. D BMES^XPDUTL($$CJ^XLFSTR("*** Protocol restore completed ***",80))
. S LA7UPD=1
;
; Removing facility station number in FACILITY NAME field in file #771.
S LA7FAC=$$FIND1^DIC(771,"","OX","LA7LAB","B","")
I LA7FAC>0 D
. D BMES^XPDUTL($$CJ^XLFSTR("*** Clearing facility name for LA7LAB entry in file #771 ***",80))
. S LA7FDA(2,771,LA7FAC_",",3)="@"
. D FILE^DIE("","LA7FDA(2)","LA7DIE(2)")
. D BMES^XPDUTL($$CJ^XLFSTR("*** Clearing facility name completed ***",80))
. S LA7UPD=1
;
I LA7UPD=0 D BMES^XPDUTL($$CJ^XLFSTR("--- No actions required for post install ---",80))
;
D BMES^XPDUTL($$CJ^XLFSTR("*** Post install completed ***",80))
;
D BMES^XPDUTL($$CJ^XLFSTR("Sending install completion alert to mail group G.LMI",80))
S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)
S XQA("G.LMI")=""
D SETUP^XQALERT
;
K LA7101,LA7HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA68 3709 printed Oct 16, 2024@17:39:44 Page 2
LA68 ;DALOI/JMC - LA*5.2*68 PATCH ENVIRONMENT CHECK ROUTINE ;July 28, 2008
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**68**;Sep 27, 1994;Build 56
+2 ;
+3 ; Reference to PROTOCOL file (#101) supported by ICR #872
+4 ;
EN ; Does not prevent loading of the transport global.
+1 ; Environment check is done only during the install.
+2 ;
+3 NEW XQA,XQAMSG
+4 ;
+5 IF '$GET(XPDENV)
Begin DoDot:1
+6 SET XQAMSG="Transport global for patch "_$GET(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($HOROLOG)
SET XQA("G.LMI")=""
+7 DO SETUP^XQALERT
+8 DO BMES^XPDUTL($$CJ^XLFSTR("Sending transport global loaded alert to mail group G.LMI",80))
End DoDot:1
QUIT
+9 ;
+10 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($HOROLOG)
+11 SET XQA("G.LMI")=""
+12 DO SETUP^XQALERT
+13 ;
+14 DO CHECK
+15 DO EXIT
+16 QUIT
+17 ;
+18 ;
CHECK ; Perform environment check
+1 IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
Begin DoDot:1
+2 DO BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))
+3 SET XPDQUIT=2
End DoDot:1
QUIT
+4 ;
+5 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
Begin DoDot:1
+6 DO BMES^XPDUTL($$CJ^XLFSTR("Please log in to set local DUZ... variables",80))
+7 SET XPDQUIT=2
End DoDot:1
QUIT
+8 ;
+9 IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
Begin DoDot:1
+10 DO BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80))
+11 SET XPDQUIT=2
End DoDot:1
QUIT
+12 ;
+13 QUIT
+14 ;
+15 ;
EXIT ;
+1 IF $GET(XPDQUIT)
DO BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))
+2 IF '$GET(XPDQUIT)
DO BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))
+3 QUIT
+4 ;
+5 ;
+6 ;
PRE ; KIDS Pre install for LA*5.2*68
+1 ;
+2 ; Save status of existing LA7HDR interface in #62.48 and #101
+3 SET LA7HDR=$ORDER(^LAHM(62.48,"B","LA7HDR",0))
+4 IF LA7HDR
SET LA7HDR(0)=$GET(^LAHM(62.48,LA7HDR,0))
+5 ;
+6 SET LA7101=$ORDER(^ORD(101,"B","LA7 LAB RESULTS TO HDR (SUB)",0))
+7 IF LA7101
SET LA7101(774)=$$GET1^DIQ(101,LA7101_",",774)
+8 ;
+9 DO BMES^XPDUTL($$CJ^XLFSTR("Sending install started alert to mail group G.LMI",80))
+10 DO BMES^XPDUTL($$CJ^XLFSTR("*** Pre install started ***",80))
+11 DO BMES^XPDUTL($$CJ^XLFSTR("--- No action required---",80))
+12 DO BMES^XPDUTL($$CJ^XLFSTR("*** Pre install completed ***",80))
+13 ;
+14 QUIT
+15 ;
+16 ;
POST ; KIDS Post install for LA*5.2*68
+1 NEW DA,DIC,DIK,DLAYGO,LA7200,LA7DIE,LA7FAC,LA7FDA,LA7UPD,LA7X,LA7Y,X,Y,XQA,XQAMSG
+2 ;
+3 DO BMES^XPDUTL($$CJ^XLFSTR("*** Post install started ***",80))
+4 ;
+5 ; Update flag.
+6 SET LA7UPD=0
+7 ;
+8 ; Restore status of LA7HDR entry in #62.48 if pre-existing and active.
+9 IF LA7HDR
IF $PIECE($GET(LA7HDR(0)),"^",3)=1
SET $PIECE(^LAHM(62.48,LA7HDR,0),"^",3)=1
+10 ;
+11 ; Restore status of Lab HDR subscriber protocol entry in #101 if pre-existing and active.
+12 IF LA7101
IF $GET(LA7101(774))'=""
IF $EXTRACT(LA7101(774),1)'=";"
Begin DoDot:1
+13 DO BMES^XPDUTL($$CJ^XLFSTR("*** Restoring protocol LA7 LAB RESULTS TO HDR (SUB) Routing Logic field (#774) ***",80))
+14 SET LA7FDA(1,101,LA7101_",",774)=LA7101(774)
+15 DO FILE^DIE("","LA7FDA(1)","LA7DIE(1)")
+16 DO BMES^XPDUTL($$CJ^XLFSTR("*** Protocol restore completed ***",80))
+17 SET LA7UPD=1
End DoDot:1
+18 ;
+19 ; Removing facility station number in FACILITY NAME field in file #771.
+20 SET LA7FAC=$$FIND1^DIC(771,"","OX","LA7LAB","B","")
+21 IF LA7FAC>0
Begin DoDot:1
+22 DO BMES^XPDUTL($$CJ^XLFSTR("*** Clearing facility name for LA7LAB entry in file #771 ***",80))
+23 SET LA7FDA(2,771,LA7FAC_",",3)="@"
+24 DO FILE^DIE("","LA7FDA(2)","LA7DIE(2)")
+25 DO BMES^XPDUTL($$CJ^XLFSTR("*** Clearing facility name completed ***",80))
+26 SET LA7UPD=1
End DoDot:1
+27 ;
+28 IF LA7UPD=0
DO BMES^XPDUTL($$CJ^XLFSTR("--- No actions required for post install ---",80))
+29 ;
+30 DO BMES^XPDUTL($$CJ^XLFSTR("*** Post install completed ***",80))
+31 ;
+32 DO BMES^XPDUTL($$CJ^XLFSTR("Sending install completion alert to mail group G.LMI",80))
+33 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)
+34 SET XQA("G.LMI")=""
+35 DO SETUP^XQALERT
+36 ;
+37 KILL LA7101,LA7HDR
+38 QUIT