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

LR291.m

Go to the documentation of this file. 
  1. LR291 ;DAL/WTY - LR*5.2*291 PATCH ENVIRONMENT CHECK ROUTINE ;8/10/04
  1.  ;;5.2;LAB SERVICE;**291**;Sep 27, 1994
  1. EN ; Does not prevent loading of the transport global.
  1.  ; Environment check is done only during the install.
  1.  ;
  1.  I '$G(XPDENV) D  Q
  1.  .N XQA,XQAMSG
  1.  .S XQAMSG="Transport global for patch "_$G(XPDNM,"Unknown patch")
  1.  .S XQAMSG=XQAMSG_" loaded on "_$$HTE^XLFDT($H)
  1.  .S XQA("G.LMI")=""
  1.  .D SETUP^XQALERT
  1.  .S MSG="Sending transport global loaded alert to mail group G.LMI"
  1.  .D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  ;
  1.  D P68
  1.  D CHECK
  1.  D EXIT
  1.  Q
  1.  ;
  1. CHECK ; Perform environment check
  1.  ;
  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.  ;
  1.  I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D  Q
  1.  .S MSG="Please log in to set local DUZ... variables"
  1.  .D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  .S XPDQUIT=2
  1.  ;
  1.  I '$D(^VA(200,$G(DUZ),0))#2 D  Q
  1.  .S MSG="You are not a valid user on this system"
  1.  .D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  .S XPDQUIT=2
  1.  ;
  1.  S XPDDIQ("XPZ1")=0
  1.  ;
  1.  Q
  1.  ;
  1. EXIT ;
  1.  I $G(XPDQUIT) D
  1.  .S MSG="--- Install Environment Check FAILED ---"
  1.  .D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  I '$G(XPDQUIT) D
  1.  .D BMES^XPDUTL($$CJ^XLFSTR("--- Environment Check is Ok ---",80))
  1.  Q
  1.  ;
  1. PRE ; KIDS Pre install for LR*5.2*291
  1.  ;
  1.  N XQA,XQAMSG
  1.  S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")
  1.  S XQAMSG=XQAMSG_" started on "_$$HTE^XLFDT($H)
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT
  1.  ;
  1.  S MSG="Sending install started alert to mail group G.LMI"
  1.  D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install started ***",80))
  1.  ;
  1.  S Y=$$OPTDE^XPDUTL("LRMENU",2)
  1.  S MSG="Disabling Laboratory DHCP Menu [LRMENU] option"
  1.  D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Pre install completed ***",80))
  1.  ;
  1.  Q
  1.  ;
  1. POST ; KIDS Post install for LR*5.2*291
  1.  ;
  1.  N XQA,XQAMSG
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Post install started ***",80))
  1.  ;
  1.  K MSG
  1.  S MSG(1)=" "
  1.  S MSG(2)=" ************************ IMPORTANT ************************"
  1.  S MSG(3)=" * Please run option LAB TESTS AND PANELS REPORT           *"
  1.  S MSG(4)=" * [LRBE PANEL REPORT] to generate a listing of all tests  *"
  1.  S MSG(5)=" * in the LABORATORY TEST (#60) file and the associated    *"
  1.  S MSG(6)=" * CPT codes that will be sent to PCE for billing.  The    *"
  1.  S MSG(7)=" * report should be used by the coders to enter the proper *"
  1.  S MSG(8)=" * CPT codes in the LABORATORY TEST (#60) file. This option*"
  1.  S MSG(9)=" * is located in the Lab liaison [LRLIAISON] menu.         *"
  1.  S MSG(10)=" ***********************************************************"
  1.  D BMES^XPDUTL(.MSG) K MSG
  1.  ;
  1.  S Y=$$OPTDE^XPDUTL("LRMENU",1)
  1.  S MSG="Enabling Laboratory DHCP Menu [LRMENU] option"
  1.  D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Post install completed ***",80))
  1.  ;
  1.  S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")
  1.  S XQAMSG=XQAMSG_" completed on "_$$HTE^XLFDT($H)
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT
  1.  ;
  1.  S MSG="Sending install completion alert to mail group G.LMI"
  1.  D BMES^XPDUTL($$CJ^XLFSTR(MSG,80)) K MSG
  1.  ;
  1.  Q
  1. P68 ; Modify the RESPONIBLE OFFICAL in #68
  1.  N A,B,DIC,ENT,HD,QT,Y,USR
  1.  S QT=0
  1.  S A="" F  S A=$O(^LRO(68,"B",A)) Q:A=""!(QT)  D
  1.  .S B="" F  S B=$O(^LRO(68,"B",A,B)) Q:B=""!(QT)  D
  1.  ..I $P(^LRO(68,"B",A,B),"^",1)=1!('$D(^LRO(68,B))) Q
  1.  ..S HD="ACCESSION AREA: "_A D EN^DDIOL(HD,"","!")
  1.  ..S X=$$GET1^DIQ(68,B_",",".1","I")
  1.  ..S USR=$S($D(^VA(200,+X,0)):$P(^(0),"^"),1:X)
  1.  ..S ENT="  Old RESPONSIBLE OFFICIAL: "_USR D EN^DDIOL(ENT,"","!")
  1.  ..S DIC="^VA(200,",DIC("A")="  New RESPONSIBLE OFFICIAL: "
  1.  ..S DIC="^VA(200,",DIC("B")=USR,DIC(0)="AMEQZ" D ^DIC
  1.  ..I $D(DTOUT)!($D(DUOUT))!(+Y=-1) S QT=1 K DIC Q:QT
  1.  ..D SET(B,+Y)
  1.  Q
  1. SET(TIEN,RO) ; Set #68
  1.  N LRFDA,FIL,IEN
  1.  S FIL=68,IEN=TIEN_","
  1.  S LRFDA(99,FIL,IEN,.1)=RO
  1.  D UPDATE^DIE("","LRFDA(99)","","LRERR")
  1.  Q