| 1 | FHWDISD ; HISC/REL - Delete Discharge ;2/2/95  10:14 | 
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005 | 
|---|
| 3 | D DID^FHDPA Q:WARD=""  S ADM=$G(^DPT("CN",WARD,DFN)) Q:'ADM | 
|---|
| 4 | S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q | 
|---|
| 5 | S A0=$G(^FHPT(FHDFN,"A",ADM,0)),FHWF=$S($D(^ORD(101)):1,1:0) Q:A0="" | 
|---|
| 6 | S TIM=$P(A0,"^",14) Q:'TIM  S $P(^FHPT(FHDFN,"A",ADM,0),"^",14)="" Q | 
|---|
| 7 | ; Re-instate Additional Orders | 
|---|
| 8 | F FHDR=0:0 S FHDR=$O(^FHPT("AOO",FHDFN,ADM,FHDR)) Q:FHDR<1  S Y=$G(^(FHDR,0)) D AOO | 
|---|
| 9 | ; Re-instate Consults | 
|---|
| 10 | F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"DR",FHDR)) Q:FHDR<1  S Y=$G(^(FHDR,0)) D CON | 
|---|
| 11 | ; Re-instate Standing Orders | 
|---|
| 12 | F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"SP",FHDR)) Q:FHDR<1  S Y=^(FHDR,0) D SP | 
|---|
| 13 | ; Re-instate Tubefeeding | 
|---|
| 14 | F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"TF",K)) Q:K<1  I $P($G(^(K,0)),"^",11)=TIM D TF | 
|---|
| 15 | ; Re-instate Supplemental Feeding | 
|---|
| 16 | F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SF",K)) Q:K<1  I $P($G(^(K,0)),"^",32)=TIM D SF | 
|---|
| 17 | ; Re-instate Diet Order | 
|---|
| 18 | D DO,WRD^FHWADM | 
|---|
| 19 | KIL K %,%H,%I,A0,A1,FHDR,K,TIM,FHORD,FHRMB,FHWRD,FHX1,FHX2,FHX3,X,Y Q | 
|---|
| 20 | AOO Q:$P(Y,"^",5,6)'=("X^"_TIM) | 
|---|
| 21 | S $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",5,7)="A^^" | 
|---|
| 22 | S ^FHPT("AOO",FHDFN,ADM,FHDR)="" Q | 
|---|
| 23 | CON Q:$P(Y,"^",8,9)'=("X^"_TIM)  S $P(^FHPT(FHDFN,"A",ADM,"DR",FHDR,0),"^",8,11)="A^^^" | 
|---|
| 24 | S K=$P(Y,"^",5) S:K ^FHPT("ADRU",K,FHDFN,ADM,FHDR)="" Q | 
|---|
| 25 | SP Q:$P(Y,"^",6)'=TIM  S $P(^FHPT(FHDFN,"A",ADM,"SP",FHDR,0),"^",6,7)="^" | 
|---|
| 26 | S ^FHPT("ASP",FHDFN,ADM,FHDR)="" Q | 
|---|
| 27 | TF S $P(^FHPT(FHDFN,"A",ADM,0),"^",4)=K S ^FHPT("ADTF",FHDFN,ADM)="" | 
|---|
| 28 | S $P(^FHPT(FHDFN,"A",ADM,"TF",K,0),"^",11,12)="^" Q | 
|---|
| 29 | SF S $P(^FHPT(FHDFN,"A",ADM,0),"^",7)=K | 
|---|
| 30 | S $P(^FHPT(FHDFN,"A",ADM,"SF",K,0),"^",32,33)="^" Q | 
|---|
| 31 | DO S FHORD=$P($G(^FHPT(FHDFN,"A",ADM,"AC",TIM,0)),"^",2) Q:'FHORD | 
|---|
| 32 | Q:$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",7)'="X" | 
|---|
| 33 | K ^FHPT(FHDFN,"A",ADM,"AC",TIM) | 
|---|
| 34 | S FHORD="" F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"AC",K)) Q:K<1!(K>TIM)  S FHORD=$P(^(K,0),"^",2) | 
|---|
| 35 | Q:'FHORD  S $P(^FHPT(FHDFN,"A",ADM,0),"^",2,3)=FHORD_"^" S EVT="D^O^"_FHORD D ^FHORX | 
|---|
| 36 | Q | 
|---|