LA68 ;VA/DALOI/JMC - LA*5.2*68 PATCH ENVIRONMENT CHECK ROUTINE ; 13-Aug-2013 09:09 ; MKK
;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 1, 1997
;
; 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))
. ; D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
;
S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H)
S XQA("G.LMI")=""
; D SETUP^XQALERT
; D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
;
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
. D SORRY^BLRPRE31("LA*5.2*68","Terminal Device is not defined.")
;
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
. D SORRY^BLRPRE31("LA*5.2*68","DUZ not Defined.")
;
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
. D SORRY^BLRPRE31("LA*5.2*68","DUZ "_DUZ_" not a valid user on this system.","FATAL","$$ACTIVE^XUSER(DUZ)="_$$ACTIVE^XUSER(DUZ))
;
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
NEW BLRVERN
S BLRVERN=$TR($P($T(+1),";")," ")
;
; 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)
;
Q
; D BMES^XPDUTL($$CJ^XLFSTR("Sending install started alert to mail group G.LMI",80))
D BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_BLRVERN_" Pre install started ***",80))
D BMES^XPDUTL($$CJ^XLFSTR("--- No action required---",80))
D BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_BLRVERN_" 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("*** Patch "_$G(XPDNM,"Unknown patch")_" 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
;
D TURNOFF ; IHS Post Install Change
;
I LA7UPD=0 D BMES^XPDUTL($$CJ^XLFSTR("--- No actions required for post install ---",80))
;
D BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_$G(XPDNM,"Unknown patch")_" 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
;
D TURNOFF
;
D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
;
K LA7101,LA7HDR
Q
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
TURNOFF ; EP - LA7HDR entry in file 62.48 set to INACTIVE
NEW ERRS,FDA,IEN
;
Q ; MU2 Quit for now
;
S IEN=+$$FIND1^DIC(62.48,,,"LA7HDR")
Q:IEN<1 ; Skip if LA7HDR parameter does not exist
;
D BMES^XPDUTL("Inactivating 'LA7HDR' parameter in 62.48.")
;
D ^XBFMK
K FDA
S FDA(62.48,IEN_",",2)=0 ; Setting STATUS field to INACTIVE
D FILE^DIE("KS","FDA","ERRS")
;
I $D(ERRS)<1 D Q
. D BMES^XPDUTL("'LA7HDR' parameter in 62.48 Inactivated.")
. D MES^XPDUTL(" ")
;
D BMES^XPDUTL("'LA7HDR' parameter in 62.48 *NOT* Inactivated.",5)
;
Q
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
LA68 ;VA/DALOI/JMC - LA*5.2*68 PATCH ENVIRONMENT CHECK ROUTINE ; 13-Aug-2013 09:09 ; MKK
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 1, 1997
+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 ; D SETUP^XQALERT
+8 ; D BMES^XPDUTL($$CJ^XLFSTR("Sending transport global loaded alert to mail group G.LMI",80))
+9 ; D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
End DoDot:1
QUIT
+10 ;
+11 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($HOROLOG)
+12 SET XQA("G.LMI")=""
+13 ; D SETUP^XQALERT
+14 ; D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
+15 ;
+16 DO CHECK
+17 DO EXIT
+18 QUIT
+19 ;
+20 ;
CHECK ; Perform environment check
+1 IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
Begin DoDot:1
+2 ; D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))
+3 ; S XPDQUIT=2
+4 DO SORRY^BLRPRE31("LA*5.2*68","Terminal Device is not defined.")
End DoDot:1
QUIT
+5 ;
+6 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
Begin DoDot:1
+7 ; D BMES^XPDUTL($$CJ^XLFSTR("Please log in to set local DUZ... variables",80))
+8 ; S XPDQUIT=2
+9 DO SORRY^BLRPRE31("LA*5.2*68","DUZ not Defined.")
End DoDot:1
QUIT
+10 ;
+11 IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
Begin DoDot:1
+12 ; D BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80))
+13 ; S XPDQUIT=2
+14 DO SORRY^BLRPRE31("LA*5.2*68","DUZ "_DUZ_" not a valid user on this system.","FATAL","$$ACTIVE^XUSER(DUZ)="_$$ACTIVE^XUSER(DUZ))
End DoDot:1
QUIT
+15 ;
+16 QUIT
+17 ;
+18 ;
EXIT ;
+1 IF $GET(XPDQUIT)
DO BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))
+2 ; I '$G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))
+3 QUIT
+4 ;
+5 ;
+6 ;
PRE ; KIDS Pre install for LA*5.2*68
+1 NEW BLRVERN
+2 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+3 ;
+4 ; Save status of existing LA7HDR interface in #62.48 and #101
+5 SET LA7HDR=$ORDER(^LAHM(62.48,"B","LA7HDR",0))
+6 IF LA7HDR
SET LA7HDR(0)=$GET(^LAHM(62.48,LA7HDR,0))
+7 ;
+8 SET LA7101=$ORDER(^ORD(101,"B","LA7 LAB RESULTS TO HDR (SUB)",0))
+9 IF LA7101
SET LA7101(774)=$$GET1^DIQ(101,LA7101_",",774)
+10 ;
+11 QUIT
+12 ; D BMES^XPDUTL($$CJ^XLFSTR("Sending install started alert to mail group G.LMI",80))
+13 DO BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_BLRVERN_" Pre install started ***",80))
+14 DO BMES^XPDUTL($$CJ^XLFSTR("--- No action required---",80))
+15 DO BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_BLRVERN_" Pre install completed ***",80))
+16 ;
+17 QUIT
+18 ;
+19 ;
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("*** Patch "_$GET(XPDNM,"Unknown patch")_" 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 ; IHS Post Install Change
DO TURNOFF
+29 ;
+30 IF LA7UPD=0
DO BMES^XPDUTL($$CJ^XLFSTR("--- No actions required for post install ---",80))
+31 ;
+32 DO BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_$GET(XPDNM,"Unknown patch")_" Post install completed ***",80))
+33 ;
+34 ; D BMES^XPDUTL($$CJ^XLFSTR("Sending install completion alert to mail group G.LMI",80))
+35 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)
+36 SET XQA("G.LMI")=""
+37 ; D SETUP^XQALERT
+38 ;
+39 DO TURNOFF
+40 ;
+41 DO BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
+42 ;
+43 KILL LA7101,LA7HDR
+44 QUIT
+45 ;
+46 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
TURNOFF ; EP - LA7HDR entry in file 62.48 set to INACTIVE
+1 NEW ERRS,FDA,IEN
+2 ;
+3 ; MU2 Quit for now
QUIT
+4 ;
+5 SET IEN=+$$FIND1^DIC(62.48,,,"LA7HDR")
+6 ; Skip if LA7HDR parameter does not exist
IF IEN<1
QUIT
+7 ;
+8 DO BMES^XPDUTL("Inactivating 'LA7HDR' parameter in 62.48.")
+9 ;
+10 DO ^XBFMK
+11 KILL FDA
+12 ; Setting STATUS field to INACTIVE
SET FDA(62.48,IEN_",",2)=0
+13 DO FILE^DIE("KS","FDA","ERRS")
+14 ;
+15 IF $DATA(ERRS)<1
Begin DoDot:1
+16 DO BMES^XPDUTL("'LA7HDR' parameter in 62.48 Inactivated.")
+17 DO MES^XPDUTL(" ")
End DoDot:1
QUIT
+18 ;
+19 DO BMES^XPDUTL("'LA7HDR' parameter in 62.48 *NOT* Inactivated.",5)
+20 ;
+21 QUIT
+22 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
