FHOMSS1 ;Hines OIFO/RTK SPECIAL MEALS STATUS LIST ;4/11/03 10:05
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
;
LIST ; Display for cancel/print/authorize screens - First build data in ^TMP
K ^TMP($J),FHLIST S NUM=0,EX="",ENDT=9999999
F FHSMDT=STDT:0 S FHSMDT=$O(^FHPT("SM",FHSMDT)) Q:FHSMDT'>0!(FHSMDT>ENDT) D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHSMDT,FHDFN)) Q:FHDFN'>0 D
..S FHSMDTX=$E(FHSMDT,1,7)
..S FHZN=$G(^FHPT(FHDFN,"SM",FHSMDT,0)),FHST=$P(FHZN,U,2) I FHST="C" Q
..I FHS'[FHST Q
..D PATNAME^FHOMUTL I FHDFN="" Q
..S FHLOC=$P(FHZN,U,3) Q:FHLOC=""
..S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
..S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1),FHML=$P(FHZN,U,9)
..S FHML=$S(FHML="B":1,FHML="N":2,FHML="E":3)
..S ^TMP($J,FHPRORD_"~"_FHLOCNM,FHSMDTX_"."_FHML,FHPTNM_"~"_FHDFN)=FHZN
..Q
.Q
I '$D(^TMP($J)) Q
D HDR
S FHLSRT="" F S FHLSRT=$O(^TMP($J,FHLSRT)) Q:FHLSRT=""!(EX=U) D
.F FHSMDT=STDT:0 S FHSMDT=$O(^TMP($J,FHLSRT,FHSMDT)) Q:FHSMDT'>0!(FHSMDT>ENDT)!(EX=U) D
..S FHPTN="" F S FHPTN=$O(^TMP($J,FHLSRT,FHSMDT,FHPTN)) Q:FHPTN=""!(EX=U) D
...S FHNODE=$G(^TMP($J,FHLSRT,FHSMDT,FHPTN)),FHSMDTX=$P(FHNODE,U,1)
...S NUM=NUM+1,PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
...S FHDFN=$P(FHPTN,"~",2) D PATNAME^FHOMUTL W ?4,$E(FHPTNM,1,17)
...S FHSTAT=$P(FHNODE,U,2),FHSTAT=$S(FHSTAT="P":"PENDING",FHSTAT="A":"AUTH",FHSTAT="D":"DENIED",1:"CANCEL")
...S FHD=$$FMTE^XLFDT(FHSMDTX,"P") W ?22,$E(FHD,1,12)
...S FHLPT=$P(FHNODE,U,3),FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,9)
...S FHRMBD=$P(FHNODE,U,13),FHRMBNM=""
...I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,9)
...W ?35,FHLOC,?45,FHRMBNM
...S FHDPT=$P(FHNODE,U,4),FHDIET=$E($P($G(^FH(111,FHDPT,0)),U,1),1,12)
...W ?55,FHDIET
...S FHMEAL=$P(FHNODE,U,9) W ?69,FHMEAL,?73,FHSTAT
...S FHLIST(NUM)=FHDFN_"^"_FHSMDTX
...I $E(FHSTAT,1)="D" D
....S FHDENY=$P(FHNODE,U,6) W !?6,"Denied by: "
....I FHDENY'="" W $P($G(^VA(200,FHDENY,0)),U,1)
...S FHCOMM=$P(FHNODE,U,8) I FHCOMM'="" W !?6,"Comment: ",FHCOMM
...I $D(^FHPT(FHDFN,"SM",FHSMDTX,1)) D
....S FHEL=$G(^FHPT(FHDFN,"SM",FHSMDTX,1))
....W !?6,"Early/Late Tray Time: ",$P(FHEL,U,1)
....W " Bagged Meal: ",$P(FHEL,U,2)
.I $Y>(IOSL-4) D PG I EX=U Q
.Q
Q
PG ;
I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
D HDR Q
HDR ;
W:$Y @IOF
W !?5,"S P E C I A L M E A L S S T A T U S R E P O R T"
W !!!?1,"#",?6,"Name",?23,"Date/Time",?35,"Location",?45,"Room-Bed"
W ?55,"Diet Ordered",?68,"Meal",?73,"Status"
W !,"===",?4,"=================",?22,"============"
W ?35,"========= =========",?55,"============",?68,"====",?73,"======="
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMSS1 2749 printed Dec 13, 2024@01:53:08 Page 2
FHOMSS1 ;Hines OIFO/RTK SPECIAL MEALS STATUS LIST ;4/11/03 10:05
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 ;
LIST ; Display for cancel/print/authorize screens - First build data in ^TMP
+1 KILL ^TMP($JOB),FHLIST
SET NUM=0
SET EX=""
SET ENDT=9999999
+2 FOR FHSMDT=STDT:0
SET FHSMDT=$ORDER(^FHPT("SM",FHSMDT))
if FHSMDT'>0!(FHSMDT>ENDT)
QUIT
Begin DoDot:1
+3 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("SM",FHSMDT,FHDFN))
if FHDFN'>0
QUIT
Begin DoDot:2
+4 SET FHSMDTX=$EXTRACT(FHSMDT,1,7)
+5 SET FHZN=$GET(^FHPT(FHDFN,"SM",FHSMDT,0))
SET FHST=$PIECE(FHZN,U,2)
IF FHST="C"
QUIT
+6 IF FHS'[FHST
QUIT
+7 DO PATNAME^FHOMUTL
IF FHDFN=""
QUIT
+8 SET FHLOC=$PIECE(FHZN,U,3)
if FHLOC=""
QUIT
+9 SET FHPRORD=$PIECE($GET(^FH(119.6,FHLOC,0)),U,4)
IF FHPRORD=""
SET FHPRORD=99
+10 SET FHPRORD=$SELECT(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
+11 SET FHLOCNM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
SET FHML=$PIECE(FHZN,U,9)
+12 SET FHML=$SELECT(FHML="B":1,FHML="N":2,FHML="E":3)
+13 SET ^TMP($JOB,FHPRORD_"~"_FHLOCNM,FHSMDTX_"."_FHML,FHPTNM_"~"_FHDFN)=FHZN
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 IF '$DATA(^TMP($JOB))
QUIT
+17 DO HDR
+18 SET FHLSRT=""
FOR
SET FHLSRT=$ORDER(^TMP($JOB,FHLSRT))
if FHLSRT=""!(EX=U)
QUIT
Begin DoDot:1
+19 FOR FHSMDT=STDT:0
SET FHSMDT=$ORDER(^TMP($JOB,FHLSRT,FHSMDT))
if FHSMDT'>0!(FHSMDT>ENDT)!(EX=U)
QUIT
Begin DoDot:2
+20 SET FHPTN=""
FOR
SET FHPTN=$ORDER(^TMP($JOB,FHLSRT,FHSMDT,FHPTN))
if FHPTN=""!(EX=U)
QUIT
Begin DoDot:3
+21 SET FHNODE=$GET(^TMP($JOB,FHLSRT,FHSMDT,FHPTN))
SET FHSMDTX=$PIECE(FHNODE,U,1)
+22 SET NUM=NUM+1
SET PAD=$SELECT($LENGTH(NUM)=1:" ",1:"")
WRITE !,PAD,NUM
+23 SET FHDFN=$PIECE(FHPTN,"~",2)
DO PATNAME^FHOMUTL
WRITE ?4,$EXTRACT(FHPTNM,1,17)
+24 SET FHSTAT=$PIECE(FHNODE,U,2)
SET FHSTAT=$SELECT(FHSTAT="P":"PENDING",FHSTAT="A":"AUTH",FHSTAT="D":"DENIED",1:"CANCEL")
+25 SET FHD=$$FMTE^XLFDT(FHSMDTX,"P")
WRITE ?22,$EXTRACT(FHD,1,12)
+26 SET FHLPT=$PIECE(FHNODE,U,3)
SET FHLOC=$EXTRACT($PIECE($GET(^FH(119.6,FHLPT,0)),U,1),1,9)
+27 SET FHRMBD=$PIECE(FHNODE,U,13)
SET FHRMBNM=""
+28 IF FHRMBD'=""
SET FHRMBNM=$EXTRACT($PIECE($GET(^DG(405.4,FHRMBD,0)),U,1),1,9)
+29 WRITE ?35,FHLOC,?45,FHRMBNM
+30 SET FHDPT=$PIECE(FHNODE,U,4)
SET FHDIET=$EXTRACT($PIECE($GET(^FH(111,FHDPT,0)),U,1),1,12)
+31 WRITE ?55,FHDIET
+32 SET FHMEAL=$PIECE(FHNODE,U,9)
WRITE ?69,FHMEAL,?73,FHSTAT
+33 SET FHLIST(NUM)=FHDFN_"^"_FHSMDTX
+34 IF $EXTRACT(FHSTAT,1)="D"
Begin DoDot:4
+35 SET FHDENY=$PIECE(FHNODE,U,6)
WRITE !?6,"Denied by: "
+36 IF FHDENY'=""
WRITE $PIECE($GET(^VA(200,FHDENY,0)),U,1)
End DoDot:4
+37 SET FHCOMM=$PIECE(FHNODE,U,8)
IF FHCOMM'=""
WRITE !?6,"Comment: ",FHCOMM
+38 IF $DATA(^FHPT(FHDFN,"SM",FHSMDTX,1))
Begin DoDot:4
+39 SET FHEL=$GET(^FHPT(FHDFN,"SM",FHSMDTX,1))
+40 WRITE !?6,"Early/Late Tray Time: ",$PIECE(FHEL,U,1)
+41 WRITE " Bagged Meal: ",$PIECE(FHEL,U,2)
End DoDot:4
End DoDot:3
End DoDot:2
+42 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+43 QUIT
End DoDot:1
+44 QUIT
PG ;
+1 IF IOST?1"C".E
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+2 DO HDR
QUIT
HDR ;
+1 if $Y
WRITE @IOF
+2 WRITE !?5,"S P E C I A L M E A L S S T A T U S R E P O R T"
+3 WRITE !!!?1,"#",?6,"Name",?23,"Date/Time",?35,"Location",?45,"Room-Bed"
+4 WRITE ?55,"Diet Ordered",?68,"Meal",?73,"Status"
+5 WRITE !,"===",?4,"=================",?22,"============"
+6 WRITE ?35,"========= =========",?55,"============",?68,"====",?73,"======="
+7 QUIT
