- 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 Feb 18, 2025@23:19:32 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
