| 1 | FHORD3 ; HISC/REL/NCA - Withhold Service ;8/20/96 09:09 ;
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005;
|
|---|
| 3 | F0 S ALL=0 D ^FHDPA G:'DFN KIL^FHORD1 G:'FHDFN KIL^FHORD1
|
|---|
| 4 | D NOW^%DTC S NOW=% D CUR,FUT^FHORD1
|
|---|
| 5 | W !!,"Place patient on NPO/HOLD-TRAY." D F5 Q:'$D(DFN) Q:'$D(FHDFN) D F7 W !!,"... done" G F0
|
|---|
| 6 | F5 ; Process NPO
|
|---|
| 7 | S D3=1 D GETD^FHORD71 G:'D1 AB
|
|---|
| 8 | F6 R !!,"Comment: ",COM:DTIME G:'$T!(COM[U) AB I COM'?.ANP W *7," ??" G F6
|
|---|
| 9 | I $L(COM)>80!(COM?1"?".E) W *7,!,"Enter comment of up to 80 characters!" G F6
|
|---|
| 10 | Q
|
|---|
| 11 | F7 ; File NPO
|
|---|
| 12 | S FHOR="^^^^",FHLD="N",TYP="",D4=0 D STR^FHORD7
|
|---|
| 13 | G KIL^FHORD1
|
|---|
| 14 | EN2 ; Cancel Withhold Order
|
|---|
| 15 | D NOW^%DTC S NOW=%,DT=%\1
|
|---|
| 16 | S ALL=0 D ^FHDPA G:'DFN KIL G:'FHDFN KIL D CUR S OLD=FHLD
|
|---|
| 17 | S (A2,CT)=0 F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1!(KK'<NOW) S A2=KK
|
|---|
| 18 | S XT="" K N F KK=A2-.000001:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1 S FHORD=$P(^(KK,0),"^",2) D T1
|
|---|
| 19 | I 'CT W !!,"No WITHHOLD Orders to Cancel" G KIL
|
|---|
| 20 | C0 R !!,"Cancel Which Order #? ",X:DTIME G:'$T!("^"[X) AB I X'?1N.N!(X<1)!(X>CT) W *7," Enter # of Order to Cancel" G C0
|
|---|
| 21 | S FHORD=$P(XT,",",X),KK=N(FHORD) D T0 G KIL
|
|---|
| 22 | T0 ; Update cancelled NPO
|
|---|
| 23 | S X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),D1=$P(X,"^",9),D2=$S(D1'>NOW:NOW,1:D1)
|
|---|
| 24 | S $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",10)=D2
|
|---|
| 25 | S $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",18,19)=D2_"^"_DUZ
|
|---|
| 26 | S:FHWF'=2 FHORN=$P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",14)
|
|---|
| 27 | F K9=KK-.000001:0 S K9=$O(^FHPT(FHDFN,"A",ADM,"AC",K9)) Q:K9<1 I $P(^(K9,0),"^",2)=FHORD S D1=K9 D S0
|
|---|
| 28 | D UPD^FHORD7 W:FHWF'=2 " ... done" Q:FHWF=2 D CUR
|
|---|
| 29 | I OLD'="","^^^^"'[FHOR S D1=NOW D ^FHORD1A
|
|---|
| 30 | Q
|
|---|
| 31 | S0 ; Set AC cross-ref data field
|
|---|
| 32 | S X2=D1+.0000001,D2=$O(^FHPT(FHDFN,"A",ADM,"AC",D1)) S:D2<1 D2=""
|
|---|
| 33 | S1 S A2=0 F A1=0:0 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) Q:A1<1!(A1'<X2) S A2=A1
|
|---|
| 34 | I A2 S X2=A2,A2=$P(^FHPT(FHDFN,"A",ADM,"AC",A2,0),"^",2),X1=$P(^FHPT(FHDFN,"A",ADM,"DI",A2,0),"^",10) I X1'="",X1'>D1 G S1
|
|---|
| 35 | D:'A2 NOR S Z6=D1_"^"_A2 D ACR^FHORD71
|
|---|
| 36 | I X1'="",D2=""!(X1<D2) S D1=X1 G S0
|
|---|
| 37 | S2 S X1="",A1=0 G S4
|
|---|
| 38 | S3 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) G:A1="" S4 S X2=$P(^(A1,0),"^",2)
|
|---|
| 39 | I X2<1 D SK G S3
|
|---|
| 40 | I '$D(^FHPT(FHDFN,"A",ADM,"DI",X2,0)) D SK G S3
|
|---|
| 41 | S X2=^FHPT(FHDFN,"A",ADM,"DI",X2,0) I $P(X2,"^",2,8)'=$P(X1,"^",2,8) S X1=X2 G S3
|
|---|
| 42 | I $P(X1,"^",10)="" D SK G S3
|
|---|
| 43 | I $P(X2,"^",10),$P(X2,"^",10)'>$P(X1,"^",10) D SK G S3
|
|---|
| 44 | S X1=X2 G S3
|
|---|
| 45 | S4 D OEU^FHORD71 Q
|
|---|
| 46 | SK K ^FHPT(FHDFN,"A",ADM,"AC",A1) S Z6=-1 G ACR^FHORD71
|
|---|
| 47 | NOR L +^FHPT(FHDFN,"A",ADM,"DI",0)
|
|---|
| 48 | I '$D(^FHPT(FHDFN,"A",ADM,"DI",0)) S ^FHPT(FHDFN,"A",ADM,"DI",0)="^115.02A^^"
|
|---|
| 49 | S X=^FHPT(FHDFN,"A",ADM,"DI",0),A2=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_A2_"^"_($P(X,"^",4)+1) L -^FHPT(FHDFN,"A",ADM,"DI",0)
|
|---|
| 50 | S ^FHPT(FHDFN,"A",ADM,"DI",A2,0)=A2_"^^^^^^X^^"_D1_"^^"_DUZ_"^"_NOW,X="" Q
|
|---|
| 51 | CUR D CUR^FHORD7 W !!,"Current Diet: ",$S(Y'="":Y,1:"No Current Order")
|
|---|
| 52 | Q:'FHORD S X9=$P(X,"^",8) W:X9'="" " (",$S(X9="T":"Tray",X9="D":"Dining Room",1:"Cafe"),")" Q
|
|---|
| 53 | T1 Q:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))!($D(N(FHORD))) Q:$P(^(0),"^",7)="" S P2=$P(^(0),"^",10)
|
|---|
| 54 | S DTP=KK D DTP^FH,C2^FHORD7
|
|---|
| 55 | I 'CT W !!," # Effective Expires Order",!
|
|---|
| 56 | S CT=CT+1,XT=XT_FHORD_",",N(FHORD)=KK W !,$J(CT,2)," ",DTP
|
|---|
| 57 | S DTP=P2 D:DTP DTP^FH W ?24,DTP,?47,Y Q
|
|---|
| 58 | AB W *7,!!,"Withhold entry TERMINATED - No change!"
|
|---|
| 59 | KIL K %,%H,%I,C,CT,DA,DG,DLB,DTP,I,K9,N,OLD,POP,P2,X9,XT G KIL^FHORD1
|
|---|
