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

LA68.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to PROTOCOL file (#101) supported by ICR #872
  1.  ;
  1. EN ; Does not prevent loading of the transport global.
  1.  ; Environment check is done only during the install.
  1.  ; 
  1.  N XQA,XQAMSG
  1.  ;
  1.  I '$G(XPDENV) D  Q
  1.  . S XQAMSG="Transport global for patch "_$G(XPDNM,"Unknown patch")_" loaded on "_$$HTE^XLFDT($H),XQA("G.LMI")=""
  1.  . ; D SETUP^XQALERT
  1.  . ; D BMES^XPDUTL($$CJ^XLFSTR("Sending transport global loaded alert to mail group G.LMI",80))
  1.  . ; D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
  1.  ;
  1.  S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" started on "_$$HTE^XLFDT($H)
  1.  S XQA("G.LMI")=""
  1.  ; D SETUP^XQALERT
  1.  ; D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
  1.  ;
  1.  D CHECK
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1. CHECK ; Perform environment check
  1.  I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D  Q
  1.  . ; D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",80))
  1.  . ; S XPDQUIT=2
  1.  . D SORRY^BLRPRE31("LA*5.2*68","Terminal Device is not defined.")
  1.  ;
  1.  I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D  Q
  1.  . ; D BMES^XPDUTL($$CJ^XLFSTR("Please log in to set local DUZ... variables",80))
  1.  . ; S XPDQUIT=2
  1.  . D SORRY^BLRPRE31("LA*5.2*68","DUZ not Defined.")
  1.  ;
  1.  I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D  Q
  1.  . ; D BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80))
  1.  . ; S XPDQUIT=2
  1.  . D SORRY^BLRPRE31("LA*5.2*68","DUZ "_DUZ_" not a valid user on this system.","FATAL","$$ACTIVE^XUSER(DUZ)="_$$ACTIVE^XUSER(DUZ))
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. EXIT ;
  1.  I $G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("--- Install Environment Check FAILED ---",80))
  1.  ; I '$G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. PRE ; KIDS Pre install for LA*5.2*68
  1.  NEW BLRVERN
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  ;
  1.  ; Save status of existing LA7HDR interface in #62.48 and #101
  1.  S LA7HDR=$O(^LAHM(62.48,"B","LA7HDR",0))
  1.  I LA7HDR S LA7HDR(0)=$G(^LAHM(62.48,LA7HDR,0))
  1.  ;
  1.  S LA7101=$O(^ORD(101,"B","LA7 LAB RESULTS TO HDR (SUB)",0))
  1.  I LA7101 S LA7101(774)=$$GET1^DIQ(101,LA7101_",",774)
  1.  ;
  1.  Q
  1.  ; D BMES^XPDUTL($$CJ^XLFSTR("Sending install started alert to mail group G.LMI",80))
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_BLRVERN_" Pre install started ***",80))
  1.  D BMES^XPDUTL($$CJ^XLFSTR("--- No action required---",80))
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_BLRVERN_" Pre install completed ***",80))
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. POST ; KIDS Post install for LA*5.2*68
  1.  N DA,DIC,DIK,DLAYGO,LA7200,LA7DIE,LA7FAC,LA7FDA,LA7UPD,LA7X,LA7Y,X,Y,XQA,XQAMSG
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_$G(XPDNM,"Unknown patch")_" Post install started ***",80))
  1.  ;
  1.  ; Update flag.
  1.  S LA7UPD=0
  1.  ;
  1.  ; Restore status of LA7HDR entry in #62.48 if pre-existing and active.
  1.  I LA7HDR,$P($G(LA7HDR(0)),"^",3)=1 S $P(^LAHM(62.48,LA7HDR,0),"^",3)=1
  1.  ;
  1.  ; Restore status of Lab HDR subscriber protocol entry in #101 if pre-existing and active.
  1.  I LA7101,$G(LA7101(774))'="",$E(LA7101(774),1)'=";" D
  1.  . D BMES^XPDUTL($$CJ^XLFSTR("*** Restoring protocol LA7 LAB RESULTS TO HDR (SUB) Routing Logic field (#774) ***",80))
  1.  . S LA7FDA(1,101,LA7101_",",774)=LA7101(774)
  1.  . D FILE^DIE("","LA7FDA(1)","LA7DIE(1)")
  1.  . D BMES^XPDUTL($$CJ^XLFSTR("*** Protocol restore completed ***",80))
  1.  . S LA7UPD=1
  1.  ;
  1.  ; Removing facility station number in FACILITY NAME field in file #771.
  1.  S LA7FAC=$$FIND1^DIC(771,"","OX","LA7LAB","B","")
  1.  I LA7FAC>0 D
  1.  . D BMES^XPDUTL($$CJ^XLFSTR("*** Clearing facility name for LA7LAB entry in file #771 ***",80))
  1.  . S LA7FDA(2,771,LA7FAC_",",3)="@"
  1.  . D FILE^DIE("","LA7FDA(2)","LA7DIE(2)")
  1.  . D BMES^XPDUTL($$CJ^XLFSTR("*** Clearing facility name completed ***",80))
  1.  . S LA7UPD=1
  1.  ;
  1.  D TURNOFF  ; IHS Post Install Change
  1.  ;
  1.  I LA7UPD=0 D BMES^XPDUTL($$CJ^XLFSTR("--- No actions required for post install ---",80))
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Patch "_$G(XPDNM,"Unknown patch")_" Post install completed ***",80))
  1.  ;
  1.  ; D BMES^XPDUTL($$CJ^XLFSTR("Sending install completion alert to mail group G.LMI",80))
  1.  S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)
  1.  S XQA("G.LMI")=""
  1.  ; D SETUP^XQALERT
  1.  ;
  1.  D TURNOFF
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR(XQAMSG,80))
  1.  ;
  1.  K LA7101,LA7HDR
  1.  Q
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1. TURNOFF ; EP - LA7HDR entry in file 62.48 set to INACTIVE
  1.  NEW ERRS,FDA,IEN
  1.  ;
  1.  Q    ; MU2 Quit for now
  1.  ; 
  1.  S IEN=+$$FIND1^DIC(62.48,,,"LA7HDR")
  1.  Q:IEN<1      ; Skip if LA7HDR parameter does not exist
  1.  ;
  1.  D BMES^XPDUTL("Inactivating 'LA7HDR' parameter in 62.48.")
  1.  ;
  1.  D ^XBFMK
  1.  K FDA
  1.  S FDA(62.48,IEN_",",2)=0         ; Setting STATUS field to INACTIVE
  1.  D FILE^DIE("KS","FDA","ERRS")
  1.  ;
  1.  I $D(ERRS)<1 D  Q
  1.  . D BMES^XPDUTL("'LA7HDR' parameter in 62.48 Inactivated.")
  1.  . D MES^XPDUTL(" ")
  1.  ;
  1.  D BMES^XPDUTL("'LA7HDR' parameter in 62.48 *NOT* Inactivated.",5)
  1.  ;
  1.  Q
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033