- 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
