- 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 Jan 18, 2025@02:54:21 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