FHOMTK1 ;Hines OIFO/RTK OUTPATIENT MEALS TRAY TICKETS ;7/02/03 14:05
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
;
START S RM="",FHBY=$E($G(FHBY),1) I FHBY="" Q
S FHDTE=D1
S X1=D1,X2=-1 D C^%DTC S FHRMDTE=X
S X1=D1,X2=1 D C^%DTC S FHDTQ=X
;NEW CODE FOR SORTING
BLDTMP ; First build data in ^TMP global
K ^TMP($J,"OPTX")
; Recurring Meals
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
..D PATNAME^FHOMUTL I DFN'="" I $G(^DPT(DFN,.1))'="" Q
..F FHRNUM=0:0 S FHRNUM=$O(^FHPT("RM",FHOMDT,FHDFN,FHRNUM)) Q:FHRNUM="" D
...S FHZN=$G(^FHPT(FHDFN,"OP",FHRNUM,0)),FHLOC=$P(FHZN,U,3) Q:FHLOC=""
...S FHSTAT=$P(FHZN,U,15) Q:FHSTAT="C"
...S FHMEAL=$P(FHZN,U,4)
...I FHOMEAL'="A",FHOMEAL'[FHMEAL Q
...I FHBY="P",FHDFN'=FHTTDFN Q
...I FHBY="L",W1'=FHLOC Q
...I FHBY="C" S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHP'=FHCOMM Q
...S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1) I FHMEAL="E" S FHMEAL="Z"
...I SRT="R" S ^TMP($J,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~R~"_FHRNUM)=FHZN
...I SRT'="R" S ^TMP($J,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~R~"_FHRNUM)=FHZN
...Q
..Q
.Q
; Special Meals
F FHOMDT=FHDTE:0 S FHOMDT=$O(^FHPT("SM",FHOMDT)) Q:FHOMDT=""!(FHOMDT>FHDTQ) D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHOMDT,FHDFN)) Q:FHDFN="" D
..D PATNAME^FHOMUTL I DFN'="" I $G(^DPT(DFN,.1))'="" Q
..S FHZN=$G(^FHPT(FHDFN,"SM",FHOMDT,0)),FHLOC=$P(FHZN,U,3) Q:FHLOC=""
..S FHSTAT=$P(FHZN,U,2) Q:FHSTAT'="A"
..S FHMEAL=$P(FHZN,U,9)
..I FHOMEAL'="A",FHOMEAL'[FHMEAL Q
..I FHBY="P",FHDFN'=FHTTDFN Q
..I FHBY="L",W1'=FHLOC Q
..I FHBY="C" S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHP'=FHCOMM Q
..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1) I FHMEAL="E" S FHMEAL="Z"
..I SRT="R" S ^TMP($J,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~S")=FHZN
..I SRT'="R" S ^TMP($J,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~S")=FHZN
..Q
.Q
; Guest Meals
F FHOMDT=FHDTE:0 S FHOMDT=$O(^FHPT("GM",FHOMDT)) Q:FHOMDT=""!(FHOMDT>FHDTQ) D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHOMDT,FHDFN)) Q:FHDFN="" D
..D PATNAME^FHOMUTL I DFN'="" I $G(^DPT(DFN,.1))'="" Q
..S FHZN=$G(^FHPT(FHDFN,"GM",FHOMDT,0)),FHLOC=$P(FHZN,U,5) Q:FHLOC=""
..S FHSTAT=$P(FHZN,U,9) Q:FHSTAT="C"
..S FHMEAL=$P(FHZN,U,3)
..I FHOMEAL'="A",FHOMEAL'[FHMEAL Q
..I FHBY="P",FHDFN'=FHTTDFN Q
..I FHBY="L",W1'=FHLOC Q
..I FHBY="C" S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHP'=FHCOMM Q
..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1) I FHMEAL="E" S FHMEAL="Z"
..I SRT="R" S ^TMP($J,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~G")=FHZN
..I SRT'="R" S ^TMP($J,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~G")=FHZN
..Q
.Q
;
;Now process sorted OM tray tickets
I '$D(^TMP($J,"OPTX")) Q
S FHINDX="" F S FHINDX=$O(^TMP($J,"OPTX",FHINDX)) Q:FHINDX="" D
.S FHINDX2="" F S FHINDX2=$O(^TMP($J,"OPTX",FHINDX,FHINDX2)) Q:FHINDX2="" D
..S FHZN=$G(^TMP($J,"OPTX",FHINDX,FHINDX2)),FHOMDT=$P(FHZN,U,1)
..S FHMEAL=$P(FHINDX2,"~",1) I FHMEAL="Z" S FHMEAL="E" ;for sorting
..S FHDFN=$P(FHINDX2,"~",3),FHOMTYP=$P(FHINDX2,"~",4)
..S FHLOC=$P(FHZN,U,3) I FHOMTYP="G" S FHLOC=$P(FHZN,U,5)
..I FHOMTYP="R" S FHRNUM=$P(FHINDX2,"~",5)
..I UPD,FHOMTYP="R",$P(FHZN,U,16)<$P(FHZN,U,13) Q
..I UPD,FHOMTYP="S",$P(FHZN,U,10)'="" Q
..I FHOMEAL'="A" D BLD^FHOMTK2 Q
..S MEAL=FHMEAL D BLD^FHOMTK2
..Q
.Q
I $G(NBR) D PRT^FHMTK1C Q
K FHTTDFN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMTK1 3479 printed Dec 13, 2024@01:53:10 Page 2
FHOMTK1 ;Hines OIFO/RTK OUTPATIENT MEALS TRAY TICKETS ;7/02/03 14:05
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 ;
START SET RM=""
SET FHBY=$EXTRACT($GET(FHBY),1)
IF FHBY=""
QUIT
+1 SET FHDTE=D1
+2 SET X1=D1
SET X2=-1
DO C^%DTC
SET FHRMDTE=X
+3 SET X1=D1
SET X2=1
DO C^%DTC
SET FHDTQ=X
+4 ;NEW CODE FOR SORTING
BLDTMP ; First build data in ^TMP global
+1 KILL ^TMP($JOB,"OPTX")
+2 ; Recurring Meals
+3 FOR FHOMDT=FHRMDTE:0
SET FHOMDT=$ORDER(^FHPT("RM",FHOMDT))
if FHOMDT=""!(FHOMDT'<FHDTQ)
QUIT
Begin DoDot:1
+4 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("RM",FHOMDT,FHDFN))
if FHDFN=""
QUIT
Begin DoDot:2
+5 DO PATNAME^FHOMUTL
IF DFN'=""
IF $GET(^DPT(DFN,.1))'=""
QUIT
+6 FOR FHRNUM=0:0
SET FHRNUM=$ORDER(^FHPT("RM",FHOMDT,FHDFN,FHRNUM))
if FHRNUM=""
QUIT
Begin DoDot:3
+7 SET FHZN=$GET(^FHPT(FHDFN,"OP",FHRNUM,0))
SET FHLOC=$PIECE(FHZN,U,3)
if FHLOC=""
QUIT
+8 SET FHSTAT=$PIECE(FHZN,U,15)
if FHSTAT="C"
QUIT
+9 SET FHMEAL=$PIECE(FHZN,U,4)
+10 IF FHOMEAL'="A"
IF FHOMEAL'[FHMEAL
QUIT
+11 IF FHBY="P"
IF FHDFN'=FHTTDFN
QUIT
+12 IF FHBY="L"
IF W1'=FHLOC
QUIT
+13 IF FHBY="C"
SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
IF FHP'=FHCOMM
QUIT
+14 SET FHLOCNM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
IF FHMEAL="E"
SET FHMEAL="Z"
+15 IF SRT="R"
SET ^TMP($JOB,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~R~"_FHRNUM)=FHZN
+16 IF SRT'="R"
SET ^TMP($JOB,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~R~"_FHRNUM)=FHZN
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 ; Special Meals
+21 FOR FHOMDT=FHDTE:0
SET FHOMDT=$ORDER(^FHPT("SM",FHOMDT))
if FHOMDT=""!(FHOMDT>FHDTQ)
QUIT
Begin DoDot:1
+22 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("SM",FHOMDT,FHDFN))
if FHDFN=""
QUIT
Begin DoDot:2
+23 DO PATNAME^FHOMUTL
IF DFN'=""
IF $GET(^DPT(DFN,.1))'=""
QUIT
+24 SET FHZN=$GET(^FHPT(FHDFN,"SM",FHOMDT,0))
SET FHLOC=$PIECE(FHZN,U,3)
if FHLOC=""
QUIT
+25 SET FHSTAT=$PIECE(FHZN,U,2)
if FHSTAT'="A"
QUIT
+26 SET FHMEAL=$PIECE(FHZN,U,9)
+27 IF FHOMEAL'="A"
IF FHOMEAL'[FHMEAL
QUIT
+28 IF FHBY="P"
IF FHDFN'=FHTTDFN
QUIT
+29 IF FHBY="L"
IF W1'=FHLOC
QUIT
+30 IF FHBY="C"
SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
IF FHP'=FHCOMM
QUIT
+31 SET FHLOCNM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
IF FHMEAL="E"
SET FHMEAL="Z"
+32 IF SRT="R"
SET ^TMP($JOB,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~S")=FHZN
+33 IF SRT'="R"
SET ^TMP($JOB,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~S")=FHZN
+34 QUIT
End DoDot:2
+35 QUIT
End DoDot:1
+36 ; Guest Meals
+37 FOR FHOMDT=FHDTE:0
SET FHOMDT=$ORDER(^FHPT("GM",FHOMDT))
if FHOMDT=""!(FHOMDT>FHDTQ)
QUIT
Begin DoDot:1
+38 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("GM",FHOMDT,FHDFN))
if FHDFN=""
QUIT
Begin DoDot:2
+39 DO PATNAME^FHOMUTL
IF DFN'=""
IF $GET(^DPT(DFN,.1))'=""
QUIT
+40 SET FHZN=$GET(^FHPT(FHDFN,"GM",FHOMDT,0))
SET FHLOC=$PIECE(FHZN,U,5)
if FHLOC=""
QUIT
+41 SET FHSTAT=$PIECE(FHZN,U,9)
if FHSTAT="C"
QUIT
+42 SET FHMEAL=$PIECE(FHZN,U,3)
+43 IF FHOMEAL'="A"
IF FHOMEAL'[FHMEAL
QUIT
+44 IF FHBY="P"
IF FHDFN'=FHTTDFN
QUIT
+45 IF FHBY="L"
IF W1'=FHLOC
QUIT
+46 IF FHBY="C"
SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
IF FHP'=FHCOMM
QUIT
+47 SET FHLOCNM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
IF FHMEAL="E"
SET FHMEAL="Z"
+48 IF SRT="R"
SET ^TMP($JOB,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~G")=FHZN
+49 IF SRT'="R"
SET ^TMP($JOB,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~G")=FHZN
+50 QUIT
End DoDot:2
+51 QUIT
End DoDot:1
+52 ;
+53 ;Now process sorted OM tray tickets
+54 IF '$DATA(^TMP($JOB,"OPTX"))
QUIT
+55 SET FHINDX=""
FOR
SET FHINDX=$ORDER(^TMP($JOB,"OPTX",FHINDX))
if FHINDX=""
QUIT
Begin DoDot:1
+56 SET FHINDX2=""
FOR
SET FHINDX2=$ORDER(^TMP($JOB,"OPTX",FHINDX,FHINDX2))
if FHINDX2=""
QUIT
Begin DoDot:2
+57 SET FHZN=$GET(^TMP($JOB,"OPTX",FHINDX,FHINDX2))
SET FHOMDT=$PIECE(FHZN,U,1)
+58 ;for sorting
SET FHMEAL=$PIECE(FHINDX2,"~",1)
IF FHMEAL="Z"
SET FHMEAL="E"
+59 SET FHDFN=$PIECE(FHINDX2,"~",3)
SET FHOMTYP=$PIECE(FHINDX2,"~",4)
+60 SET FHLOC=$PIECE(FHZN,U,3)
IF FHOMTYP="G"
SET FHLOC=$PIECE(FHZN,U,5)
+61 IF FHOMTYP="R"
SET FHRNUM=$PIECE(FHINDX2,"~",5)
+62 IF UPD
IF FHOMTYP="R"
IF $PIECE(FHZN,U,16)<$PIECE(FHZN,U,13)
QUIT
+63 IF UPD
IF FHOMTYP="S"
IF $PIECE(FHZN,U,10)'=""
QUIT
+64 IF FHOMEAL'="A"
DO BLD^FHOMTK2
QUIT
+65 SET MEAL=FHMEAL
DO BLD^FHOMTK2
+66 QUIT
End DoDot:2
+67 QUIT
End DoDot:1
+68 IF $GET(NBR)
DO PRT^FHMTK1C
QUIT
+69 KILL FHTTDFN
QUIT
