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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRO3 6473 printed Oct 16, 2024@17:55:26 Page 2
FHPRO3 ; HISC/REL/RVD - Recipe Calculations ;4/14/95 08:05
+1 ;;5.5;DIETETICS;**3,5**;Jan 28, 2005;Build 53
+2 ;RVD 5/20/05 - as part of AFP project.
+3 ;patch #5 -added a screen for cancelled quest meals.
+4 KILL ^TMP($JOB,"FH","T"),P,T
+5 IF '$GET(FHAFLG)
KILL ^TMP($JOB,"AFP","T")
+6 ;S K3=$F("BNE",MEAL)-1,FHX1=$P(FHDA,"^",K3+1) Q:'FHX1
+7 FOR L1=0:0
SET L1=$ORDER(^FH(116.2,L1))
if L1<1
QUIT
SET Z=$PIECE($GET(^(L1,0)),"^",2)
IF Z'=""
SET P(Z)=L1
+8 FOR P0=0:0
SET P0=$ORDER(^TMP($JOB,"FH",P0))
if P0<1
QUIT
SET Z=$PIECE($GET(^FH(119.72,P0,0)),"^",2)
IF Z'=""
SET T(P0)=Z
+9 DO P1
+10 SET FHAFLG=1
+11 GOTO ^FHPRO4
P1 FOR FHI=0:0
SET FHI=$ORDER(FHDODAY(FHI))
if FHI'>0
QUIT
SET (D1,X1)=FHDODAY(FHI)
DO FHD
DO P12
+1 KILL M,P,T,Y,Z,Z1
QUIT
P12 SET K3=$FIND("BNE",MEAL)-1
SET FHX1=$PIECE(FHDA,"^",K3+1)
if 'FHX1
QUIT
+1 if '$DATA(^FH(116.1,FHX1))
QUIT
+2 FOR M=0:0
SET M=$ORDER(^FH(116.1,FHX1,"RE",M))
if M<1
QUIT
SET L1=^(M,0)
SET L1=+L1
DO P2
+3 QUIT
P2 SET N1=0
SET X=$GET(^FH(114,L1,0))
SET K4=$PIECE(X,"^",12)
SET K4=$SELECT($DATA(^FH(114.2,+K4,0)):$PIECE(^(0),"^",3),1:99)
+1 ;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)
+2 ;S FHPD=$P(LL,"^",2),LL=+LL
+3 ;S LL=$S($D(^FH(114.1,+LL,0)):$P(^(0),"^",3),1:99)
+4 ;
+5 SET LL=$PIECE(X,"^",7)
+6 IF $GET(LL)
SET LL=$SELECT($DATA(^FH(114.1,+LL,0)):$PIECE(^(0),"^",3),1:99)
+7 SET K4=$SELECT(K4<1:99,K4<10:"0"_K4,1:K4)_$SELECT(LL<1:99,LL<10:"0"_LL,1:LL)_$EXTRACT($PIECE(X,"^",1),1,26)
+8 ;I N2 S ^TMP($J,"FH","T",K4,L1,P0)=N2,^TMP($J,"AFP","T",K4,L1,P0)=N2
FOR P0=0:0
SET P0=$ORDER(^TMP($JOB,"FHD",D1,P0))
if P0<1
QUIT
DO R1
+9 if 'N1
QUIT
if '$GET(^TMP($JOB,"FH","T",K4,L1))
SET ^TMP($JOB,"FH","T",K4,L1)=0
SET ^(L1)=^(L1)+N1
+10 if '$GET(^TMP($JOB,"AFP","T",K4,L1))
SET ^TMP($JOB,"AFP","T",K4,L1)=0
SET ^(L1)=^(L1)+N1
+11 QUIT
R1 SET Z1=$PIECE($GET(^FH(116.1,FHX1,"RE",M,"D",P0,0)),"^",2)
SET N2=0
+1 FOR CAT=0:0
SET CAT=$ORDER(^FH(116.1,FHX1,"RE",M,"R",CAT))
if CAT<1
QUIT
SET FHPD=$PIECE($GET(^(CAT,0)),"^",2)
Begin DoDot:1
+2 FOR LL=1:1
SET FHX2=$PIECE(FHPD," ",LL)
if FHX2=""
QUIT
SET X=$PIECE(FHX2,";",1)
IF X'=""
IF $DATA(P(X))
DO P3
+3 QUIT
End DoDot:1
+4 QUIT
P3 SET FHPX1=$GET(^TMP($JOB,"FHD",D1,P0,P(X)))
if 'FHPX1
QUIT
+1 SET Y=$PIECE(FHX2,";",2)
IF Y=""
if Z1'=""
SET FHPX1=$JUSTIFY(Z1*FHPX1/100,0,0)
GOTO P4
+2 DO P5
SET Y=$PIECE(FHX2,";",3)
if Y'=""
DO P5
P4 ;S:FHPX1 ^TMP($J,"FH","T",K4,L1,P0)=FHPX1 Q
SET N1=N1+FHPX1
SET N2=N2+FHPX1
+1 IF FHPX1
if '$DATA(^TMP($JOB,"FH","T",K4,L1,P0))
SET ^TMP($JOB,"FH","T",K4,L1,P0)=0
SET ^TMP($JOB,"FH","T",K4,L1,P0)=^TMP($JOB,"FH","T",K4,L1,P0)+FHPX1
+2 QUIT
P5 if $EXTRACT(Y,1)=T(P0)
SET FHPX1=$JUSTIFY($EXTRACT(Y,2,99)*FHPX1/100,0,0)
QUIT
+1 ;
FHD ;get FHDA
+1 if $DATA(FHDA)
SET FHDASV=FHDA
+2 DO E1^FHPRC1
+3 IF '$GET(FHCY)!'$GET(FHDA)
SET FHDA=FHDASV
QUIT
+4 SET FHDA=^FH(116,FHCY,"DA",FHDA,0)
+5 IF $DATA(^FH(116.3,D1,0))
SET X=^(0)
FOR LL=2:1:4
IF $PIECE(X,"^",LL)
SET $PIECE(FHDA,"^",LL)=$PIECE(X,"^",LL)
+6 QUIT
+7 ;
OUT ;process outpatient data
REC SET FHTIM=D1-.000001
SET FHDT299=FHDT2+.99999
+1 FOR FHIR=FHTIM:0
SET FHIR=$ORDER(^FHPT("RM",FHIR))
if (FHIR'>0)!(FHIR>(FHDT299))
QUIT
FOR FHIDFN=0:0
SET FHIDFN=$ORDER(^FHPT("RM",FHIR,FHIDFN))
if FHIDFN'>0
QUIT
Begin DoDot:1
+2 FOR FHIEN=0:0
SET FHIEN=$ORDER(^FHPT("RM",FHIR,FHIDFN,FHIEN))
if FHIEN'>0
QUIT
Begin DoDot:2
+3 SET FHPX1=FHIR\1
+4 SET FHREDAT=$GET(^FHPT(FHIDFN,"OP",FHIEN,0))
+5 if $PIECE(FHREDAT,U,4)'=MEAL
QUIT
+6 if $PIECE(FHREDAT,U,15)="C"
QUIT
+7 SET FHLOC=$PIECE(FHREDAT,U,3)
if '$GET(FHLOC)
QUIT
+8 IF $GET(FHSITE)
IF $PIECE($GET(^FH(119.6,FHLOC,0)),U,8)'=FHSITE
QUIT
+9 SET FHRDIET=$PIECE(FHREDAT,U,2)
if '$GET(FHRDIET)
QUIT
+10 SET FHPDIET=$PIECE($GET(^FH(111,FHRDIET,0)),U,5)
+11 IF $GET(FHLOC)
Begin DoDot:3
+12 SET FHSER=$PIECE($GET(^FH(119.6,FHLOC,0)),U,5)
if $GET(FHSER)
SET SP(FHSER)=""
+13 IF '$GET(FHSER)
SET FHSER=$PIECE($GET(^FH(119.6,FHLOC,0)),U,6)
if $GET(FHSER)
SET SP(FHSER)=""
+14 IF '$GET(FHSER)
SET FHSER=$ORDER(^FH(119.72,0))
if $GET(FHSER)
SET SP(FHSER)=""
End DoDot:3
+15 if '$GET(FHSER)
QUIT
+16 IF $DATA(^FH(119.72,FHSER,0))
IF $PIECE(^FH(119.72,FHSER,0),U,3)'=FHP
QUIT
+17 SET FHDIET=$PIECE($GET(^FH(119.9,1,0)),U,2)
+18 if '$DATA(P(FHPDIET,FHSER))
SET P(FHPDIET,FHSER)=0
+19 SET P(FHPDIET,FHSER)=P(FHPDIET,FHSER)+1
+20 if '$DATA(^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET))
SET ^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)=0
+21 SET ^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)=^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)+1
+22 if '$DATA(P(.6,FHSER))
SET P(.6,FHSER)=0
SET P(.6,FHSER)=P(.6,FHSER)+1
+23 ;if tubefeeding and not cancelled, also count the TF data.
+24 IF $DATA(^FHPT(FHIDFN,"OP",FHIEN,"TF"))
Begin DoDot:3
+25 if $PIECE(^FHPT(FHIDFN,"OP",FHIEN,3),U,5)="C"
QUIT
+26 IF '$DATA(P(.7,FHSER))
SET P(.7,FHSER)=1
+27 IF '$TEST
SET P(.7,FHSER)=P(.7,FHSER)+1
+28 if '$DATA(P(.6,FHSER))
SET P(.6,FHSER)=0
SET P(.6,FHSER)=P(.6,FHSER)+1
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
SPEC ;process special meal
+1 SET FHITIM=D1-.00001
+2 FOR FHI=FHITIM:0
SET FHI=$ORDER(^FHPT("SM",FHI))
if (FHI'>0)!(FHI>FHDT299)
QUIT
Begin DoDot:1
+3 FOR FHJ=0:0
SET FHJ=$ORDER(^FHPT("SM",FHI,FHJ))
if FHJ'>0
QUIT
Begin DoDot:2
+4 SET FHPX1=FHI\1
+5 SET FHNODE=$GET(^FHPT(FHJ,"SM",FHI,0))
+6 SET FHSTAT=$PIECE(FHNODE,U,2)
+7 IF FHSTAT'="A"
IF (FHSTAT'="P")
QUIT
+8 SET FHLPT=$PIECE(FHNODE,U,3)
+9 SET FHDIET=$PIECE(FHNODE,U,4)
+10 if '$GET(FHDIET)
SET FHDIET=$PIECE($GET(^FH(119.9,1,0)),U,2)
+11 IF $GET(FHDIET)
IF $DATA(^FH(111,FHDIET,0))
SET FHPDIET=$PIECE(^FH(111,FHDIET,0),U,5)
+12 if '$GET(FHPDIET)
QUIT
+13 IF $GET(FHSITE)
SET FHCOM=$PIECE(^FH(119.6,FHLPT,0),U,8)
if FHSITE'=FHCOM
QUIT
+14 SET FHSER=""
+15 IF $GET(FHLPT)
Begin DoDot:3
+16 SET FHSER=$PIECE($GET(^FH(119.6,FHLPT,0)),U,5)
if $GET(FHSER)
SET SP(FHSER)=""
+17 IF '$GET(FHSER)
SET FHSER=$PIECE($GET(^FH(119.6,FHLPT,0)),U,6)
if $GET(FHSER)
SET SP(FHSER)=""
+18 IF '$GET(FHSER)
SET FHSER=$ORDER(^FH(119.72,0))
if $GET(FHSER)
SET SP(FHSER)=""
End DoDot:3
+19 if FHSER=""
QUIT
+20 IF $DATA(^FH(119.72,FHSER,0))
IF $PIECE(^FH(119.72,FHSER,0),U,3)'=FHP
QUIT
+21 SET FHMEAL=$PIECE(FHNODE,U,9)
+22 if FHMEAL'=MEAL
QUIT
+23 if '$DATA(P(FHPDIET,FHSER))
SET P(FHPDIET,FHSER)=0
+24 SET P(FHPDIET,FHSER)=P(FHPDIET,FHSER)+1
+25 if '$DATA(^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET))
SET ^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)=0
+26 SET ^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)=^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)+1
+27 ;S:'$D(P(.6,FHSER)) P(.6,FHSER)=0 S P(.6,FHSER)=P(.6,FHSER)+1
End DoDot:2
End DoDot:1
+28 ;
GUEST ;process GUEST meal
+1 FOR FHI=FHITIM:0
SET FHI=$ORDER(^FHPT("GM",FHI))
if (FHI'>0)!(FHI>FHDT299)
QUIT
Begin DoDot:1
+2 FOR FHJ=0:0
SET FHJ=$ORDER(^FHPT("GM",FHI,FHJ))
if FHJ'>0
QUIT
Begin DoDot:2
+3 SET FHPX1=FHI\1
+4 SET FHNODE=$GET(^FHPT(FHJ,"GM",FHI,0))
+5 SET FHMEAL=$PIECE(FHNODE,U,3)
+6 if FHMEAL'=MEAL
QUIT
+7 if $PIECE(FHNODE,U,9)="C"
QUIT
+8 SET FHLPT=$PIECE(FHNODE,U,5)
+9 SET FHDIET=$PIECE(FHNODE,U,6)
+10 if '$GET(FHDIET)
SET FHDIET=$PIECE($GET(^FH(119.9,1,0)),U,2)
+11 IF $GET(FHDIET)
IF $DATA(^FH(111,FHDIET,0))
SET FHPDIET=$PIECE(^FH(111,FHDIET,0),U,5)
+12 if '$GET(FHPDIET)
QUIT
+13 IF $GET(FHSITE)
SET FHCOM=$PIECE(^FH(119.6,FHLPT,0),U,8)
if FHSITE'=FHCOM
QUIT
+14 SET FHSER=""
+15 IF $GET(FHLPT)
Begin DoDot:3
+16 SET FHSER=$PIECE($GET(^FH(119.6,FHLPT,0)),U,5)
if $GET(FHSER)
SET SP(FHSER)=""
+17 IF '$GET(FHSER)
SET FHSER=$PIECE($GET(^FH(119.6,FHLPT,0)),U,6)
if $GET(FHSER)
SET SP(FHSER)=""
+18 IF '$GET(FHSER)
SET FHSER=$ORDER(^FH(119.72,0))
if $GET(FHSER)
SET SP(FHSER)=""
End DoDot:3
+19 if FHSER=""
QUIT
+20 IF $DATA(^FH(119.72,FHSER,0))
IF $PIECE(^FH(119.72,FHSER,0),U,3)'=FHP
QUIT
+21 if '$DATA(P(FHPDIET,FHSER))
SET P(FHPDIET,FHSER)=0
+22 SET P(FHPDIET,FHSER)=P(FHPDIET,FHSER)+1
+23 if '$DATA(^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET))
SET ^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)=0
+24 SET ^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)=^TMP($JOB,"FHD",FHPX1,FHSER,FHPDIET)+1
+25 ;S:'$D(P(.6,FHSER)) P(.6,FHSER)=0 S P(.6,FHSER)=P(.6,FHSER)+1
End DoDot:2
End DoDot:1
+26 QUIT
