FHOMELT.m

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

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