FHOMELT ;Hines OIFO/RTK OUTPATIENT MEALS LIST EARLY/LATE TRAYS ;5/10/04 12:35
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
;patch #5 - added outpt room-bed.
;
; FHP=PTR to COMM OFFICE, DTE=DATE in FILEMAN FORMAT, MEAL=B,N,E or A
;K ^TMP($J)
S X1=DTE,X2=-1 D C^%DTC S FHRMDTE=X,X1=DTE,X2=1 D C^%DTC S FHDTQ=X
F FHOMDT=FHRMDTE:0 S FHOMDT=$O(^FHPT("RM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHDTQ) D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHOMDT,FHDFN)) Q:FHDFN="" D
..F FHRNUM=0:0 S FHRNUM=$O(^FHPT("RM",FHOMDT,FHDFN,FHRNUM)) Q:FHRNUM="" D
...I '$D(^FHPT(FHDFN,"OP",FHRNUM,2)) Q
...S FHELN0=$G(^FHPT(FHDFN,"OP",FHRNUM,0))
...S FHELN2=$G(^FHPT(FHDFN,"OP",FHRNUM,2))
...I $P(FHELN0,U,15)="C" Q
...I $P(FHELN2,U,6)="C" Q
...S FHLOC=$P(FHELN0,U,3) I FHLOC="" Q
...S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHCOMM="" Q
...S FHMEAL=$P(FHELN0,U,4) I MEAL'="A",MEAL'=FHMEAL Q
...I FHP>0,FHP'=FHCOMM Q
...S RM=$P(FHELN0,U,18)
...I $G(RM),$D(^DG(405.4,RM,0)) S RM=$P(^DG(405.4,RM,0),U,1)
...S FHMLTM=$P(FHELN2,U,1),FHBAG=$P(FHELN2,U,2)
...I $P($G(^FH(119.6,FHLOC,1)),U,4)="Y" D DIETPAT^FHOMRR1 S FHDIET=FHDIETP
...I $P($G(^FH(119.6,FHLOC,1)),U,4)'="Y" S FHDIET=$P(FHELN0,U,2) I FHDIET'="" S FHDIET=$P($G(^FH(111,FHDIET,0)),U,1)
...D PATNAME^FHOMUTL
...S ^TMP($J,FHMEAL,FHMLTM_"~"_FHPTNM)=FHLOC_"^"_FHDFN_"^"_FHBAG_"^"_FHDIET_"^"_$E(RM,1,10)
...Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMELT 1379 printed Dec 13, 2024@01:52:44 Page 2
FHOMELT ;Hines OIFO/RTK OUTPATIENT MEALS LIST EARLY/LATE TRAYS ;5/10/04 12:35
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 ;patch #5 - added outpt room-bed.
+3 ;
+4 ; FHP=PTR to COMM OFFICE, DTE=DATE in FILEMAN FORMAT, MEAL=B,N,E or A
+5 ;K ^TMP($J)
+6 SET X1=DTE
SET X2=-1
DO C^%DTC
SET FHRMDTE=X
SET X1=DTE
SET X2=1
DO C^%DTC
SET FHDTQ=X
+7 FOR FHOMDT=FHRMDTE:0
SET FHOMDT=$ORDER(^FHPT("RM",FHOMDT))
if FHOMDT=""!(FHOMDT'<FHDTQ)
QUIT
Begin DoDot:1
+8 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("RM",FHOMDT,FHDFN))
if FHDFN=""
QUIT
Begin DoDot:2
+9 FOR FHRNUM=0:0
SET FHRNUM=$ORDER(^FHPT("RM",FHOMDT,FHDFN,FHRNUM))
if FHRNUM=""
QUIT
Begin DoDot:3
+10 IF '$DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
QUIT
+11 SET FHELN0=$GET(^FHPT(FHDFN,"OP",FHRNUM,0))
+12 SET FHELN2=$GET(^FHPT(FHDFN,"OP",FHRNUM,2))
+13 IF $PIECE(FHELN0,U,15)="C"
QUIT
+14 IF $PIECE(FHELN2,U,6)="C"
QUIT
+15 SET FHLOC=$PIECE(FHELN0,U,3)
IF FHLOC=""
QUIT
+16 SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
IF FHCOMM=""
QUIT
+17 SET FHMEAL=$PIECE(FHELN0,U,4)
IF MEAL'="A"
IF MEAL'=FHMEAL
QUIT
+18 IF FHP>0
IF FHP'=FHCOMM
QUIT
+19 SET RM=$PIECE(FHELN0,U,18)
+20 IF $GET(RM)
IF $DATA(^DG(405.4,RM,0))
SET RM=$PIECE(^DG(405.4,RM,0),U,1)
+21 SET FHMLTM=$PIECE(FHELN2,U,1)
SET FHBAG=$PIECE(FHELN2,U,2)
+22 IF $PIECE($GET(^FH(119.6,FHLOC,1)),U,4)="Y"
DO DIETPAT^FHOMRR1
SET FHDIET=FHDIETP
+23 IF $PIECE($GET(^FH(119.6,FHLOC,1)),U,4)'="Y"
SET FHDIET=$PIECE(FHELN0,U,2)
IF FHDIET'=""
SET FHDIET=$PIECE($GET(^FH(111,FHDIET,0)),U,1)
+24 DO PATNAME^FHOMUTL
+25 SET ^TMP($JOB,FHMEAL,FHMLTM_"~"_FHPTNM)=FHLOC_"^"_FHDFN_"^"_FHBAG_"^"_FHDIET_"^"_$EXTRACT(RM,1,10)
+26 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
