FHDCR11 ; HISC/REL/NCA/RVD - Build Diet Cards (Cont.) ;3/27/96 10:20
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
;patch #5 - added outpatient SO and fix diet pattern for outpatient.
BLD ; Build Diet Card list for a patient
S X1=$G(^FHPT(+FHDFN,"A",+ADM,0)),FHORD=$P(X1,"^",2),SVC=$P(X1,"^",5),SF=$P(X1,"^",7),IS=$P(X1,"^",10),FHD=$P(X1,"^",16),(FHOR,X)=""
I FHPAR'="Y" Q:SVC="C"
I SVC="C" S:SP'=SP1 SP=SP1 Q:'SP
Q:'FHORD S X=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
S MPD=$P(X,"^",13),FHOR=$P(X,"^",2,6) Q:"^^^^"[FHOR
I IS S IS=$G(^FH(119.4,+IS,0)) S:IS'="" SVC=SVC_"-"_$P(IS,"^",2)_$P(IS,"^",3)
S:SF SVC=SVC_" "_"SF"_"("_$S($P($G(^FHPT(FHDFN,"A",ADM,"SF",+SF,0)),"^",34)="Y":"M",1:"I")_")"
I UPD D OLD^FHMTK11 I OLD=FHOR S FLG2=0 D EVT^FHDCR2 Q:'FLG2
S STR=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,2))
S DPAT=$O(^FH(111.1,"AB",FHOR,0))
F MEAL="B","N","E" D
.K FP(MEAL),MP(MEAL),N2(MEAL) I $P(STR,";",$S(MEAL="B":1,MEAL="N":2,1:3))'="" D DECOD^FHDCR1B
.S PD=MPD
.I DPAT S PD=$P($G(^FH(111.1,DPAT,0)),"^",7) D
..I $P(STR,";",$S(MEAL="B":1,MEAL="N":2,1:3))="",$O(MP(MEAL,""))="" F X8=0:0 S X8=$O(^FH(111.1,DPAT,MEAL,X8)) Q:X8<1 S Z1=$G(^(X8,0)) D
...S ZZ=$G(^FH(114.1,+Z1,0)),NAM=$P(ZZ,"^",1)
...S K4=$P(ZZ,"^",3),K4=$S('K4:99,K4<10:"0"_K4,1:K4)
...S MP(MEAL,K4_"~"_+Z1_"~"_NAM)=$P(Z1,"^",2) Q
..Q
.Q:PD="" S PD=$P($G(^FH(116.2,PD,0)),"^",2) Q:PD=""
I NBR=2 D PRT^FHDCR1C K ^TMP($J,"MP"),^TMP($J,0),PP,S,TT S NBR=0
Q:PD="" S NBR=NBR+1 D PID^FHDPA
S Y0=$P($G(^DPT(DFN,0)),"^",1)_" ("_BID_")"_" "_SVC,N1=0,S(NBR)=0
D CUR^FHORD7
S N1=N1+1 I $L(Y)<60 S PP(N1,NBR)=Y
E S L=$S($L($P(Y,",",1,4))<60:4,1:3) S PP(N1,NBR)=$P(Y,",",1,L),N1=N1+1,PP(N1,NBR)=$E($P(Y,",",L+1,5),2,99)
S ^TMP($J,0,NBR)=Y0_"^"_WRDN_"^"_RM
I $G(DFN) D ALG^FHCLN S ALG="ALLGS.: "_$S(ALG="":"NONE ON FILE",1:ALG) S J=0 D BRK^FHDCR1B
S S(NBR)=S(NBR)+1
S ^TMP($J,"MP",S(NBR),NBR)=" Breakfast Noon Evening"
K NN F MEAL="B","N","E" D
.S X8="" F S X8=$O(MP(MEAL,X8)) Q:X8="" S X1=+$G(MP(MEAL,X8)) D
..;Q:'X1 S Z1=$P(X8,"~",2),QTY=$S(+X1#1>0:$J(+X1,3,1),1:+X1_" ")_" "
..Q:'X1 S Z1=$P(X8,"~",2),PAD=$E(" ",1,5-$L(X1)),QTY=+X1_PAD
..S NN(MEAL,X8)=QTY_$E($P(X8,"~",3),1,15)
..Q
.Q
K TT,SRT F MEAL="B","N","E" D
.S TT(MEAL)=0
.S X8="" F S X8=$O(NN(MEAL,X8)) Q:X8="" D
..S TT(MEAL)=TT(MEAL)+1,SRT(TT(MEAL),MEAL)=$G(NN(MEAL,X8)) Q
.D SO^FHDCR1B,DISL^FHDCR1B Q
F N1=1:1 Q:'$D(SRT(N1)) D
.S STR="" F MEAL="B","N","E" D
..I '$D(SRT(N1,MEAL)) S STR=STR_$J("",20) Q
..S STR=STR_SRT(N1,MEAL)
..S:MEAL'="E" STR=STR_$J("",20-$L(SRT(N1,MEAL)))
..Q
.S S(NBR)=S(NBR)+1
.S ^TMP($J,"MP",S(NBR),NBR)=STR
.Q
;
OUT ;OUTPATIENT data
S (SVC,SF,IS)=""
I '$D(FHKDAT)!'$G(FHADM) Q
S X1=FHKDAT
S FHWARD=W1 D LOC
S (FHOR,FHORD)=$P(FHKDAT,U,2),FHD=$P(X1,"^",14)
I FHPAR'="Y" Q:SVC="C"
I SVC="C" S:SP'=SP1 SP=SP1 Q:'SP
I FHORD="" S FHORD=$P(FHKDAT,U,7,11)
S:$D(^FHPT(FHDFN,0)) IS=$P(^FHPT(FHDFN,0),U,5)
I $D(^FHPT(FHDFN,"OP",FHADM,"SF",0)) S SF=$P(^(0),U,3)
I IS S IS=$G(^FH(119.4,+IS,0)) S:IS'="" SVC=SVC_"-"_$P(IS,"^",2)_$P(IS,"^",3)
I SF,$D(^FHPT(FHDFN,"OP",FHADM,"SF",SF,0)),'$P(^(0),U,32) S SVC=SVC_" "_"SF"_"("_$S($P($G(^FHPT(FHDFN,"OP",FHADM,"SF",SF,0)),"^",34)="Y":"M",1:"I")_")"
I UPD D OLD^FHMTK11 I OLD=FHOR S FLG2=0 D EVT^FHDCR2 Q:'FLG2
S STR=""
S:$G(FHOR) FHOR=FHOR_"^^^^"
I FHOR="" S FHOR=$P(FHKDAT,U,7,11)
;
S DPAT=$O(^FH(111.1,"AB",FHOR,0))
F MEAL="B","N","E" D
.Q:FHMEAL'=MEAL
.K FP(MEAL),MP(MEAL),N2(MEAL)
.S PD=""
.S:$G(MPD) PD=MPD
.I DPAT S PD=$P($G(^FH(111.1,DPAT,0)),"^",7) D
..F X8=0:0 S X8=$O(^FH(111.1,DPAT,MEAL,X8)) Q:X8<1 S Z1=$G(^(X8,0)) D
...S ZZ=$G(^FH(114.1,+Z1,0)),NAM=$P(ZZ,"^",1)
...S K4=$P(ZZ,"^",3),K4=$S('K4:99,K4<10:"0"_K4,1:K4)
...S MP(MEAL,K4_"~"_+Z1_"~"_NAM)=$P(Z1,"^",2)
..Q
.Q:PD="" S PD=$P($G(^FH(116.2,PD,0)),"^",2) Q:PD=""
I NBR=2 D PRT^FHDCR1C K ^TMP($J,"MP"),^TMP($J,0),PP,S,TT,SRT S (N1,NBR)=0
Q:PD="" S NBR=NBR+1 D PATNAME^FHOMUTL
S Y0=FHPTNM_" ("_FHBID_")"_" "_SVC,N1=0,S(NBR)=0,Y="***"
I '$G(FHDIET) S FHRNUM=FHKD D DIETPAT^FHOMRR1 S Y=$E(FHDIETP,1,18)
S:$G(FHDIET) Y=$P(^FH(111,FHDIET,0),U,7)
S N1=N1+1 I $L(Y)<60 S PP(N1,NBR)=Y
E S L=$S($L($P(Y,",",1,4))<60:4,1:3) S PP(N1,NBR)=$P(Y,",",1,L),N1=N1+1,PP(N1,NBR)=$E($P(Y,",",L+1,5),2,99)
S ^TMP($J,0,NBR)=Y0_"^"_WRDN_"^"_RM_"^^^^"_FHMEAL
I $G(DFN) D ALG^FHCLN S ALG="ALLGS.: "_$S(ALG="":"NONE ON FILE",1:ALG) S J=0 D BRK^FHDCR1B
S S(NBR)=S(NBR)+1
S ^TMP($J,"MP",S(NBR),NBR)=" Breakfast Noon Evening"
K NN F MEAL="B","N","E" D
.S X8="" F S X8=$O(MP(MEAL,X8)) Q:X8="" S X1=+$G(MP(MEAL,X8)) D
..;Q:'X1 S Z1=$P(X8,"~",2),QTY=$S(+X1#1>0:$J(+X1,3,1),1:+X1_" ")_" "
..Q:'X1 S Z1=$P(X8,"~",2),PAD=$E(" ",1,5-$L(X1)),QTY=+X1_PAD
..S NN(MEAL,X8)=QTY_$E($P(X8,"~",3),1,15)
..Q
.Q
K TT,SRT F MEAL="B","N","E" D
.S TT(MEAL)=0
.S X8="" F S X8=$O(NN(MEAL,X8)) Q:X8="" D
..S TT(MEAL)=TT(MEAL)+1,SRT(TT(MEAL),MEAL)=$G(NN(MEAL,X8)) Q
.D SOUT^FHDCR1B,DISL^FHDCR1B
;
F N1=1:1 Q:'$D(SRT(N1)) D
.S STR="" F MEAL="B","N","E" D
..I '$D(SRT(N1,MEAL))!(MEAL'=FHMEAL) S STR=STR_$J("",20) Q
..S STR=STR_SRT(N1,MEAL)
..S:MEAL'="E" STR=STR_$J("",20-$L(SRT(N1,MEAL)))
..Q
.S S(NBR)=S(NBR)+1
.S ^TMP($J,"MP",S(NBR),NBR)=STR
.Q
Q
;
LOC ;get location info
I $G(FHWARD),$D(^FH(119.6,FHWARD,0)) S FHWDAT=^FH(119.6,FHWARD,0) D
.S FHWT=$P(FHWDAT,U,5)
.S FHWC=$P(FHWDAT,U,6)
.S FHWD=$P(FHWDAT,U,7)
.I $G(FHWT),$D(^FH(119.72,FHWT,0)) S SVC=$P(^FH(119.72,FHWT,0),U,2)
.I $G(FHWC),$D(^FH(119.72,FHWC,0)) S SVC=$P(^FH(119.72,FHWC,0),U,2)
.I FHRGS="OP" D
..S (FHOR,FHDIET)=$P(FHKDAT,U,2)
.I FHRGS="GM" D
..S FHDIET=$P(FHKDAT,U,6)
.I FHRGS="SM" D
..S FHDIET=$P(FHKDAT,U,4)
.S:$G(FHDIET) MPD=$P(^FH(111,FHDIET,0),U,5)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHDCR11 5860 printed Nov 22, 2024@16:57:36 Page 2
FHDCR11 ; HISC/REL/NCA/RVD - Build Diet Cards (Cont.) ;3/27/96 10:20
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 ;patch #5 - added outpatient SO and fix diet pattern for outpatient.
BLD ; Build Diet Card list for a patient
+1 SET X1=$GET(^FHPT(+FHDFN,"A",+ADM,0))
SET FHORD=$PIECE(X1,"^",2)
SET SVC=$PIECE(X1,"^",5)
SET SF=$PIECE(X1,"^",7)
SET IS=$PIECE(X1,"^",10)
SET FHD=$PIECE(X1,"^",16)
SET (FHOR,X)=""
+2 IF FHPAR'="Y"
if SVC="C"
QUIT
+3 IF SVC="C"
if SP'=SP1
SET SP=SP1
if 'SP
QUIT
+4 if 'FHORD
QUIT
SET X=$GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
+5 SET MPD=$PIECE(X,"^",13)
SET FHOR=$PIECE(X,"^",2,6)
if "^^^^"[FHOR
QUIT
+6 IF IS
SET IS=$GET(^FH(119.4,+IS,0))
if IS'=""
SET SVC=SVC_"-"_$PIECE(IS,"^",2)_$PIECE(IS,"^",3)
+7 if SF
SET SVC=SVC_" "_"SF"_"("_$SELECT($PIECE($GET(^FHPT(FHDFN,"A",ADM,"SF",+SF,0)),"^",34)="Y":"M",1:"I")_")"
+8 IF UPD
DO OLD^FHMTK11
IF OLD=FHOR
SET FLG2=0
DO EVT^FHDCR2
if 'FLG2
QUIT
+9 SET STR=$GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,2))
+10 SET DPAT=$ORDER(^FH(111.1,"AB",FHOR,0))
+11 FOR MEAL="B","N","E"
Begin DoDot:1
+12 KILL FP(MEAL),MP(MEAL),N2(MEAL)
IF $PIECE(STR,";",$SELECT(MEAL="B":1,MEAL="N":2,1:3))'=""
DO DECOD^FHDCR1B
+13 SET PD=MPD
+14 IF DPAT
SET PD=$PIECE($GET(^FH(111.1,DPAT,0)),"^",7)
Begin DoDot:2
+15 IF $PIECE(STR,";",$SELECT(MEAL="B":1,MEAL="N":2,1:3))=""
IF $ORDER(MP(MEAL,""))=""
FOR X8=0:0
SET X8=$ORDER(^FH(111.1,DPAT,MEAL,X8))
if X8<1
QUIT
SET Z1=$GET(^(X8,0))
Begin DoDot:3
+16 SET ZZ=$GET(^FH(114.1,+Z1,0))
SET NAM=$PIECE(ZZ,"^",1)
+17 SET K4=$PIECE(ZZ,"^",3)
SET K4=$SELECT('K4:99,K4<10:"0"_K4,1:K4)
+18 SET MP(MEAL,K4_"~"_+Z1_"~"_NAM)=$PIECE(Z1,"^",2)
QUIT
End DoDot:3
+19 QUIT
End DoDot:2
+20 if PD=""
QUIT
SET PD=$PIECE($GET(^FH(116.2,PD,0)),"^",2)
if PD=""
QUIT
End DoDot:1
+21 IF NBR=2
DO PRT^FHDCR1C
KILL ^TMP($JOB,"MP"),^TMP($JOB,0),PP,S,TT
SET NBR=0
+22 if PD=""
QUIT
SET NBR=NBR+1
DO PID^FHDPA
+23 SET Y0=$PIECE($GET(^DPT(DFN,0)),"^",1)_" ("_BID_")"_" "_SVC
SET N1=0
SET S(NBR)=0
+24 DO CUR^FHORD7
+25 SET N1=N1+1
IF $LENGTH(Y)<60
SET PP(N1,NBR)=Y
+26 IF '$TEST
SET L=$SELECT($LENGTH($PIECE(Y,",",1,4))<60:4,1:3)
SET PP(N1,NBR)=$PIECE(Y,",",1,L)
SET N1=N1+1
SET PP(N1,NBR)=$EXTRACT($PIECE(Y,",",L+1,5),2,99)
+27 SET ^TMP($JOB,0,NBR)=Y0_"^"_WRDN_"^"_RM
+28 IF $GET(DFN)
DO ALG^FHCLN
SET ALG="ALLGS.: "_$SELECT(ALG="":"NONE ON FILE",1:ALG)
SET J=0
DO BRK^FHDCR1B
+29 SET S(NBR)=S(NBR)+1
+30 SET ^TMP($JOB,"MP",S(NBR),NBR)=" Breakfast Noon Evening"
+31 KILL NN
FOR MEAL="B","N","E"
Begin DoDot:1
+32 SET X8=""
FOR
SET X8=$ORDER(MP(MEAL,X8))
if X8=""
QUIT
SET X1=+$GET(MP(MEAL,X8))
Begin DoDot:2
+33 ;Q:'X1 S Z1=$P(X8,"~",2),QTY=$S(+X1#1>0:$J(+X1,3,1),1:+X1_" ")_" "
+34 if 'X1
QUIT
SET Z1=$PIECE(X8,"~",2)
SET PAD=$EXTRACT(" ",1,5-$LENGTH(X1))
SET QTY=+X1_PAD
+35 SET NN(MEAL,X8)=QTY_$EXTRACT($PIECE(X8,"~",3),1,15)
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 KILL TT,SRT
FOR MEAL="B","N","E"
Begin DoDot:1
+39 SET TT(MEAL)=0
+40 SET X8=""
FOR
SET X8=$ORDER(NN(MEAL,X8))
if X8=""
QUIT
Begin DoDot:2
+41 SET TT(MEAL)=TT(MEAL)+1
SET SRT(TT(MEAL),MEAL)=$GET(NN(MEAL,X8))
QUIT
End DoDot:2
+42 DO SO^FHDCR1B
DO DISL^FHDCR1B
QUIT
End DoDot:1
+43 FOR N1=1:1
if '$DATA(SRT(N1))
QUIT
Begin DoDot:1
+44 SET STR=""
FOR MEAL="B","N","E"
Begin DoDot:2
+45 IF '$DATA(SRT(N1,MEAL))
SET STR=STR_$JUSTIFY("",20)
QUIT
+46 SET STR=STR_SRT(N1,MEAL)
+47 if MEAL'="E"
SET STR=STR_$JUSTIFY("",20-$LENGTH(SRT(N1,MEAL)))
+48 QUIT
End DoDot:2
+49 SET S(NBR)=S(NBR)+1
+50 SET ^TMP($JOB,"MP",S(NBR),NBR)=STR
+51 QUIT
End DoDot:1
+52 ;
OUT ;OUTPATIENT data
+1 SET (SVC,SF,IS)=""
+2 IF '$DATA(FHKDAT)!'$GET(FHADM)
QUIT
+3 SET X1=FHKDAT
+4 SET FHWARD=W1
DO LOC
+5 SET (FHOR,FHORD)=$PIECE(FHKDAT,U,2)
SET FHD=$PIECE(X1,"^",14)
+6 IF FHPAR'="Y"
if SVC="C"
QUIT
+7 IF SVC="C"
if SP'=SP1
SET SP=SP1
if 'SP
QUIT
+8 IF FHORD=""
SET FHORD=$PIECE(FHKDAT,U,7,11)
+9 if $DATA(^FHPT(FHDFN,0))
SET IS=$PIECE(^FHPT(FHDFN,0),U,5)
+10 IF $DATA(^FHPT(FHDFN,"OP",FHADM,"SF",0))
SET SF=$PIECE(^(0),U,3)
+11 IF IS
SET IS=$GET(^FH(119.4,+IS,0))
if IS'=""
SET SVC=SVC_"-"_$PIECE(IS,"^",2)_$PIECE(IS,"^",3)
+12 IF SF
IF $DATA(^FHPT(FHDFN,"OP",FHADM,"SF",SF,0))
IF '$PIECE(^(0),U,32)
SET SVC=SVC_" "_"SF"_"("_$SELECT($PIECE($GET(^FHPT(FHDFN,"OP",FHADM,"SF",SF,0)),"^",34)="Y":"M",1:"I")_")"
+13 IF UPD
DO OLD^FHMTK11
IF OLD=FHOR
SET FLG2=0
DO EVT^FHDCR2
if 'FLG2
QUIT
+14 SET STR=""
+15 if $GET(FHOR)
SET FHOR=FHOR_"^^^^"
+16 IF FHOR=""
SET FHOR=$PIECE(FHKDAT,U,7,11)
+17 ;
+18 SET DPAT=$ORDER(^FH(111.1,"AB",FHOR,0))
+19 FOR MEAL="B","N","E"
Begin DoDot:1
+20 if FHMEAL'=MEAL
QUIT
+21 KILL FP(MEAL),MP(MEAL),N2(MEAL)
+22 SET PD=""
+23 if $GET(MPD)
SET PD=MPD
+24 IF DPAT
SET PD=$PIECE($GET(^FH(111.1,DPAT,0)),"^",7)
Begin DoDot:2
+25 FOR X8=0:0
SET X8=$ORDER(^FH(111.1,DPAT,MEAL,X8))
if X8<1
QUIT
SET Z1=$GET(^(X8,0))
Begin DoDot:3
+26 SET ZZ=$GET(^FH(114.1,+Z1,0))
SET NAM=$PIECE(ZZ,"^",1)
+27 SET K4=$PIECE(ZZ,"^",3)
SET K4=$SELECT('K4:99,K4<10:"0"_K4,1:K4)
+28 SET MP(MEAL,K4_"~"_+Z1_"~"_NAM)=$PIECE(Z1,"^",2)
End DoDot:3
+29 QUIT
End DoDot:2
+30 if PD=""
QUIT
SET PD=$PIECE($GET(^FH(116.2,PD,0)),"^",2)
if PD=""
QUIT
End DoDot:1
+31 IF NBR=2
DO PRT^FHDCR1C
KILL ^TMP($JOB,"MP"),^TMP($JOB,0),PP,S,TT,SRT
SET (N1,NBR)=0
+32 if PD=""
QUIT
SET NBR=NBR+1
DO PATNAME^FHOMUTL
+33 SET Y0=FHPTNM_" ("_FHBID_")"_" "_SVC
SET N1=0
SET S(NBR)=0
SET Y="***"
+34 IF '$GET(FHDIET)
SET FHRNUM=FHKD
DO DIETPAT^FHOMRR1
SET Y=$EXTRACT(FHDIETP,1,18)
+35 if $GET(FHDIET)
SET Y=$PIECE(^FH(111,FHDIET,0),U,7)
+36 SET N1=N1+1
IF $LENGTH(Y)<60
SET PP(N1,NBR)=Y
+37 IF '$TEST
SET L=$SELECT($LENGTH($PIECE(Y,",",1,4))<60:4,1:3)
SET PP(N1,NBR)=$PIECE(Y,",",1,L)
SET N1=N1+1
SET PP(N1,NBR)=$EXTRACT($PIECE(Y,",",L+1,5),2,99)
+38 SET ^TMP($JOB,0,NBR)=Y0_"^"_WRDN_"^"_RM_"^^^^"_FHMEAL
+39 IF $GET(DFN)
DO ALG^FHCLN
SET ALG="ALLGS.: "_$SELECT(ALG="":"NONE ON FILE",1:ALG)
SET J=0
DO BRK^FHDCR1B
+40 SET S(NBR)=S(NBR)+1
+41 SET ^TMP($JOB,"MP",S(NBR),NBR)=" Breakfast Noon Evening"
+42 KILL NN
FOR MEAL="B","N","E"
Begin DoDot:1
+43 SET X8=""
FOR
SET X8=$ORDER(MP(MEAL,X8))
if X8=""
QUIT
SET X1=+$GET(MP(MEAL,X8))
Begin DoDot:2
+44 ;Q:'X1 S Z1=$P(X8,"~",2),QTY=$S(+X1#1>0:$J(+X1,3,1),1:+X1_" ")_" "
+45 if 'X1
QUIT
SET Z1=$PIECE(X8,"~",2)
SET PAD=$EXTRACT(" ",1,5-$LENGTH(X1))
SET QTY=+X1_PAD
+46 SET NN(MEAL,X8)=QTY_$EXTRACT($PIECE(X8,"~",3),1,15)
+47 QUIT
End DoDot:2
+48 QUIT
End DoDot:1
+49 KILL TT,SRT
FOR MEAL="B","N","E"
Begin DoDot:1
+50 SET TT(MEAL)=0
+51 SET X8=""
FOR
SET X8=$ORDER(NN(MEAL,X8))
if X8=""
QUIT
Begin DoDot:2
+52 SET TT(MEAL)=TT(MEAL)+1
SET SRT(TT(MEAL),MEAL)=$GET(NN(MEAL,X8))
QUIT
End DoDot:2
+53 DO SOUT^FHDCR1B
DO DISL^FHDCR1B
End DoDot:1
+54 ;
+55 FOR N1=1:1
if '$DATA(SRT(N1))
QUIT
Begin DoDot:1
+56 SET STR=""
FOR MEAL="B","N","E"
Begin DoDot:2
+57 IF '$DATA(SRT(N1,MEAL))!(MEAL'=FHMEAL)
SET STR=STR_$JUSTIFY("",20)
QUIT
+58 SET STR=STR_SRT(N1,MEAL)
+59 if MEAL'="E"
SET STR=STR_$JUSTIFY("",20-$LENGTH(SRT(N1,MEAL)))
+60 QUIT
End DoDot:2
+61 SET S(NBR)=S(NBR)+1
+62 SET ^TMP($JOB,"MP",S(NBR),NBR)=STR
+63 QUIT
End DoDot:1
+64 QUIT
+65 ;
LOC ;get location info
+1 IF $GET(FHWARD)
IF $DATA(^FH(119.6,FHWARD,0))
SET FHWDAT=^FH(119.6,FHWARD,0)
Begin DoDot:1
+2 SET FHWT=$PIECE(FHWDAT,U,5)
+3 SET FHWC=$PIECE(FHWDAT,U,6)
+4 SET FHWD=$PIECE(FHWDAT,U,7)
+5 IF $GET(FHWT)
IF $DATA(^FH(119.72,FHWT,0))
SET SVC=$PIECE(^FH(119.72,FHWT,0),U,2)
+6 IF $GET(FHWC)
IF $DATA(^FH(119.72,FHWC,0))
SET SVC=$PIECE(^FH(119.72,FHWC,0),U,2)
+7 IF FHRGS="OP"
Begin DoDot:2
+8 SET (FHOR,FHDIET)=$PIECE(FHKDAT,U,2)
End DoDot:2
+9 IF FHRGS="GM"
Begin DoDot:2
+10 SET FHDIET=$PIECE(FHKDAT,U,6)
End DoDot:2
+11 IF FHRGS="SM"
Begin DoDot:2
+12 SET FHDIET=$PIECE(FHKDAT,U,4)
End DoDot:2
+13 if $GET(FHDIET)
SET MPD=$PIECE(^FH(111,FHDIET,0),U,5)
End DoDot:1
+14 QUIT
