- 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
- 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