LRARIPOS ;DALISC/CKA - LRAR POST INIT UPDATE MENU OPTIONS
;;5.2;LAB SERVICE;**59**;July 31, 1995
EN ;
W !!,">>> Deleting OLD 'LAB' ARCHIVING options in OPTION file.",!
19 F LRARI=1:1 S LROPT=$P($T(OPTIONS+LRARI),";;",2) Q:LROPT="" I LROPT'="" D DO1
DIPT ;
W !! K DA,DIK S LRI="",DIK="^DIPT(" S LRI="LR ARCHIVE EXTRACT " F LRARI=65,67.9,64.1 S LRIN=LRI_LRARI D
.S DA=$$FIND1^DIC(.4,"","",LRIN,"B") I DA W !?15,"Removing Print template ",?35,LRIN D ^DIK
LR W !!,"Linking LRAR ARCHIVE MAIN MENU option to LRLIAISON ..."
S LRAROPT="LRAR ARCHIVE MAIN MENU",LROPTION="LRLIAISON"
S LROPTN=$O(^DIC(19,"B",LROPTION,0))
I 'LROPTN D QUIT
. W !!?5,"Option ",LROPTION," is missing from your option file."
. W !?5,"Couldn't attach option called ",LRAROPT,"."
S LRAROPTN=$O(^DIC(19,"B",LRAROPT,0))
I 'LRAROPTN D QUIT
. W !!?5,"Option ",LRAROPT," is missing from your option file."
. W !?5,"Couldn't attach to option ",LROPTION,"."
I $D(^DIC(19,LROPTN,10,"B",LRAROPTN)) D QUIT
. W !!?5,"Option ",LRAROPT," is already attached to ",LROPTION,"."
K DIC,DA
S DA(1)=LROPTN
S DIC="^DIC(19,"_DA(1)_",10,"
S DIC(0)="L"
S X=LRAROPTN
D FILE^DICN
K D0,D1,DIC
I +Y<1 D G QUIT
. W !!?5,"Couldn't add option ",LRAROPT," to ",LROPTION,"."
W !!?5,"Added option ",LRAROPT," to ",LROPTION,"."
W !!!,"Installation of patch LR*5.2*59 completed."
QUIT K D0,D1,DA,DIC,DIK,I,LRARI,LRAROPT,LRAROPTN,LRI,LRIN,LRM,LRNOPT,LROPT,LROPTION,LROPTN,LRS,X,Y Q
DO1 W !!?5,LROPT,!?5 F I=1:1:$L(LROPT) W "-"
S LRNOPT=$O(^DIC(19,"B",LROPT,0))
I 'LRNOPT W !?5,"DOES NOT EXIST IN THE 'OPTION' FILE...NOTHING DELETED!" Q
DO2 I $O(^DIC(19,"AD",LRNOPT,0))'>0 W !?5,"NOT ATTACHED TO ANY MENUS AS AN ITEM...NOTHING TO REPOINT OR DELETE!" G DO3
S LRM=0 F S LRM=$O(^DIC(19,"AD",LRNOPT,LRM)) Q:LRM'>0 S LRS=0 F S LRS=$O(^DIC(19,"AD",LRNOPT,LRM,LRS)) Q:LRS'>0 D DO4
DO3 S DA(1)=19,DA=LRNOPT,DIK="^DIC(19," D ^DIK W !?5,"'",LROPT,"' REMOVED from OPTION file..." Q
DO4 Q:'$D(^DIC(19,+LRM,0))#2 W !?5,"REMOVED from '",$P(^DIC(19,+LRM,0),"^",1),"' menu..." S DIK="^DIC(19,"_LRM_",10,",DA(2)=19,DA(1)=LRM,DA=LRS D ^DIK K DIK,DA
Q
OPTIONS ;
;;LR ARCHIVE CLEAR
;;LR ARCHIVE DATA
;;LR ARCHIVE MENU
;;LR ARCHIVE NP CONVERSION
;;LR ARCHIVE PURGE
;;LR ARCHIVE READ MEDIA
;;LR ARCHIVE RESTORE
;;LR ARCHIVE SEARCH
;;LR ARCHIVE WRITE MEDIA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARIPOS 2361 printed Nov 22, 2024@17:19:30 Page 2
LRARIPOS ;DALISC/CKA - LRAR POST INIT UPDATE MENU OPTIONS
+1 ;;5.2;LAB SERVICE;**59**;July 31, 1995
EN ;
+1 WRITE !!,">>> Deleting OLD 'LAB' ARCHIVING options in OPTION file.",!
19 FOR LRARI=1:1
SET LROPT=$PIECE($TEXT(OPTIONS+LRARI),";;",2)
if LROPT=""
QUIT
IF LROPT'=""
DO DO1
DIPT ;
+1 WRITE !!
KILL DA,DIK
SET LRI=""
SET DIK="^DIPT("
SET LRI="LR ARCHIVE EXTRACT "
FOR LRARI=65,67.9,64.1
SET LRIN=LRI_LRARI
Begin DoDot:1
+2 SET DA=$$FIND1^DIC(.4,"","",LRIN,"B")
IF DA
WRITE !?15,"Removing Print template ",?35,LRIN
DO ^DIK
End DoDot:1
LR WRITE !!,"Linking LRAR ARCHIVE MAIN MENU option to LRLIAISON ..."
+1 SET LRAROPT="LRAR ARCHIVE MAIN MENU"
SET LROPTION="LRLIAISON"
+2 SET LROPTN=$ORDER(^DIC(19,"B",LROPTION,0))
+3 IF 'LROPTN
Begin DoDot:1
+4 WRITE !!?5,"Option ",LROPTION," is missing from your option file."
+5 WRITE !?5,"Couldn't attach option called ",LRAROPT,"."
End DoDot:1
QUIT
+6 SET LRAROPTN=$ORDER(^DIC(19,"B",LRAROPT,0))
+7 IF 'LRAROPTN
Begin DoDot:1
+8 WRITE !!?5,"Option ",LRAROPT," is missing from your option file."
+9 WRITE !?5,"Couldn't attach to option ",LROPTION,"."
End DoDot:1
QUIT
+10 IF $DATA(^DIC(19,LROPTN,10,"B",LRAROPTN))
Begin DoDot:1
+11 WRITE !!?5,"Option ",LRAROPT," is already attached to ",LROPTION,"."
End DoDot:1
QUIT
+12 KILL DIC,DA
+13 SET DA(1)=LROPTN
+14 SET DIC="^DIC(19,"_DA(1)_",10,"
+15 SET DIC(0)="L"
+16 SET X=LRAROPTN
+17 DO FILE^DICN
+18 KILL D0,D1,DIC
+19 IF +Y<1
Begin DoDot:1
+20 WRITE !!?5,"Couldn't add option ",LRAROPT," to ",LROPTION,"."
End DoDot:1
GOTO QUIT
+21 WRITE !!?5,"Added option ",LRAROPT," to ",LROPTION,"."
+22 WRITE !!!,"Installation of patch LR*5.2*59 completed."
QUIT KILL D0,D1,DA,DIC,DIK,I,LRARI,LRAROPT,LRAROPTN,LRI,LRIN,LRM,LRNOPT,LROPT,LROPTION,LROPTN,LRS,X,Y
QUIT
DO1 WRITE !!?5,LROPT,!?5
FOR I=1:1:$LENGTH(LROPT)
WRITE "-"
+1 SET LRNOPT=$ORDER(^DIC(19,"B",LROPT,0))
+2 IF 'LRNOPT
WRITE !?5,"DOES NOT EXIST IN THE 'OPTION' FILE...NOTHING DELETED!"
QUIT
DO2 IF $ORDER(^DIC(19,"AD",LRNOPT,0))'>0
WRITE !?5,"NOT ATTACHED TO ANY MENUS AS AN ITEM...NOTHING TO REPOINT OR DELETE!"
GOTO DO3
+1 SET LRM=0
FOR
SET LRM=$ORDER(^DIC(19,"AD",LRNOPT,LRM))
if LRM'>0
QUIT
SET LRS=0
FOR
SET LRS=$ORDER(^DIC(19,"AD",LRNOPT,LRM,LRS))
if LRS'>0
QUIT
DO DO4
DO3 SET DA(1)=19
SET DA=LRNOPT
SET DIK="^DIC(19,"
DO ^DIK
WRITE !?5,"'",LROPT,"' REMOVED from OPTION file..."
QUIT
DO4 if '$DATA(^DIC(19,+LRM,0))#2
QUIT
WRITE !?5,"REMOVED from '",$PIECE(^DIC(19,+LRM,0),"^",1),"' menu..."
SET DIK="^DIC(19,"_LRM_",10,"
SET DA(2)=19
SET DA(1)=LRM
SET DA=LRS
DO ^DIK
KILL DIK,DA
+1 QUIT
OPTIONS ;
+1 ;;LR ARCHIVE CLEAR
+2 ;;LR ARCHIVE DATA
+3 ;;LR ARCHIVE MENU
+4 ;;LR ARCHIVE NP CONVERSION
+5 ;;LR ARCHIVE PURGE
+6 ;;LR ARCHIVE READ MEDIA
+7 ;;LR ARCHIVE RESTORE
+8 ;;LR ARCHIVE SEARCH
+9 ;;LR ARCHIVE WRITE MEDIA
