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

LRARIPOS.m

Go to the documentation of this file.
LRARIPOS ; IHS/DIR/AAB - LRAR POST INIT UPDATE MENU OPTIONS ; [ 07/22/2002  1:06 PM ]
 ;;5.2;LR;**1002,1013**;JUL 15, 2002
 ;;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