- 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
