139 lines
6.2 KiB
Mathematica
139 lines
6.2 KiB
Mathematica
FHPRO3 ; HISC/REL/RVD - Recipe Calculations ;4/14/95 08:05
|
|
;;5.5;DIETETICS;**3,5**;Jan 28, 2005;Build 53
|
|
;RVD 5/20/05 - as part of AFP project.
|
|
;patch #5 -added a screen for cancelled quest meals.
|
|
K ^TMP($J,"FH","T"),P,T
|
|
I '$G(FHAFLG) K ^TMP($J,"AFP","T")
|
|
;S K3=$F("BNE",MEAL)-1,FHX1=$P(FHDA,"^",K3+1) Q:'FHX1
|
|
F L1=0:0 S L1=$O(^FH(116.2,L1)) Q:L1<1 S Z=$P($G(^(L1,0)),"^",2) I Z'="" S P(Z)=L1
|
|
F P0=0:0 S P0=$O(^TMP($J,"FH",P0)) Q:P0<1 S Z=$P($G(^FH(119.72,P0,0)),"^",2) I Z'="" S T(P0)=Z
|
|
D P1
|
|
S FHAFLG=1
|
|
G ^FHPRO4
|
|
P1 F FHI=0:0 S FHI=$O(FHDODAY(FHI)) Q:FHI'>0 S (D1,X1)=FHDODAY(FHI) D FHD,P12
|
|
K M,P,T,Y,Z,Z1 Q
|
|
P12 S K3=$F("BNE",MEAL)-1,FHX1=$P(FHDA,"^",K3+1) Q:'FHX1
|
|
Q:'$D(^FH(116.1,FHX1))
|
|
F M=0:0 S M=$O(^FH(116.1,FHX1,"RE",M)) Q:M<1 S L1=^(M,0),L1=+L1 D P2
|
|
Q
|
|
P2 S N1=0,X=$G(^FH(114,L1,0)),K4=$P(X,"^",12),K4=$S($D(^FH(114.2,+K4,0)):$P(^(0),"^",3),1:99)
|
|
;S MCA=$O(^FH(116.1,FHX1,"RE",M,"R",0)),LL=$S(MCA:+$G(^FH(116.1,FHX1,"RE",M,"R",MCA,0)),1:99)
|
|
;S FHPD=$P(LL,"^",2),LL=+LL
|
|
;S LL=$S($D(^FH(114.1,+LL,0)):$P(^(0),"^",3),1:99)
|
|
;
|
|
S LL=$P(X,"^",7)
|
|
I $G(LL) S LL=$S($D(^FH(114.1,+LL,0)):$P(^(0),"^",3),1:99)
|
|
S K4=$S(K4<1:99,K4<10:"0"_K4,1:K4)_$S(LL<1:99,LL<10:"0"_LL,1:LL)_$E($P(X,"^",1),1,26)
|
|
F P0=0:0 S P0=$O(^TMP($J,"FHD",D1,P0)) Q:P0<1 D R1 ;I N2 S ^TMP($J,"FH","T",K4,L1,P0)=N2,^TMP($J,"AFP","T",K4,L1,P0)=N2
|
|
Q:'N1 S:'$G(^TMP($J,"FH","T",K4,L1)) ^TMP($J,"FH","T",K4,L1)=0 S ^(L1)=^(L1)+N1
|
|
S:'$G(^TMP($J,"AFP","T",K4,L1)) ^TMP($J,"AFP","T",K4,L1)=0 S ^(L1)=^(L1)+N1
|
|
Q
|
|
R1 S Z1=$P($G(^FH(116.1,FHX1,"RE",M,"D",P0,0)),"^",2),N2=0
|
|
F CAT=0:0 S CAT=$O(^FH(116.1,FHX1,"RE",M,"R",CAT)) Q:CAT<1 S FHPD=$P($G(^(CAT,0)),"^",2) D
|
|
.F LL=1:1 S FHX2=$P(FHPD," ",LL) Q:FHX2="" S X=$P(FHX2,";",1) I X'="",$D(P(X)) D P3
|
|
.Q
|
|
Q
|
|
P3 S FHPX1=$G(^TMP($J,"FHD",D1,P0,P(X))) Q:'FHPX1
|
|
S Y=$P(FHX2,";",2) I Y="" S:Z1'="" FHPX1=$J(Z1*FHPX1/100,0,0) G P4
|
|
D P5 S Y=$P(FHX2,";",3) D:Y'="" P5
|
|
P4 S N1=N1+FHPX1,N2=N2+FHPX1 ;S:FHPX1 ^TMP($J,"FH","T",K4,L1,P0)=FHPX1 Q
|
|
I FHPX1 S:'$D(^TMP($J,"FH","T",K4,L1,P0)) ^TMP($J,"FH","T",K4,L1,P0)=0 S ^TMP($J,"FH","T",K4,L1,P0)=^TMP($J,"FH","T",K4,L1,P0)+FHPX1
|
|
Q
|
|
P5 S:$E(Y,1)=T(P0) FHPX1=$J($E(Y,2,99)*FHPX1/100,0,0) Q
|
|
;
|
|
FHD ;get FHDA
|
|
S:$D(FHDA) FHDASV=FHDA
|
|
D E1^FHPRC1
|
|
I '$G(FHCY)!'$G(FHDA) S FHDA=FHDASV Q
|
|
S FHDA=^FH(116,FHCY,"DA",FHDA,0)
|
|
I $D(^FH(116.3,D1,0)) S X=^(0) F LL=2:1:4 I $P(X,"^",LL) S $P(FHDA,"^",LL)=$P(X,"^",LL)
|
|
Q
|
|
;
|
|
OUT ;process outpatient data
|
|
REC S FHTIM=D1-.000001,FHDT299=FHDT2+.99999
|
|
F FHIR=FHTIM:0 S FHIR=$O(^FHPT("RM",FHIR)) Q:(FHIR'>0)!(FHIR>(FHDT299)) F FHIDFN=0:0 S FHIDFN=$O(^FHPT("RM",FHIR,FHIDFN)) Q:FHIDFN'>0 D
|
|
.F FHIEN=0:0 S FHIEN=$O(^FHPT("RM",FHIR,FHIDFN,FHIEN)) Q:FHIEN'>0 D
|
|
..S FHPX1=FHIR\1
|
|
..S FHREDAT=$G(^FHPT(FHIDFN,"OP",FHIEN,0))
|
|
..Q:$P(FHREDAT,U,4)'=MEAL
|
|
..Q:$P(FHREDAT,U,15)="C"
|
|
..S FHLOC=$P(FHREDAT,U,3) Q:'$G(FHLOC)
|
|
..I $G(FHSITE),$P($G(^FH(119.6,FHLOC,0)),U,8)'=FHSITE Q
|
|
..S FHRDIET=$P(FHREDAT,U,2) Q:'$G(FHRDIET)
|
|
..S FHPDIET=$P($G(^FH(111,FHRDIET,0)),U,5)
|
|
..I $G(FHLOC) D
|
|
...S FHSER=$P($G(^FH(119.6,FHLOC,0)),U,5) S:$G(FHSER) SP(FHSER)=""
|
|
...I '$G(FHSER) S FHSER=$P($G(^FH(119.6,FHLOC,0)),U,6) S:$G(FHSER) SP(FHSER)=""
|
|
...I '$G(FHSER) S FHSER=$O(^FH(119.72,0)) S:$G(FHSER) SP(FHSER)=""
|
|
..Q:'$G(FHSER)
|
|
..I $D(^FH(119.72,FHSER,0)),$P(^FH(119.72,FHSER,0),U,3)'=FHP Q
|
|
..S FHDIET=$P($G(^FH(119.9,1,0)),U,2)
|
|
..S:'$D(P(FHPDIET,FHSER)) P(FHPDIET,FHSER)=0
|
|
..S P(FHPDIET,FHSER)=P(FHPDIET,FHSER)+1
|
|
..S:'$D(^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)) ^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)=0
|
|
..S ^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)=^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)+1
|
|
..S:'$D(P(.6,FHSER)) P(.6,FHSER)=0 S P(.6,FHSER)=P(.6,FHSER)+1
|
|
..;if tubefeeding and not cancelled, also count the TF data.
|
|
..I $D(^FHPT(FHIDFN,"OP",FHIEN,"TF")) D
|
|
...Q:$P(^FHPT(FHIDFN,"OP",FHIEN,3),U,5)="C"
|
|
...I '$D(P(.7,FHSER)) S P(.7,FHSER)=1
|
|
...E S P(.7,FHSER)=P(.7,FHSER)+1
|
|
...S:'$D(P(.6,FHSER)) P(.6,FHSER)=0 S P(.6,FHSER)=P(.6,FHSER)+1
|
|
;
|
|
SPEC ;process special meal
|
|
S FHITIM=D1-.00001
|
|
F FHI=FHITIM:0 S FHI=$O(^FHPT("SM",FHI)) Q:(FHI'>0)!(FHI>FHDT299) D
|
|
.F FHJ=0:0 S FHJ=$O(^FHPT("SM",FHI,FHJ)) Q:FHJ'>0 D
|
|
..S FHPX1=FHI\1
|
|
..S FHNODE=$G(^FHPT(FHJ,"SM",FHI,0))
|
|
..S FHSTAT=$P(FHNODE,U,2)
|
|
..I FHSTAT'="A",(FHSTAT'="P") Q
|
|
..S FHLPT=$P(FHNODE,U,3)
|
|
..S FHDIET=$P(FHNODE,U,4)
|
|
..S:'$G(FHDIET) FHDIET=$P($G(^FH(119.9,1,0)),U,2)
|
|
..I $G(FHDIET),$D(^FH(111,FHDIET,0)) S FHPDIET=$P(^FH(111,FHDIET,0),U,5)
|
|
..Q:'$G(FHPDIET)
|
|
..I $G(FHSITE) S FHCOM=$P(^FH(119.6,FHLPT,0),U,8) Q:FHSITE'=FHCOM
|
|
..S FHSER=""
|
|
..I $G(FHLPT) D
|
|
...S FHSER=$P($G(^FH(119.6,FHLPT,0)),U,5) S:$G(FHSER) SP(FHSER)=""
|
|
...I '$G(FHSER) S FHSER=$P($G(^FH(119.6,FHLPT,0)),U,6) S:$G(FHSER) SP(FHSER)=""
|
|
...I '$G(FHSER) S FHSER=$O(^FH(119.72,0)) S:$G(FHSER) SP(FHSER)=""
|
|
..Q:FHSER=""
|
|
..I $D(^FH(119.72,FHSER,0)),$P(^FH(119.72,FHSER,0),U,3)'=FHP Q
|
|
..S FHMEAL=$P(FHNODE,U,9)
|
|
..Q:FHMEAL'=MEAL
|
|
..S:'$D(P(FHPDIET,FHSER)) P(FHPDIET,FHSER)=0
|
|
..S P(FHPDIET,FHSER)=P(FHPDIET,FHSER)+1
|
|
..S:'$D(^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)) ^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)=0
|
|
..S ^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)=^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)+1
|
|
..;S:'$D(P(.6,FHSER)) P(.6,FHSER)=0 S P(.6,FHSER)=P(.6,FHSER)+1
|
|
;
|
|
GUEST ;process GUEST meal
|
|
F FHI=FHITIM:0 S FHI=$O(^FHPT("GM",FHI)) Q:(FHI'>0)!(FHI>FHDT299) D
|
|
.F FHJ=0:0 S FHJ=$O(^FHPT("GM",FHI,FHJ)) Q:FHJ'>0 D
|
|
..S FHPX1=FHI\1
|
|
..S FHNODE=$G(^FHPT(FHJ,"GM",FHI,0))
|
|
..S FHMEAL=$P(FHNODE,U,3)
|
|
..Q:FHMEAL'=MEAL
|
|
..Q:$P(FHNODE,U,9)="C"
|
|
..S FHLPT=$P(FHNODE,U,5)
|
|
..S FHDIET=$P(FHNODE,U,6)
|
|
..S:'$G(FHDIET) FHDIET=$P($G(^FH(119.9,1,0)),U,2)
|
|
..I $G(FHDIET),$D(^FH(111,FHDIET,0)) S FHPDIET=$P(^FH(111,FHDIET,0),U,5)
|
|
..Q:'$G(FHPDIET)
|
|
..I $G(FHSITE) S FHCOM=$P(^FH(119.6,FHLPT,0),U,8) Q:FHSITE'=FHCOM
|
|
..S FHSER=""
|
|
..I $G(FHLPT) D
|
|
...S FHSER=$P($G(^FH(119.6,FHLPT,0)),U,5) S:$G(FHSER) SP(FHSER)=""
|
|
...I '$G(FHSER) S FHSER=$P($G(^FH(119.6,FHLPT,0)),U,6) S:$G(FHSER) SP(FHSER)=""
|
|
...I '$G(FHSER) S FHSER=$O(^FH(119.72,0)) S:$G(FHSER) SP(FHSER)=""
|
|
..Q:FHSER=""
|
|
..I $D(^FH(119.72,FHSER,0)),$P(^FH(119.72,FHSER,0),U,3)'=FHP Q
|
|
..S:'$D(P(FHPDIET,FHSER)) P(FHPDIET,FHSER)=0
|
|
..S P(FHPDIET,FHSER)=P(FHPDIET,FHSER)+1
|
|
..S:'$D(^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)) ^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)=0
|
|
..S ^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)=^TMP($J,"FHD",FHPX1,FHSER,FHPDIET)+1
|
|
..;S:'$D(P(.6,FHSER)) P(.6,FHSER)=0 S P(.6,FHSER)=P(.6,FHSER)+1
|
|
Q
|