- FHXOR ; HISC/REL - OE/RR Post-Init ;12/10/92 15:03
- ;;5.5;DIETETICS;;Jan 28, 2005
- Q:'$D(^ORD(101,0))
- ; Clean up options and routines
- S DA(1)=$O(^ORD(101,"B","ORADD",0))
- S DA=$O(^ORD(101,"B","FHWM",0))
- I DA S DA=$O(^ORD(101,DA(1),10,"B",DA,0)) I DA S DIK="^ORD(101,DA(1),10," D ^DIK
- 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
- F FHX="FHWM","FHW5" S DA=$O(^ORD(101,"B",FHX,"")) I DA S DIK="^ORD(101," D ^DIK
- W !!,"Add Dietetic protocols to MAS OE/RR options ..."
- S X=" ;;DGPM MOVEMENT EVENTS;FHWMAS" D A2
- W !!,"Add Dietetic protocols to OE/RR protocols ..."
- F KK=1:1:2 S X=$T(ADD+KK) D A2
- Q:'$D(^ORD(100.98,0)) Q:$P(^(0),"^",1)'="DISPLAY GROUP"
- W !!,"Adding Dietetic Display Groups for OE/RR ..." K DIC,DIE,DA,DR
- F KK=1:1:4 S X=$T(DIS+KK) D A3
- F KK=1:1:4 S X=$T(SUB+KK) D A4
- K D0,DA,DIC,DIE,DLAYGO,DR,KK,ORBUF,X,Y Q
- A2 S DA(1)=$O(^ORD(101,"B",$P(X,";",3),0)) I 'DA(1) K DA Q
- K DIC S:'$D(^ORD(101,DA(1),10,0)) ^(0)="^101.01PA^^"
- S DIC("DR")=$P(X,";",5,6)
- S DIC="^ORD(101,"_DA(1)_",10,",DIC(0)="L",DLAYGO=101,X=$P(X,";",4) D ^DIC
- I $P(Y,"^",3) W !?2,X," added as item to ",$P(^ORD(101,DA(1),0),"^",1),"."
- K DIC,DA Q
- 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
- I $P(Y,"^",3) W !,X," added as new Display Group"
- I Y S DIE=DIC,DA=+Y,DR=ORBUF D ^DIE K DA,DIE,DIC,DR W "."
- Q
- A4 Q:'$O(^ORD(100.98,"B",$P(X,";",4),0))
- S DA(1)=$O(^ORD(100.98,"B",$P(X,";",3),0)) I 'DA(1) K DA Q
- S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
- S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="L",DLAYGO=100.98,X=$P(X,";",4) D ^DIC
- I $P(Y,"^",3) W !?2,X," added as subgroup to ",$P(^ORD(100.98,DA(1),0),"^",1),"."
- K DIC,DA Q
- ADD ;;
- ;;ORADD;FHWMENU;2///DI;3///1
- ;;OROPRO;FHWPRO1;2///DI;3///1
- DIS ;;NAME;PACKAGE;SHORT NAME
- ;;DIET ORDERS;DIETETICS;DO
- ;;TUBEFEEDINGS;DIETETICS;TF
- ;;DIETETIC CONSULTS;DIETETICS;D CON
- ;;DIET ADDITIONAL ORDERS;DIETETICS;D AO
- ;;EARLY/LATE TRAYS;DIETETICS;E/L T
- ;;DIETETICS;DIETETICS;DIET
- SUB ;;PARENT;MEMBER ;10/7/89 20:52
- ;;DIETETICS;DIET ORDERS
- ;;DIETETICS;TUBEFEEDINGS
- ;;DIETETICS;DIETETIC CONSULTS
- ;;DIETETICS;DIET ADDITIONAL ORDERS
- ;;DIETETICS;EARLY/LATE TRAYS
- ;;ALL SERVICES;DIETETICS
- FHXOR ; HISC/REL - OE/RR Post-Init ;12/10/92 15:03
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 IF '$DATA(^ORD(101,0))
- QUIT
- +3 ; Clean up options and routines
- +4 SET DA(1)=$ORDER(^ORD(101,"B","ORADD",0))
- +5 SET DA=$ORDER(^ORD(101,"B","FHWM",0))
- +6 IF DA
- SET DA=$ORDER(^ORD(101,DA(1),10,"B",DA,0))
- IF DA
- SET DIK="^ORD(101,DA(1),10,"
- DO ^DIK
- +7 FOR FHX="FHWM","FHW1","FHW2","FHW3","FHW4","FHW5","FHW6","FHW7","FHW8","FHWMAS","FHWPRO1"
- SET DA=$ORDER(^DIC(19,"B",FHX,""))
- IF DA
- SET DIK="^DIC(19,"
- DO ^DIK
- +8 FOR FHX="FHWM","FHW5"
- SET DA=$ORDER(^ORD(101,"B",FHX,""))
- IF DA
- SET DIK="^ORD(101,"
- DO ^DIK
- +9 WRITE !!,"Add Dietetic protocols to MAS OE/RR options ..."
- +10 SET X=" ;;DGPM MOVEMENT EVENTS;FHWMAS"
- DO A2
- +11 WRITE !!,"Add Dietetic protocols to OE/RR protocols ..."
- +12 FOR KK=1:1:2
- SET X=$TEXT(ADD+KK)
- DO A2
- +13 IF '$DATA(^ORD(100.98,0))
- QUIT
- IF $PIECE(^(0),"^",1)'="DISPLAY GROUP"
- QUIT
- +14 WRITE !!,"Adding Dietetic Display Groups for OE/RR ..."
- KILL DIC,DIE,DA,DR
- +15 FOR KK=1:1:4
- SET X=$TEXT(DIS+KK)
- DO A3
- +16 FOR KK=1:1:4
- SET X=$TEXT(SUB+KK)
- DO A4
- +17 KILL D0,DA,DIC,DIE,DLAYGO,DR,KK,ORBUF,X,Y
- QUIT
- A2 SET DA(1)=$ORDER(^ORD(101,"B",$PIECE(X,";",3),0))
- IF 'DA(1)
- KILL DA
- QUIT
- +1 KILL DIC
- IF '$DATA(^ORD(101,DA(1),10,0))
- SET ^(0)="^101.01PA^^"
- +2 SET DIC("DR")=$PIECE(X,";",5,6)
- +3 SET DIC="^ORD(101,"_DA(1)_",10,"
- SET DIC(0)="L"
- SET DLAYGO=101
- SET X=$PIECE(X,";",4)
- DO ^DIC
- +4 IF $PIECE(Y,"^",3)
- WRITE !?2,X," added as item to ",$PIECE(^ORD(101,DA(1),0),"^",1),"."
- +5 KILL DIC,DA
- QUIT
- A3 SET DIC="^ORD(100.98,"
- SET DIC(0)="L"
- SET DLAYGO=100.98
- SET ORBUF="3///"_$PIECE(X,";",5)
- SET X=$PIECE(X,";",3)
- DO ^DIC
- KILL DA,DR,DIE
- +1 IF $PIECE(Y,"^",3)
- WRITE !,X," added as new Display Group"
- +2 IF Y
- SET DIE=DIC
- SET DA=+Y
- SET DR=ORBUF
- DO ^DIE
- KILL DA,DIE,DIC,DR
- WRITE "."
- +3 QUIT
- A4 IF '$ORDER(^ORD(100.98,"B",$PIECE(X,";",4),0))
- QUIT
- +1 SET DA(1)=$ORDER(^ORD(100.98,"B",$PIECE(X,";",3),0))
- IF 'DA(1)
- KILL DA
- QUIT
- +2 IF '$DATA(^ORD(100.98,DA(1),1,0))
- SET ^(0)="^100.981P^^"
- +3 SET DIC="^ORD(100.98,"_DA(1)_",1,"
- SET DIC(0)="L"
- SET DLAYGO=100.98
- SET X=$PIECE(X,";",4)
- DO ^DIC
- +4 IF $PIECE(Y,"^",3)
- WRITE !?2,X," added as subgroup to ",$PIECE(^ORD(100.98,DA(1),0),"^",1),"."
- +5 KILL DIC,DA
- QUIT
- ADD ;;
- +1 ;;ORADD;FHWMENU;2///DI;3///1
- +2 ;;OROPRO;FHWPRO1;2///DI;3///1
- DIS ;;NAME;PACKAGE;SHORT NAME
- +1 ;;DIET ORDERS;DIETETICS;DO
- +2 ;;TUBEFEEDINGS;DIETETICS;TF
- +3 ;;DIETETIC CONSULTS;DIETETICS;D CON
- +4 ;;DIET ADDITIONAL ORDERS;DIETETICS;D AO
- +5 ;;EARLY/LATE TRAYS;DIETETICS;E/L T
- +6 ;;DIETETICS;DIETETICS;DIET
- SUB ;;PARENT;MEMBER ;10/7/89 20:52
- +1 ;;DIETETICS;DIET ORDERS
- +2 ;;DIETETICS;TUBEFEEDINGS
- +3 ;;DIETETICS;DIETETIC CONSULTS
- +4 ;;DIETETICS;DIET ADDITIONAL ORDERS
- +5 ;;DIETETICS;EARLY/LATE TRAYS
- +6 ;;ALL SERVICES;DIETETICS
