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

LR302.m

Go to the documentation of this file. 
  1. LR302 ;DALOI/FHS - LR*5.2*302 PATCH ENVIRONMENT CHECK ROUTINE;31-AUG-2001
  1.  ;;5.2;LR;**302,1022**;September 20, 2007
  1.  ;
  1.  ; This VA Patch is being included as part of IHS Lab Patch 1022
  1.  ; 
  1. ENV ; Does not prevent loading of the transport global.
  1.  ; Environment check is done only during the install.
  1.  ;
  1.  N XQA,XQAMSG
  1.  ;
  1. CHKNM ; Make sure the patch name exist
  1.  I '$D(XPDNM) D  G EXIT
  1.  . D BMES("No valid patch name exist")
  1.  . S XPDQUIT=2
  1.  ;
  1.  D CHECK
  1.  D EXIT
  1.  Q
  1.  ;
  1. CHECK ; Perform environment check
  1.  I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D
  1.  . D BMES("Terminal Device is not defined")
  1.  . S XPDQUIT=2
  1.  I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D
  1.  . D BMES("Please log in to set local DUZ... variables")
  1.  . S XPDQUIT=2
  1.  I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D
  1.  . D BMES("You are not a valid user on this system")
  1.  . S XPDQUIT=2
  1.  S XPDIQ("XPZ1","B")="NO"
  1. DUP64 ;Check ^LAM for duplicate Names or NLT codes
  1.  D BMES("Checking WKLD CODE file (#64) for duplicate names or numbers.")
  1.  H 5
  1. DUP64P I $G(^XTMP("LRNLTD",0)) D DUPCHK Q
  1.  W !
  1.  N LRINS,LRDT,LRNLT
  1.  S ^XTMP("LRNLTD",0)=$$HTFM^XLFDT(($H+90),1)_U_DT_U_"LR302 64.1 NLT ENTRIES"
  1.  S LRINS=0 F  S LRINS=$O(^LRO(64.1,LRINS)) Q:LRINS<1  D
  1.  . W "."
  1.  . S LRDT=0 F  S LRDT=$O(^LRO(64.1,LRINS,1,LRDT)) Q:LRDT<1  D
  1.  . . S LRNLT=0  F  S LRNLT=$O(^LRO(64.1,LRINS,1,LRDT,1,"B",LRNLT)) Q:LRNLT<1  D
  1.  . . . S:'$D(^XTMP("LRNLTD",LRNLT)) ^(LRNLT)=""
  1. DUPCHK ;
  1.  N IEN,IENX,NAM,CNT,DUP,XREF,TEXT,DA,DIK
  1.  S:$G(LRPOST) DIK="^LAM("
  1.  F XREF="B","C" S (IEN,NAM,CNT)=0 D
  1.  . F  S NAM=$O(^LAM(XREF,NAM)) Q:NAM=""  D
  1.  . . K DUP S (CNT,IEN)=0 F  S IEN=$O(^LAM(XREF,NAM,IEN)) Q:IEN=""  I '$O(^(IEN,0)) D
  1.  . . . S CNT=CNT+1,DUP(CNT)=NAM_U_IEN
  1.  . . I CNT>1 S CNT=0 W ! F  S CNT=$O(DUP(CNT)) Q:CNT<1  D
  1.  . . . S IENX=$P(DUP(CNT),U,2)
  1.  . . . I $G(LRPOST),'$D(^XTMP("LRNLTD",IENX)) D  Q
  1.  . . . . S DA=IENX D ^DIK
  1.  . . . S TEXT=DUP(CNT)
  1.  . . . S TEXT=$S('$D(^XTMP("LRNLTD",IENX)):"+",XREF="B"&(TEXT'["~"):"*",$P($P(TEXT,U),".",2)="0000 ":"*",1:"")_TEXT
  1.  . . . D MES^XPDUTL(TEXT)
  1.  Q:$G(LRPOST)
  1.  D BMES("End of duplicate listing.")
  1.  D BMES("If '*' duplicates were listed they should be resolved before patch install.")
  1.  D BMES("Those '+' will be removed during the post install.")
  1.  H 5
  1.  Q
  1.  ;
  1. EXIT ;
  1.  N XQA
  1.  I $G(XPDQUIT) D BMES("--- Install Environment Check FAILED ---") Q
  1.  D BMES("--- Environment Check is Ok ---")
  1.  S XQAMSG="Loading of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)
  1.  D BMES("Sending install loaded alert to mail group G.LMI")
  1.  S XQA("G.LMI")=""
  1.  D SETUP^XQALERT,TEXT
  1.  H 5
  1.  Q
  1.  ;
  1. PRE ;Pre-install entry point
  1.  Q:'$D(XPDNM)
  1.  N LAST
  1.  D PTRSAV ;Save pointer information
  1.  ;Remove old data
  1.  N DIU,DIK,DA
  1.  S DIU="^LAB(64.81,",DIU(0)="DS" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(95.3,",DIU(0)="DS" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(95.31,",DIU(0)="DS" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(64.061,",DIU(0)="DS" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(64.2,",DIU(0)="DS" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(64.3,",DIU(0)="DS" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(64.062",DIU(0)="DS" D EN^DIU2
  1. DD D
  1.  . N DIK,DA
  1.  . S DIK="^DD(64,",DA(1)=64,DA=25 D ^DIK K DIK
  1.  . S DIK="^DD(64.02,",DA(1)=64.02,DA=4 D ^DIK
  1.  D BMES("*** Preinstall completed ***")
  1.  Q
  1. POST ;Post install repointing of historical data
  1.  D POST^LR302PO
  1.  D ^LR302P
  1.  D
  1.  . D BMES^LR302("Sending install completion alert to mail group G.LMI")
  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.  N LRPOST S LRPOST=1 D TEXT
  1.  Q
  1. PTRSAV ;Save pointer values into XTMP("LR302" to repointed after install
  1.  D BMES("** Saving Pointer Values **")
  1.  N LRPOST,LRIEN,LRIENSUB,LRPTR,LRDTLB,LRNODE,X,Y,ERR
  1.  S LRPOST=1 D DUP64P K LRPOST
  1.  S:$D(^LAM(0)) $P(^(0),U,3)=0
  1.  S Y=$$FIND1^DIC(64,"","","87971.0000","E","","ERR")
  1.  I Y D
  1.  . N IEN,VAL
  1.  . S IEN=+Y
  1.  . I $D(^LAM(IEN,0))#2,$P(^(0),U,7)=68 D
  1.  . . S VAL=$$FIND1^DIC(64.22,"","","TEST","B","","ERR")
  1.  . . I VAL S $P(^LAM(IEN,0),U,7)=+VAL
  1.  D ^LR302A
  1.  Q
  1. BMES(STR) ;EP - Write BMES^XPDUTL statements
  1.  D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
  1.  Q
  1. TEXT ; Alert the user that file #64 should not have any error before and after installing
  1.  N STR W !
  1.  S STR="Using VA FileMan menu ""UTILITY FUNCTIONS"", perform the option ""VERIFY FIELDS""," D BMES(STR)
  1.  S STR="MODIFY WHAT FILE: WKLD CODE" D BMES(STR)
  1.  S STR="VERIFY WHICH FIELD: ALL" D BMES(STR)
  1.  S STR="DO YOU MEAN ALL THE FIELDS IN THE FILE? YES" D BMES(STR)
  1.  I '$G(LRPOST) S STR="Ensure that this option runs CLEANLY before installation of this patch." D BMES(STR)
  1.  H 10
  1.  Q
  1. STAR ;
  1.  W $S(XREF="B"&(TEXT'["~"):"*",$P($P(TEXT,U),".",2)="0000 ":"*",1:"")_TEXT
  1.  Q