LR278 ;DALOI/FHS - LR*5.2*278 PATCH ENVIRONMENT CHECK ROUTINE;16 -SEP-2001
;;5.2;LAB SERVICE;**278**;Sep 27,1994
EN ; Does not prevent loading of the transport global.
;Environment check is done only during the install.
Q:'$D(XPDENV)
N VER,RN,LN2
D BMES^XPDUTL($$CJ^XLFSTR("*** Environment check started ***",80))
D CHECK
EXIT I $G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("Install Environment Check FAILED",IOM))
I '$G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("Environment Check is Ok ---",IOM))
Q
CHECK I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",IOM)) S XPDQUIT=2
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D BMES^XPDUTL($$CJ^XLFSTR("Please Log in to set local DUZ... variables",80)) S XPDQUIT=2
I '$$ACTIVE^XUSER($G(DUZ)) D BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80)) S XPDQUIT=2
S VER=$$VERSION^XPDUTL("LR")
I VER'>5.1 D BMES^XPDUTL($$CJ^XLFSTR("You must have LAB V5.2 Installed",IOM)) S XPDQUIT=2
S VER=$$VERSION^XPDUTL("NLT")
I VER'=5.254 D BMES^XPDUTL($$CJ^XLFSTR("You must have NLT V5.254 Installed",IOM)) S XPDQUIT=2
Q
PRE ;Pre-install entry point
Q:'$D(XPDNM)
N DA,DIC,DIK,LROK,X,Y
D BMES^XPDUTL($$CJ^XLFSTR("Removing the data dictionary for WKLD METHOD #.14 ",IOM))
D BMES^XPDUTL($$CJ^XLFSTR("From LOAD/WORK LIST file (68.2) ",IOM))
S DIK="^DD(68.2,",DA(1)=68.2,DA=.14 D ^DIK K DIK,DA
K ^LAM("AL")
D BMES^XPDUTL($$CJ^XLFSTR("Done - Install will replace the field ",IOM))
S DIK="^DD(62.06,",DA=64,DA(1)=62.06 D ^DIK K DIK,DA
S DA(1)=$$LKOPT^XPDMENU("LR7O 60-64")
I DA(1)>0 D K DA
. D BMES^XPDUTL($$CJ^XLFSTR("Removing routine from [LR7O 60-64] Menu",IOM))
. N DIK
. S DA=25,DA(2)=19
. S DIK="^DIC(19,"_DA(1)_"," D ^DIK
S LROK=$$DELETE^XPDMENU("LRLOINC","LR LOINC MAP ANTIMICROBIAL")
D
. N DA,DIK
. S DA=$$LKOPT^XPDMENU("LR LOINC MAP ANTIMICROBIAL")
. Q:DA<1 S DIK="^DIC(19," D ^DIK
Q
POST ;Do reindexing 64.02 field #3
D BMES^XPDUTL($$CJ^XLFSTR("Reindexing 64.02 field #3",IOM))
S:$D(^LAM(0))#2 $P(^(0),U,3)=99999
W !
N LRIEN,LRSPEC,LRASPECT,DIK,DA,LRDA,X,Y
S LRIEN=0
F S LRIEN=$O(^LAM(LRIEN)) Q:LRIEN<1 D
. S LRSPEC=0 F S LRSPEC=$O(^LAM(LRIEN,5,LRSPEC)) Q:LRSPEC<1 D
. . S LRDA=0 F S LRDA=$O(^LAM(LRIEN,5,LRSPEC,1,LRDA)) Q:LRDA<1 D SET
D
. S LRIEN=0 F S LRIEN=+$O(^LAB(60,LRIEN)) Q:LRIEN<1 I $D(^(LRIEN,0))#2 D
. . N DIK,DA
. . S DA=LRIEN,DIK="^LAB(60,",DIK(1)=".01^B"
. . D EN1^DIK
Q
SET ;Set X-Ref on 64.02,3 [^LAM("AL",LAB TEST,WKLD CODE,SPECIMEN,TIME ASPECT)]
K DIK,DA
S DA=LRDA,DA(1)=LRSPEC,DA(2)=LRIEN
S DIK="^LAM("_DA(2)_",5,"_DA(1)_",1,"
S DIK(1)="3^AL"
D ENALL^DIK
W "# "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR278 2705 printed Sep 23, 2025@19:39:14 Page 2
LR278 ;DALOI/FHS - LR*5.2*278 PATCH ENVIRONMENT CHECK ROUTINE;16 -SEP-2001
+1 ;;5.2;LAB SERVICE;**278**;Sep 27,1994
EN ; Does not prevent loading of the transport global.
+1 ;Environment check is done only during the install.
+2 if '$DATA(XPDENV)
QUIT
+3 NEW VER,RN,LN2
+4 DO BMES^XPDUTL($$CJ^XLFSTR("*** Environment check started ***",80))
+5 DO CHECK
EXIT IF $GET(XPDQUIT)
DO BMES^XPDUTL($$CJ^XLFSTR("Install Environment Check FAILED",IOM))
+1 IF '$GET(XPDQUIT)
DO BMES^XPDUTL($$CJ^XLFSTR("Environment Check is Ok ---",IOM))
+2 QUIT
CHECK IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
DO BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",IOM))
SET XPDQUIT=2
+1 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
DO BMES^XPDUTL($$CJ^XLFSTR("Please Log in to set local DUZ... variables",80))
SET XPDQUIT=2
+2 IF '$$ACTIVE^XUSER($GET(DUZ))
DO BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80))
SET XPDQUIT=2
+3 SET VER=$$VERSION^XPDUTL("LR")
+4 IF VER'>5.1
DO BMES^XPDUTL($$CJ^XLFSTR("You must have LAB V5.2 Installed",IOM))
SET XPDQUIT=2
+5 SET VER=$$VERSION^XPDUTL("NLT")
+6 IF VER'=5.254
DO BMES^XPDUTL($$CJ^XLFSTR("You must have NLT V5.254 Installed",IOM))
SET XPDQUIT=2
+7 QUIT
PRE ;Pre-install entry point
+1 if '$DATA(XPDNM)
QUIT
+2 NEW DA,DIC,DIK,LROK,X,Y
+3 DO BMES^XPDUTL($$CJ^XLFSTR("Removing the data dictionary for WKLD METHOD #.14 ",IOM))
+4 DO BMES^XPDUTL($$CJ^XLFSTR("From LOAD/WORK LIST file (68.2) ",IOM))
+5 SET DIK="^DD(68.2,"
SET DA(1)=68.2
SET DA=.14
DO ^DIK
KILL DIK,DA
+6 KILL ^LAM("AL")
+7 DO BMES^XPDUTL($$CJ^XLFSTR("Done - Install will replace the field ",IOM))
+8 SET DIK="^DD(62.06,"
SET DA=64
SET DA(1)=62.06
DO ^DIK
KILL DIK,DA
+9 SET DA(1)=$$LKOPT^XPDMENU("LR7O 60-64")
+10 IF DA(1)>0
Begin DoDot:1
+11 DO BMES^XPDUTL($$CJ^XLFSTR("Removing routine from [LR7O 60-64] Menu",IOM))
+12 NEW DIK
+13 SET DA=25
SET DA(2)=19
+14 SET DIK="^DIC(19,"_DA(1)_","
DO ^DIK
End DoDot:1
KILL DA
+15 SET LROK=$$DELETE^XPDMENU("LRLOINC","LR LOINC MAP ANTIMICROBIAL")
+16 Begin DoDot:1
+17 NEW DA,DIK
+18 SET DA=$$LKOPT^XPDMENU("LR LOINC MAP ANTIMICROBIAL")
+19 if DA<1
QUIT
SET DIK="^DIC(19,"
DO ^DIK
End DoDot:1
+20 QUIT
POST ;Do reindexing 64.02 field #3
+1 DO BMES^XPDUTL($$CJ^XLFSTR("Reindexing 64.02 field #3",IOM))
+2 if $DATA(^LAM(0))#2
SET $PIECE(^(0),U,3)=99999
+3 WRITE !
+4 NEW LRIEN,LRSPEC,LRASPECT,DIK,DA,LRDA,X,Y
+5 SET LRIEN=0
+6 FOR
SET LRIEN=$ORDER(^LAM(LRIEN))
if LRIEN<1
QUIT
Begin DoDot:1
+7 SET LRSPEC=0
FOR
SET LRSPEC=$ORDER(^LAM(LRIEN,5,LRSPEC))
if LRSPEC<1
QUIT
Begin DoDot:2
+8 SET LRDA=0
FOR
SET LRDA=$ORDER(^LAM(LRIEN,5,LRSPEC,1,LRDA))
if LRDA<1
QUIT
DO SET
End DoDot:2
End DoDot:1
+9 Begin DoDot:1
+10 SET LRIEN=0
FOR
SET LRIEN=+$ORDER(^LAB(60,LRIEN))
if LRIEN<1
QUIT
IF $DATA(^(LRIEN,0))#2
Begin DoDot:2
+11 NEW DIK,DA
+12 SET DA=LRIEN
SET DIK="^LAB(60,"
SET DIK(1)=".01^B"
+13 DO EN1^DIK
End DoDot:2
End DoDot:1
+14 QUIT
SET ;Set X-Ref on 64.02,3 [^LAM("AL",LAB TEST,WKLD CODE,SPECIMEN,TIME ASPECT)]
+1 KILL DIK,DA
+2 SET DA=LRDA
SET DA(1)=LRSPEC
SET DA(2)=LRIEN
+3 SET DIK="^LAM("_DA(2)_",5,"_DA(1)_",1,"
+4 SET DIK(1)="3^AL"
+5 DO ENALL^DIK
+6 WRITE "# "
+7 QUIT
