LRIPOS3 ;SLC/RWA/DALISC/JRR - LR POST INIT UPDATE MENU OPTIONS ;2/8/91 07:37 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
W !!,">>> Deleting/repointing 'LAB' options in OPTION file as necessary.",!
19 S LRI="" F S LRI=$O(^LAB(69.91,1,"DO","B",LRI)) Q:LRI="" S LRIFN=$O(^LAB(69.91,1,"DO","B",LRI,0)) I LRIFN,$D(^LAB(69.91,1,"DO",LRIFN,0)) S LRDEL=^(0) D DO1
DIE ;
K DA,DIK S LRI="",DIK="^DIE(" F S LRI=$O(^LAB(69.91,1,"EDIT","B",LRI)) Q:LRI="" D
.S DA=$O(^DIE("B",$E(LRI,1,30),0)) I DA W !?10,"Removing Edit template ",?30,LRI D ^DIK
DIPT ;
K DA,DIK S LRI="",DIK="^DIPT(" F S LRI=$O(^LAB(69.91,1,"PRT","B",LRI)) Q:LRI="" D
.S DA=$O(^DIPT("B",$E(LRI,1,30),0)) I DA W !?15,"Removing Print template ",?35,LRI D ^DIK
DIBT ;
K DA,DIK S LRI="",DIK="^DIBT(" F S LRI=$O(^LAB(69.91,1,"SORT","B",LRI)) Q:LRI="" D
.S DA=$O(^DIBT("B",$E(LRI,1,30),0)) I DA W !?20,"Removing Sort template ",?40,LRI D ^DIK
W !!,"Options - Edit,Print and Sort templates removal complete ",!
LA W !!,"Linking LA namespaced options to their appropriate LR parents..."
F LACNT=1:1 S LAOPT=$P($T(LAOPTION+LACNT),";",3) Q:LAOPT="" D
. S LAOPTION=$P(LAOPT,"^"),LROPTION=$P(LAOPT,"^",2)
. 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 ",LAOPTION,"."
. S LAOPTN=$O(^DIC(19,"B",LAOPTION,0))
. I 'LAOPTN D QUIT
. . W !!?5,"Option ",LAOPTION," is missing from your option file."
. . W !?5,"Couldn't attach to option ",LROPTION,"."
. I $D(^DIC(19,LROPTN,10,"B",LAOPTN)) D QUIT
. . W !!?5,"Option ",LAOPTION," 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=LAOPTN
. D FILE^DICN
. K D0,D1,DIC
. I +Y<1 D QUIT
. . W !!?5,"Couldn't add option ",LAOPTION," to ",LROPTION,"."
. W !!?5,"Added option ",LAOPTION," to ",LROPTION,"."
K DA,LRDEL,LRI,LRIFN,LRJ,LRM,LRNOPT,LROPT,LRREP,LRS,DIC,DIK,DINUM,I,X Q
DO1 W !!?5,LRI,!?5 F I=1:1:$L(LRI) W "-"
S LROPT=$O(^DIC(19,"B",$E(LRI,1,30),0)) I $S(LROPT'>0:1,'$D(^DIC(19,LROPT,0)):1,1:0) W !?5,"DOES NOT EXIST IN THE 'OPTION' FILE...NOTHING DELETED!" Q
S LRREP=$P(LRDEL,"^",3) G DO2:'LRREP S LRNOPT=$O(^DIC(19,"B",$E($P(LRDEL,"^",4),1,30),0))
I $S(LRNOPT'>0:1,'$D(^DIC(19,LRNOPT,0)):1,1:0) W !?5,"NEW OPTION (",$P(LRDEL,"^",3),") DOESN'T EXIST IN 'OPTION' FILE...NOTHING REPOINTED!" S LRREP=0
DO2 I $O(^DIC(19,"AD",LROPT,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",LROPT,LRM)) Q:LRM'>0 S LRS=0 F S LRS=$O(^DIC(19,"AD",LROPT,LRM,LRS)) Q:LRS'>0 D DO4
DO3 S DA(1)=19,DA=LROPT,DIK="^DIC(19," D ^DIK W !?5,"'",$P(LRDEL,"^",1),"' 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:'LRREP W !?10,"'",$P(LRDEL,"^",4),"' " I $D(^DIC(19,"AD",LRNOPT,LRM)) W "already EXISTS as an item on this menu..." Q
W "ADDED to menu as a NEW ITEM..." K DD,DO S DA(2)=19,DA(1)=LRM,X=LRNOPT,(DA,DINUM)=LRS,DIC="^DIC(19,"_LRM_",10,",DIC(0)="L",DLAYGO=19 D FILE^DICN K DD,DO,DA,DIC,DLAYGO Q
LAOPTION ;;
;;LA AP FICHE^LRLIAISON
;;LA DOWN^LR DO!
;;LA INTERFACE^LRSUPERVISOR
;;LA MI MENU^LRMI
;;LA JOB^LRLIAISON
;;LA DOWN^LA MI MENU
LRIPOS3 ;SLC/RWA/DALISC/JRR - LR POST INIT UPDATE MENU OPTIONS ;2/8/91 07:37 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
+1 WRITE !!,">>> Deleting/repointing 'LAB' options in OPTION file as necessary.",!
19 SET LRI=""
FOR
SET LRI=$ORDER(^LAB(69.91,1,"DO","B",LRI))
IF LRI=""
QUIT
SET LRIFN=$ORDER(^LAB(69.91,1,"DO","B",LRI,0))
IF LRIFN
IF $DATA(^LAB(69.91,1,"DO",LRIFN,0))
SET LRDEL=^(0)
DO DO1
DIE ;
+1 KILL DA,DIK
SET LRI=""
SET DIK="^DIE("
FOR
SET LRI=$ORDER(^LAB(69.91,1,"EDIT","B",LRI))
IF LRI=""
QUIT
Begin DoDot:1
+2 SET DA=$ORDER(^DIE("B",$EXTRACT(LRI,1,30),0))
IF DA
WRITE !?10,"Removing Edit template ",?30,LRI
DO ^DIK
End DoDot:1
DIPT ;
+1 KILL DA,DIK
SET LRI=""
SET DIK="^DIPT("
FOR
SET LRI=$ORDER(^LAB(69.91,1,"PRT","B",LRI))
IF LRI=""
QUIT
Begin DoDot:1
+2 SET DA=$ORDER(^DIPT("B",$EXTRACT(LRI,1,30),0))
IF DA
WRITE !?15,"Removing Print template ",?35,LRI
DO ^DIK
End DoDot:1
DIBT ;
+1 KILL DA,DIK
SET LRI=""
SET DIK="^DIBT("
FOR
SET LRI=$ORDER(^LAB(69.91,1,"SORT","B",LRI))
IF LRI=""
QUIT
Begin DoDot:1
+2 SET DA=$ORDER(^DIBT("B",$EXTRACT(LRI,1,30),0))
IF DA
WRITE !?20,"Removing Sort template ",?40,LRI
DO ^DIK
End DoDot:1
+3 WRITE !!,"Options - Edit,Print and Sort templates removal complete ",!
LA WRITE !!,"Linking LA namespaced options to their appropriate LR parents..."
+1 FOR LACNT=1:1
SET LAOPT=$PIECE($TEXT(LAOPTION+LACNT),";",3)
IF LAOPT=""
QUIT
Begin DoDot:1
+2 SET LAOPTION=$PIECE(LAOPT,"^")
SET LROPTION=$PIECE(LAOPT,"^",2)
+3 SET LROPTN=$ORDER(^DIC(19,"B",LROPTION,0))
+4 IF 'LROPTN
Begin DoDot:2
+5 WRITE !!?5,"Option ",LROPTION," is missing from your option file."
+6 WRITE !?5,"Couldn't attach option called ",LAOPTION,"."
End DoDot:2
QUIT
+7 SET LAOPTN=$ORDER(^DIC(19,"B",LAOPTION,0))
+8 IF 'LAOPTN
Begin DoDot:2
+9 WRITE !!?5,"Option ",LAOPTION," is missing from your option file."
+10 WRITE !?5,"Couldn't attach to option ",LROPTION,"."
End DoDot:2
QUIT
+11 IF $DATA(^DIC(19,LROPTN,10,"B",LAOPTN))
Begin DoDot:2
+12 WRITE !!?5,"Option ",LAOPTION," is already attached to ",LROPTION,"."
End DoDot:2
QUIT
+13 KILL DIC,DA
+14 SET DA(1)=LROPTN
+15 SET DIC="^DIC(19,"_DA(1)_",10,"
+16 SET DIC(0)="L"
+17 SET X=LAOPTN
+18 DO FILE^DICN
+19 KILL D0,D1,DIC
+20 IF +Y<1
Begin DoDot:2
+21 WRITE !!?5,"Couldn't add option ",LAOPTION," to ",LROPTION,"."
End DoDot:2
QUIT
+22 WRITE !!?5,"Added option ",LAOPTION," to ",LROPTION,"."
End DoDot:1
+23 KILL DA,LRDEL,LRI,LRIFN,LRJ,LRM,LRNOPT,LROPT,LRREP,LRS,DIC,DIK,DINUM,I,X
QUIT
DO1 WRITE !!?5,LRI,!?5
FOR I=1:1:$LENGTH(LRI)
WRITE "-"
+1 SET LROPT=$ORDER(^DIC(19,"B",$EXTRACT(LRI,1,30),0))
IF $SELECT(LROPT'>0:1,'$DATA(^DIC(19,LROPT,0)):1,1:0)
WRITE !?5,"DOES NOT EXIST IN THE 'OPTION' FILE...NOTHING DELETED!"
QUIT
+2 SET LRREP=$PIECE(LRDEL,"^",3)
IF 'LRREP
GOTO DO2
SET LRNOPT=$ORDER(^DIC(19,"B",$EXTRACT($PIECE(LRDEL,"^",4),1,30),0))
+3 IF $SELECT(LRNOPT'>0:1,'$DATA(^DIC(19,LRNOPT,0)):1,1:0)
WRITE !?5,"NEW OPTION (",$PIECE(LRDEL,"^",3),") DOESN'T EXIST IN 'OPTION' FILE...NOTHING REPOINTED!"
SET LRREP=0
DO2 IF $ORDER(^DIC(19,"AD",LROPT,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",LROPT,LRM))
IF LRM'>0
QUIT
SET LRS=0
FOR
SET LRS=$ORDER(^DIC(19,"AD",LROPT,LRM,LRS))
IF LRS'>0
QUIT
DO DO4
DO3 SET DA(1)=19
SET DA=LROPT
SET DIK="^DIC(19,"
DO ^DIK
WRITE !?5,"'",$PIECE(LRDEL,"^",1),"' 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 IF 'LRREP
QUIT
WRITE !?10,"'",$PIECE(LRDEL,"^",4),"' "
IF $DATA(^DIC(19,"AD",LRNOPT,LRM))
WRITE "already EXISTS as an item on this menu..."
QUIT
+2 WRITE "ADDED to menu as a NEW ITEM..."
KILL DD,DO
SET DA(2)=19
SET DA(1)=LRM
SET X=LRNOPT
SET (DA,DINUM)=LRS
SET DIC="^DIC(19,"_LRM_",10,"
SET DIC(0)="L"
SET DLAYGO=19
DO FILE^DICN
KILL DD,DO,DA,DIC,DLAYGO
QUIT
LAOPTION ;;
+1 ;;LA AP FICHE^LRLIAISON
+2 ;;LA DOWN^LR DO!
+3 ;;LA INTERFACE^LRSUPERVISOR
+4 ;;LA MI MENU^LRMI
+5 ;;LA JOB^LRLIAISON
+6 ;;LA DOWN^LA MI MENU
