source: FOIAVistA/trunk/r/DIETETICS-FH/FHORD71.m@ 677

Last change on this file since 677 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1FHORD71 ; HISC/REL - Diet Order Utilities (cont) ;10/1/96 10:00
2 ;;5.5;DIETETICS;;Jan 28, 2005
3GETD ; Get from/to dates
4 S (D1,D2)=0 D NOW^%DTC S NOW=%,DT=NOW\1 K %,%H,%I
5D1 R !!,"Effective Date/Time: NOW// ",X:DTIME Q:'$T!(X="^") S:X="" X="NOW" D:$E($P(X,"@",2),1)?1U CNV S %DT="ETSX" D ^%DT Q:U[X G:Y<1 D1
6 I Y<NOW W *7," Cannot be effective before now!" G GETD
7 S D1=+Y Q:'D3
8D2 R !!,"Expiration Date/Time: ",X:DTIME G:'$T!(X["^") D3 Q:X="" D:$P(X,"@",2)?1U CNV S %DT="ETSX" D ^%DT G D3:U[X,D2:Y<1
9 I Y'>D1 W *7," Cannot end before effective date!" G GETD
10 S D2=+Y Q
11D3 S D1=0 Q
12CNV S DP=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8)
13 I DP'="" S DP=$P($G(^FH(119.6,DP,0)),"^",8)
14 S FHPAR=$G(^FH(119.73,+DP,2))
15 S A1=$E($P(X,"@",2),1) I A1'="M" S A1=$S(A1="B":$P(FHPAR,"^",7),A1="N":$P(FHPAR,"^",8),A1="E":$P(FHPAR,"^",9),1:A1),$P(X,"@",2)=A1 Q
16 S X=$P(X,"@",1),%DT="X" D ^%DT I Y<1 S X=X_"@2359" Q
17 S X1=Y,X2=1 D C^%DTC K %H,%T Q:X<1 S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))_"@0001" Q
18ACR ; Store AC diet sequence data
19 G:Z6<1 A1 I '$D(^FHPT(FHDFN,"A",ADM,"AC",0)) S ^(0)="^115.14^^"
20 S ^FHPT(FHDFN,"A",ADM,"AC",+Z6,0)=Z6,$P(^FHPT(FHDFN,"A",ADM,"AC",0),"^",3)=+Z6
21 I Z6'>NOW S Z6=1 G A1
22 N X,X1,FHORN K ZTSAVE
23 S ZTIO="",ZTRTN="UPD^FHORD7",ZTREQ="@",ZTDESC="Diet Update",ZTDTH=+Z6
24 S ZTSAVE("DFN")=DFN,ZTSAVE("FHDFN")=FHDFN,ZTSAVE("ADM")=ADM,ZTSAVE("Z6")=+Z6,ZTSAVE("ZTREQ")="" D ^%ZTLOAD K ZTSK
25 S Z6=1
26A1 S $P(^FHPT(FHDFN,"A",ADM,"AC",0),"^",4)=$P(^FHPT(FHDFN,"A",ADM,"AC",0),"^",4)+Z6 K Z6 Q
27OE ; File OE/RR Diet Order
28 Q:FHLD="X"!(FHLD="P")
29 S FHO=FHOR,VAL="" D VAL^FHWORP(FHO,.VAL) Q:VAL=""
30 S FHNEW=$S(FHLD'="":"N",1:"D")_";"_ADM_";"_FHORD_";"_D1_";"_D2_";"_FHLD_";"_COM_";"_TYP_";"_D4_";"_VAL
31 S (FHSTS,FHDU)=$S(D1>NOW:8,1:6)
32 I FHWF=1 D FILE S:FHDU $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",15)=FHDU Q
33 I FHWF=2 S FHDU=+FHORN_"^"_FHDU D FHWF2
34 S:+FHDU $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",14,15)=FHDU Q
35OEU ; Update status of OE/RR orders
36 N FHORN K A1 S A1=0
37 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"AC",K)) Q:K>NOW!(K<1) S A1=K
38 I A1 S X=$P(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2),A1(+X)=A1,A1=+X
39 F K=NOW:0 S K=$O(^FHPT(FHDFN,"A",ADM,"AC",K)) Q:K<1 S X=$P(^(K,0),"^",2) I '$D(A1(+X)) S A1(+X)=K
40 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"DI",K)) Q:K="" S FHORN=$P(^(K,0),"^",14) I FHORN S STS=$P(^(0),"^",15) D U1
41 K A1,K,X,FHORN,FHL,FHO,FHMSG1,FHSAV,STS Q
42U1 I '$D(A1(K)) Q:STS<3 S $P(^FHPT(FHDFN,"A",ADM,"DI",K,0),"^",15)=1,FHSTS=1,FHSAV=$G(^FHPT(FHDFN,"A",ADM,"DI",K,0)) Q:'$D(^OR(100,FHORN)) G U3
43 N FHMSG1,FHO,FHSAV S FHSAV=$G(^FHPT(FHDFN,"A",ADM,"DI",K,0))
44 S FHO=$P(FHSAV,"^",2,6),VAL="" D VAL^FHWORP(FHO,.VAL) Q:VAL=""
45 S FHMSG1=$S($P(FHSAV,"^",7)="N":"N",1:"D")_";"_ADM_";"_K_";"_$P(FHSAV,"^",9)_";"_$P(FHSAV,"^",10)_";"_$P(FHSAV,"^",7)_";"_$G(^FHPT(FHDFN,"A",ADM,"DI",K,1))_";"_$P(FHSAV,"^",8)_";;"_VAL
46 S FHDAT="",FHSTRT=$P(^FHPT(FHDFN,"A",ADM,"DI",K,0),"^",9) I FHSTRT'=A1(K) S FHDAT=A1(K)
47 S FHDAT=FHDAT_"^"_$P(^FHPT(FHDFN,"A",ADM,"DI",K,0),"^",10)
48 S FHSTS=$S(K=A1:6,1:8) I FHSTS'=STS S $P(^FHPT(FHDFN,"A",ADM,"DI",K,0),"^",15)=FHSTS
49 I '$D(^OR(100,FHORN)) K FHDAT,FHSTRT,FHSTS Q
50 I $D(FHORN1),FHORN1=FHORN S FHORR=1
51 I $P(FHSAV,"^",7)="N" D CODE^FHWOR4 D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG,FHDAT,FHSTRT,FHSTS Q
52 I $P(FHSAV,"^",7)="" D CODE^FHWOR2 D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
53 K FHDAT,FHSTRT,FHSTS Q
54U3 S FHO=$P(FHSAV,"^",2,6),VAL="" D VAL^FHWORP(FHO,.VAL) Q:VAL=""
55 S FHMSG1=$S($P(FHSAV,"^",7)="N":"N",1:"D")_";"_ADM_";"_K_";"_$P(FHSAV,"^",9)_";"_$P(FHSAV,"^",10)_";"_$P(FHSAV,"^",7)_";"_$G(^FHPT(FHDFN,"A",ADM,"DI",K,1))_";"_$P(FHSAV,"^",8)_";;"_VAL
56 I $D(FHORN1),FHORN1=FHORN S FHORR=1
57 S FHDAT=""
58 I $P(FHSAV,"^",7)="N" D CODE^FHWOR4 D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG Q
59 I $P(FHSAV,"^",7)="" D CODE^FHWOR2 D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
60 Q
61FILE ; File Orders from Dietetics
62 I FHLD="N" D NPO^FHWOR4 D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG Q
63 I FHLD="" D DO^FHWOR2 D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
64 Q
65FHWF2 ; Perform if orders comes from OE/RR
66 S $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",14)=$S(+FHORN:+FHORN,1:0)
67 Q:FHLD="X"!(FHLD="P")
68 Q:'FHORN S VAL="" D VAL^FHWORP(FHOR,.VAL) Q:VAL=""
69 S FILL=$S(FHLD="N":"N;",1:"D;")_ADM_";"_FHORD_";"_D1_";"_D2_";"_FHLD_";"_COM_";"_TYP_";"_D4_";"_VAL
70 I FHLD="N" D SEND^FHWOR D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG Q
71 I FHLD="" D SEND^FHWOR D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
72 Q
73WAIT ; Hold screen for OE/RR
74 Q:$E(IOST,1)'="C" R !!?5,"Press return to continue ",X:DTIME Q
Note: See TracBrowser for help on using the repository browser.