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