70 lines
3.8 KiB
Mathematica
70 lines
3.8 KiB
Mathematica
FHORD7 ; HISC/REL/NCA/JH - Diet Order Utilities ;4/5/96 11:27
|
|
;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
|
|
CUR ; Get Diet
|
|
S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
|
|
S X1=$G(^FHPT(FHDFN,"A",ADM,0)),FHORD=$P(X1,"^",2),X1=$P(X1,"^",3),(FHLD,FHOR,X,Y)=""
|
|
Q:'FHORD Q:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
|
|
C2 ; Set FHOR & FHLD variables & Y = diet text
|
|
S X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),FHOR=$P(X,"^",2,6),FHLD=$P(X,"^",7),Y=""
|
|
I FHLD'="" S FHDU=";"_$P(^DD(115.02,6,0),"^",3),%=$F(FHDU,";"_FHLD_":") S:%>0 Y=$P($E(FHDU,%,999),";",1) K % Q
|
|
C3 S Y="" F A1=1:1:5 S D3=$P(FHOR,"^",A1) I D3 S:Y'="" Y=Y_", " S Y=Y_$P(^FH(111,D3,0),"^",7)
|
|
Q
|
|
NOW D NOW^%DTC S NOW=% Q
|
|
POST ; Generate bulletin
|
|
S WRD=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8) Q:WRD<1
|
|
F FHXMKK=0:0 S FHXMKK=$O(^FH(119.6,WRD,2,"B",FHXMKK)) Q:FHXMKK'>0 D
|
|
.S XMY(FHXMKK)=""
|
|
Q:'$D(XMY) S XMB="FHDIORD"
|
|
D PATNAME^FHOMUTL I DFN="" Q
|
|
S XMB(1)=$P(^DPT(DFN,0),"^",1),XMB(2)=$P(^FH(119.6,WRD,0),"^",1) D C3 S XMB(3)=Y
|
|
S XMB(5)=$S($D(^DPT(DFN,.101)):^(.101),1:"unknown")
|
|
S DTP=D1 D DTP^FH S XMB(4)=DTP D ^XMB K XMB,XMY,XMM,XMDT,FHXMKK Q
|
|
STR ; Store new diet order
|
|
D ORD,NOW
|
|
S X=FHORD_"^"_FHOR_"^"_FHLD_"^"_TYP_"^"_D1_"^"_$S(D2:D2,1:"")_"^"_DUZ_"^"_NOW,FHNOW=NOW
|
|
S ^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)=X S:COM'="" ^(1)=COM I FHWF D OE^FHORD71 S NOW=FHNOW
|
|
S0 G:'D2 S1 S X2=D2+.000001
|
|
S01 S A2=0 F A1=0:0 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) Q:A1<1!(A1'<X2) S A2=A1
|
|
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'>D2 G S01
|
|
F A1=D1:0 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) Q:A1<1!(A1'<D2) D SK
|
|
S Z6=D1_"^"_FHORD D ACR^FHORD71
|
|
I 'A2 D ORD S A2=FHORD,^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)=FHORD_"^^^^^^X^^"_D2_"^^"_DUZ_"^"_NOW
|
|
E D OE3
|
|
S Z6=D2_"^"_A2 D ACR^FHORD71 G S2
|
|
S1 I FHLD'="P" F A1=D1:0 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) Q:A1="" D SK
|
|
S Z6=D1_"^"_FHORD D ACR^FHORD71
|
|
S2 S X1="",A1=0 G S4
|
|
S3 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) G:A1="" S4 S X2=$P(^(A1,0),"^",2)
|
|
I X2<1 D SK G S3
|
|
I '$D(^FHPT(FHDFN,"A",ADM,"DI",X2,0)) D SK G S3
|
|
S X2=^FHPT(FHDFN,"A",ADM,"DI",X2,0) I $P(X2,"^",2,8)'=$P(X1,"^",2,8) S X1=X2 G S3
|
|
I $P(X1,"^",10)="" D SK G S3
|
|
I $P(X2,"^",10),$P(X2,"^",10)'>$P(X1,"^",10) D SK G S3
|
|
S X1=X2 G S3
|
|
S4 D OEU^FHORD71 S NOW=FHNOW K FHNOW G U1
|
|
UPD ; Get time & update diet
|
|
D NOW I $D(ZTQUEUED),$D(Z6) I NOW<Z6 S NOW=Z6+.0002
|
|
U1 ; Update diet
|
|
S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" W "Could not find patient" Q
|
|
S A1=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"AC",K)) Q:K<1!(K>NOW) S A1=K
|
|
G:'A1 U3 S X1=$P(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2) G S2:X1<1,S2:'$D(^FHPT(FHDFN,"A",ADM,"DI",X1,0))
|
|
S X2=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) S:X2<1 X2=""
|
|
U2 I $P(^FHPT(FHDFN,"A",ADM,0),"^",2,3)=X1_"^"_X2 Q
|
|
S FHYES=0 I $P(^FHPT(FHDFN,"A",ADM,0),"^",2)=X1 S FHYES=1
|
|
S $P(^FHPT(FHDFN,"A",ADM,0),"^",2,3)=X1_"^"_X2,X9="" I X1 S X9=$P(^FHPT(FHDFN,"A",ADM,"DI",X1,0),"^",8) I 'FHYES S EVT="D^O^"_X1 D ^FHORX
|
|
I X9'="",X9'=$P(^FHPT(FHDFN,"A",ADM,0),"^",5) S $P(^(0),"^",5)=X9
|
|
K X9 D ^FHORD72 K FHYES Q
|
|
U3 S (X1,X2)="" G U2
|
|
SK K ^FHPT(FHDFN,"A",ADM,"AC",A1) S Z6=-1 G ACR^FHORD71
|
|
ORD ; Get next order #
|
|
L +^FHPT(FHDFN,"A",ADM,"DI",0)
|
|
I '$D(^FHPT(FHDFN,"A",ADM,"DI",0)) S ^FHPT(FHDFN,"A",ADM,"DI",0)="^115.02A^^"
|
|
S X=^FHPT(FHDFN,"A",ADM,"DI",0),FHORD=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_FHORD_"^"_($P(X,"^",4)+1)
|
|
L -^FHPT(FHDFN,"A",ADM,"DI",0) Q:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD)) G ORD
|
|
OE3 ; Enter New Re-enstated Order
|
|
Q:$$VERSION^XPDUTL("OR")=2.5
|
|
D ORD^FHORR S FHNO1=$G(^FHPT(FHDFN,"A",ADM,"DI",A2,0)),FHNO2=$G(^(1)),FHNO3=$G(^(2))
|
|
S ^FHPT(FHDFN,"A",ADM,"DI",FHORD1,0)=FHORD1_"^"_$P(FHNO1,"^",2,8)_"^"_D2_"^"_$P(FHNO1,"^",10)_"^"_DUZ_"^"_NOW_"^"_$P(FHNO1,"^",13) S:FHNO2'="" ^(1)=FHNO2
|
|
S:FHNO3 ^(2)=FHNO3,^(3)=DUZ_"^"_NOW S A2=FHORD1 I FHWF D OE^FHORR S NOW=FHNOW
|
|
K FHNO1,FHNO2,FHNO3,FHORD1 Q
|