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