LR138P ;DALISC/FHS - LR*5.2*138 AFTER USER COMMITS ROUTINE KIDS INSTALL
;;5.2;LAB SERVICE;**138**;Sep 27, 1994
EN ;
Q:'$D(XPDNM)
;Removing Alpha site dds
K DIK,DA S DA(1)=63.04,DIK="^DD(63.04," F DA=.064,.065,.066,.067 D ^DIK
K DIK,DA S DA(1)=63.05,DIK="^DD(63.05," F DA=.064,.065,.066,.067 D ^DIK
K DIK,DA S DA(1)=68.02,DIK="^DD(68.02," F DA=95,96,97,98 D ^DIK
K DIK,DA
I $O(^LAB(64.81,0)) W !?5,"You still have unistalled data in LAB NLT/CPT CODES file ",!,$C(7)
S X="SCDXUAPI" X ^%ZOSF("TEST") I '$T D S XPDQUIT=2 Q
. W !!,$$CJ^XLFSTR("You must Load the SD*5.3*63 to add OOS clinic locations",80),!,$$CJ^XLFSTR("BEFORE YOU INSTALL THIS PATCH",80),!! S LRSDCX=1
S LRPKG=$O(^DIC(9.4,"B","LR",0))
I 'LRPKG S LRPKG=$O(^DIC(9.4,"B","LAB SERVICE",0))
I 'LRPKG W !!?10,"Not able to find 'LAB SERVICE' in your Package (#9.4) file.",!,"Contact your IRM Service !!",!!,$C(7) H 5 S XPDQUIT=2 Q
K DA,DIK S DA(1)=64,DA=14,DIK="^DD(64," D ^DIK K DA,DIK
W !!,$$CJ^XLFSTR("LOCKING THE ^LRO(69,AA) GLOBAL",80),!
L +LRO(69,"AA"):10 I '$T W !!?5,"Not able to LOCK ^LRO(69,AA) Global" S XPDQUIT=2 Q
W !,$$CJ^XLFSTR("Pre Install Step Complete",80),!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR138P 1174 printed Nov 22, 2024@17:13:19 Page 2
LR138P ;DALISC/FHS - LR*5.2*138 AFTER USER COMMITS ROUTINE KIDS INSTALL
+1 ;;5.2;LAB SERVICE;**138**;Sep 27, 1994
EN ;
+1 if '$DATA(XPDNM)
QUIT
+2 ;Removing Alpha site dds
+3 KILL DIK,DA
SET DA(1)=63.04
SET DIK="^DD(63.04,"
FOR DA=.064,.065,.066,.067
DO ^DIK
+4 KILL DIK,DA
SET DA(1)=63.05
SET DIK="^DD(63.05,"
FOR DA=.064,.065,.066,.067
DO ^DIK
+5 KILL DIK,DA
SET DA(1)=68.02
SET DIK="^DD(68.02,"
FOR DA=95,96,97,98
DO ^DIK
+6 KILL DIK,DA
+7 IF $ORDER(^LAB(64.81,0))
WRITE !?5,"You still have unistalled data in LAB NLT/CPT CODES file ",!,$CHAR(7)
+8 SET X="SCDXUAPI"
XECUTE ^%ZOSF("TEST")
IF '$TEST
Begin DoDot:1
+9 WRITE !!,$$CJ^XLFSTR("You must Load the SD*5.3*63 to add OOS clinic locations",80),!,$$CJ^XLFSTR("BEFORE YOU INSTALL THIS PATCH",80),!!
SET LRSDCX=1
End DoDot:1
SET XPDQUIT=2
QUIT
+10 SET LRPKG=$ORDER(^DIC(9.4,"B","LR",0))
+11 IF 'LRPKG
SET LRPKG=$ORDER(^DIC(9.4,"B","LAB SERVICE",0))
+12 IF 'LRPKG
WRITE !!?10,"Not able to find 'LAB SERVICE' in your Package (#9.4) file.",!,"Contact your IRM Service !!",!!,$CHAR(7)
HANG 5
SET XPDQUIT=2
QUIT
+13 KILL DA,DIK
SET DA(1)=64
SET DA=14
SET DIK="^DD(64,"
DO ^DIK
KILL DA,DIK
+14 WRITE !!,$$CJ^XLFSTR("LOCKING THE ^LRO(69,AA) GLOBAL",80),!
+15 LOCK +LRO(69,"AA"):10
IF '$TEST
WRITE !!?5,"Not able to LOCK ^LRO(69,AA) Global"
SET XPDQUIT=2
QUIT
+16 WRITE !,$$CJ^XLFSTR("Pre Install Step Complete",80),!!
+17 QUIT
