| 1 | FHXOR ; HISC/REL - OE/RR Post-Init ;12/10/92 15:03
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | Q:'$D(^ORD(101,0))
|
|---|
| 4 | ; Clean up options and routines
|
|---|
| 5 | S DA(1)=$O(^ORD(101,"B","ORADD",0))
|
|---|
| 6 | S DA=$O(^ORD(101,"B","FHWM",0))
|
|---|
| 7 | I DA S DA=$O(^ORD(101,DA(1),10,"B",DA,0)) I DA S DIK="^ORD(101,DA(1),10," D ^DIK
|
|---|
| 8 | F FHX="FHWM","FHW1","FHW2","FHW3","FHW4","FHW5","FHW6","FHW7","FHW8","FHWMAS","FHWPRO1" S DA=$O(^DIC(19,"B",FHX,"")) I DA S DIK="^DIC(19," D ^DIK
|
|---|
| 9 | F FHX="FHWM","FHW5" S DA=$O(^ORD(101,"B",FHX,"")) I DA S DIK="^ORD(101," D ^DIK
|
|---|
| 10 | W !!,"Add Dietetic protocols to MAS OE/RR options ..."
|
|---|
| 11 | S X=" ;;DGPM MOVEMENT EVENTS;FHWMAS" D A2
|
|---|
| 12 | W !!,"Add Dietetic protocols to OE/RR protocols ..."
|
|---|
| 13 | F KK=1:1:2 S X=$T(ADD+KK) D A2
|
|---|
| 14 | Q:'$D(^ORD(100.98,0)) Q:$P(^(0),"^",1)'="DISPLAY GROUP"
|
|---|
| 15 | W !!,"Adding Dietetic Display Groups for OE/RR ..." K DIC,DIE,DA,DR
|
|---|
| 16 | F KK=1:1:4 S X=$T(DIS+KK) D A3
|
|---|
| 17 | F KK=1:1:4 S X=$T(SUB+KK) D A4
|
|---|
| 18 | K D0,DA,DIC,DIE,DLAYGO,DR,KK,ORBUF,X,Y Q
|
|---|
| 19 | A2 S DA(1)=$O(^ORD(101,"B",$P(X,";",3),0)) I 'DA(1) K DA Q
|
|---|
| 20 | K DIC S:'$D(^ORD(101,DA(1),10,0)) ^(0)="^101.01PA^^"
|
|---|
| 21 | S DIC("DR")=$P(X,";",5,6)
|
|---|
| 22 | S DIC="^ORD(101,"_DA(1)_",10,",DIC(0)="L",DLAYGO=101,X=$P(X,";",4) D ^DIC
|
|---|
| 23 | I $P(Y,"^",3) W !?2,X," added as item to ",$P(^ORD(101,DA(1),0),"^",1),"."
|
|---|
| 24 | K DIC,DA Q
|
|---|
| 25 | A3 S DIC="^ORD(100.98,",DIC(0)="L",DLAYGO=100.98,ORBUF="3///"_$P(X,";",5),X=$P(X,";",3) D ^DIC K DA,DR,DIE
|
|---|
| 26 | I $P(Y,"^",3) W !,X," added as new Display Group"
|
|---|
| 27 | I Y S DIE=DIC,DA=+Y,DR=ORBUF D ^DIE K DA,DIE,DIC,DR W "."
|
|---|
| 28 | Q
|
|---|
| 29 | A4 Q:'$O(^ORD(100.98,"B",$P(X,";",4),0))
|
|---|
| 30 | S DA(1)=$O(^ORD(100.98,"B",$P(X,";",3),0)) I 'DA(1) K DA Q
|
|---|
| 31 | S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
|
|---|
| 32 | S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="L",DLAYGO=100.98,X=$P(X,";",4) D ^DIC
|
|---|
| 33 | I $P(Y,"^",3) W !?2,X," added as subgroup to ",$P(^ORD(100.98,DA(1),0),"^",1),"."
|
|---|
| 34 | K DIC,DA Q
|
|---|
| 35 | ADD ;;
|
|---|
| 36 | ;;ORADD;FHWMENU;2///DI;3///1
|
|---|
| 37 | ;;OROPRO;FHWPRO1;2///DI;3///1
|
|---|
| 38 | DIS ;;NAME;PACKAGE;SHORT NAME
|
|---|
| 39 | ;;DIET ORDERS;DIETETICS;DO
|
|---|
| 40 | ;;TUBEFEEDINGS;DIETETICS;TF
|
|---|
| 41 | ;;DIETETIC CONSULTS;DIETETICS;D CON
|
|---|
| 42 | ;;DIET ADDITIONAL ORDERS;DIETETICS;D AO
|
|---|
| 43 | ;;EARLY/LATE TRAYS;DIETETICS;E/L T
|
|---|
| 44 | ;;DIETETICS;DIETETICS;DIET
|
|---|
| 45 | SUB ;;PARENT;MEMBER ;10/7/89 20:52
|
|---|
| 46 | ;;DIETETICS;DIET ORDERS
|
|---|
| 47 | ;;DIETETICS;TUBEFEEDINGS
|
|---|
| 48 | ;;DIETETICS;DIETETIC CONSULTS
|
|---|
| 49 | ;;DIETETICS;DIET ADDITIONAL ORDERS
|
|---|
| 50 | ;;DIETETICS;EARLY/LATE TRAYS
|
|---|
| 51 | ;;ALL SERVICES;DIETETICS
|
|---|
