| [613] | 1 | FHXUTL ; HISC/NCA - OE/RR Post-Init Clean Up of 2.5 Protocols ;11/10/97 12:52
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | I +$$VERSION^XPDUTL("OR")'=3 W !,?10,"You do not have version 3 of Order Entry.",!,?10,"The Protocols will not be removed." Q
|
|---|
| 4 | Q:'$D(^ORD(101,0))
|
|---|
| 5 | S FHX="FHW"
|
|---|
| 6 | S FHX=$O(^ORD(101,"B",FHX)) Q:FHX=""
|
|---|
| 7 | S FHX1=$O(^ORD(101,"B",FHX,0)) Q:'FHX1
|
|---|
| 8 | K ^TMP($J,"FHPRO")
|
|---|
| 9 | ; Clean up protocols
|
|---|
| 10 | W !!,"Clean up 2.5 Dietetics Protocols..."
|
|---|
| 11 | S FHX="FHW" F S FHX=$O(^ORD(101,"B",FHX)) Q:$E(FHX,1,3)'="FHW" F FHX1=0:0 S FHX1=$O(^ORD(101,"B",FHX,FHX1)) Q:FHX1<1 S:FHX'="FHWMAS" ^TMP($J,"FHPRO",FHX1)=FHX
|
|---|
| 12 | F FHX="OR" F S FHX=$O(^ORD(101,"B",FHX)) Q:$E(FHX,1,2)'="OR" F FHX1=0:0 S FHX1=$O(^ORD(101,"B",FHX,FHX1)) Q:FHX1<1 I $E($P($G(^ORD(101,FHX1,0)),"^",1),1,2)="OR" D REMOV
|
|---|
| 13 | F FHX="FHW" F S FHX=$O(^ORD(101,"B",FHX)) Q:$E(FHX,1,3)'="FHW" F FHX1=0:0 S FHX1=$O(^ORD(101,"B",FHX,FHX1)) Q:FHX1<1 I $E($P($G(^ORD(101,FHX1,0)),"^",1),1,3)="FHW" D REMOV
|
|---|
| 14 | F FHX=0:0 S FHX=$O(^TMP($J,"FHPRO",FHX)) Q:FHX<1 S DA=FHX I DA S DIK="^ORD(101," D ^DIK W !,"Protocol ",$G(^TMP($J,"FHPRO",FHX))," Removed"
|
|---|
| 15 | W !,"...Done"
|
|---|
| 16 | K ^TMP($J,"FHPRO"),DA,DIC,DIK,FHX,FHX1,FHX3
|
|---|
| 17 | Q
|
|---|
| 18 | REMOV ; Check if FHW protocols is used as Items and delete them.
|
|---|
| 19 | S DA(1)=FHX1
|
|---|
| 20 | F FHX3=0:0 S FHX3=$O(^TMP($J,"FHPRO",FHX3)) Q:FHX3<1 S DA=$O(^ORD(101,DA(1),10,"B",FHX3,0)) I DA S DIK="^ORD(101,DA(1),10," D ^DIK W !,"Protocol ",$G(^TMP($J,"FHPRO",FHX3))," Removed From ",FHX
|
|---|
| 21 | Q
|
|---|
