Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHOMRMD

FHOMRMD.m

Go to the documentation of this file.
  1. FHOMRMD ;Hines OIFO/RTK/FAI RECURRING MEALS REVIEW/DISPLAY ;10/20/04 13:22
  1. ;;5.5;DIETETICS;**1,5**;Jan 28, 2005;Build 53
  1. ;patch #5 - added outpatient SOs & SFs.
  1. ;
  1. DISP ;
  1. S X1=STDT,X2=-1 D C^%DTC S STDT=X
  1. I '$O(^FHPT(FHDFN,"OP","B",STDT)) W !!,"No Recurring Meals to Display" Q
  1. K FHLIST S EX="",NUM=0 D HDR I $G(ENDT)="" S ENDT=9999999.99
  1. F FHRMDT=STDT:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>ENDT)!(EX=U) F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0!(EX=U) D
  1. .S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0))
  1. .S FHRM=$P(FHNODE,U,1)
  1. .S NUM=NUM+1,PAD=$S($L(NUM)<3:3-$L(NUM),1:1) W !?PAD,NUM
  1. .S FHLIST(NUM)=FHRNUM_"^"_FHRM
  1. .S FHDOW=$$DOW^XLFDT(FHRM),FHDOW=$E(FHDOW,1,3)
  1. .S FHDTP=$$FMTE^XLFDT(FHRM,"P") W ?6,FHDOW," - ",$E(FHDTP,1,12)
  1. .S FHLPT=$P(FHNODE,U,3),FHLOCZN=$G(^FH(119.6,FHLPT,0)) D
  1. ..S FHLOC=$E($P(FHLOCZN,U,1),1,10),FHSERV=$P(FHLOCZN,U,10)
  1. ..S FHSRV=$S(FHSERV["T":$P(FHLOCZN,U,5),FHSERV["C":$P(FHLOCZN,U,6),1:"")
  1. ..I FHSRV="" S FHSRVPT="" Q
  1. ..S FHSRVPT=$P($G(^FH(119.72,FHSRV,0)),U,1)
  1. ..Q
  1. .W ?26,FHLOC,?38,$E(FHSRVPT,1,9)
  1. .W ?51,$P(FHNODE,U,4),?56,$P(FHNODE,U,5)
  1. .I $P($G(^FH(119.6,FHLPT,1)),U,4)="Y" D DIETPAT W ?60,$E(FHDIETP,1,12)
  1. .I $P($G(^FH(119.6,FHLPT,1)),U,4)'="Y" S FHDPTR=$P(FHNODE,U,2) Q:FHDPTR="" W ?60,$E($P($G(^FH(111,FHDPTR,0)),U,1),1,12)
  1. .S FHSTAT=$P(FHNODE,U,15) I FHSTAT="C" W ?76,"C"
  1. .I $Y>(IOSL-4) D PG I EX=U Q
  1. .I $D(^FHPT(FHDFN,"OP",FHRNUM,1)) D
  1. ..S FHNODE1=$G(^FHPT(FHDFN,"OP",FHRNUM,1))
  1. ..S FHSTATA=$P(FHNODE1,U,5) I FHSTATA="C" W !?7,"Additional Orders: ",$E($P(FHNODE1,U,1),1,46),?76,"C" Q
  1. ..W !?7,"Additional Orders: ",$P(FHNODE1,U,1)
  1. .I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
  1. ..S FHNODE2=$G(^FHPT(FHDFN,"OP",FHRNUM,2))
  1. ..S FHEL=FHNODE2
  1. ..W !?7,"Early/Late Tray Time: ",$P(FHEL,U,1)
  1. ..W " Bagged Meal: ",$P(FHEL,U,2)
  1. ..S FHSTATE=$P(FHNODE2,U,6) I FHSTATE="C" W ?76,"C"
  1. .I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
  1. ..S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3))
  1. ..S FHTU=FHNODE3
  1. ..W !?7,"Tubefeeding: " S FHSTATT=$P(FHTU,U,5) I FHSTATT="C" W ?76,"C"
  1. ..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ)) Q:FHTZ'>0 D
  1. ...S FHTUZN=$G(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ,0))
  1. ...S FHTUPTR=$P(FHTUZN,U,1),FHTUSTR=$P(FHTUZN,U,2)
  1. ...W !?9,$P($G(^FH(118.2,FHTUPTR,0)),U,1)," Strength: "
  1. ...W $S(FHTUSTR=1:"1/4",FHTUSTR=2:"1/2",FHTUSTR=3:"3/4",1:"FULL")
  1. ...I $P(FHTUZN,U,3)["CC" D ;print ml instead of cc.
  1. ....S QUA=$P(FHTUZN,U,3)
  1. ....S QUAFI=$P(QUA,"CC",1),QUASE=$P(QUA,"CC",2)
  1. ....S $P(FHTUZN,U,3)=QUAFI_"ML"_QUASE
  1. ...W " Quantity: ",$P(FHTUZN,U,3)
  1. ..W !?7,"Total ML's: ",$P(FHTU,U,2)," Total KCALS/DAY: ",$P(FHTU,U,3)
  1. ..S FHTCOMM=$P(FHTU,U,1) I FHTCOMM'="" W !?7,"Comment: ",FHTCOMM
  1. .;outpatient SOs.
  1. .I $D(^FHPT(FHDFN,"OP",FHRNUM,"SP")) D
  1. ..I $Y>(IOSL-4) D PG I EX=U Q
  1. ..W !,?7,"Standing Orders:"
  1. ..S FHTZSOL=23,FHTZCNT=0
  1. ..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ)) Q:FHTZ'>0 D
  1. ...S FHTZSO=$G(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ,0))
  1. ...S FHTZSO2=$P(FHTZSO,U,2)
  1. ...S FHTZSO6=$P(FHTZSO,U,6)
  1. ...S FHTZSO8=$P(FHTZSO,U,8)
  1. ...S FHTZSOCN="" I FHTZSO6'="" S FHTZSOCN=" (C) "
  1. ...I $G(FHTZSO2),$D(^FH(118.3,FHTZSO2,0)) D
  1. ....S FHTZSON=$P(^FH(118.3,FHTZSO2,0),U,1)
  1. ....S FHTZSOL=FHTZSOL+$L(FHTZSON)+$L(FHTZSOCN)+7
  1. ....I FHTZSOL>80 W !,?23 S FHTZSOL=30+$L(FHTZSON)+$L(FHTZSOCN),FHTZCNT=0
  1. ....I $G(FHTZCNT) W ", ",FHTZSON,FHTZSOCN," = ",FHTZSO8
  1. ....E W " ",FHTZSON,FHTZSOCN," = ",FHTZSO8
  1. ....S FHTZCNT=FHTZCNT+1
  1. .I $D(^FHPT(FHDFN,"OP",FHRNUM,"SF")) D
  1. ..Q:'$D(^FHPT(FHDFN,"OP",FHRNUM,"SF",0))
  1. ..S SF=""
  1. ..I $D(^FHPT(FHDFN,"OP",FHRNUM,"SF",0)) S SF=$P(^(0),U,3)
  1. ..Q:'SF
  1. ..S FHSFDAT=$G(^FHPT(FHDFN,"OP",FHRNUM,"SF",SF,0))
  1. ..I SF,$P(FHSFDAT,U,32) Q
  1. ..I $Y>(IOSL-4) D PG I EX=U Q
  1. ..W !,?7,"Supplemental Feeding: " I $P(FHSFDAT,U,4),$D(^FH(118.1,$P(FHSFDAT,U,4),0)) W $P(^(0),U,1)
  1. ..S FHSF10=$P(FHSFDAT,U,5,12)
  1. ..S FHSF2=$P(FHSFDAT,U,13,20)
  1. ..S FHSF8=$P(FHSFDAT,U,21,28)
  1. ..I FHSF10'["^^^^^^^" D
  1. ...W !,?9,"10AM:"
  1. ...F FHI=1,3,5,7 S FHSF1=$P(FHSF10,U,FHI) I FHSF1,$D(^FH(118,FHSF1,0)) W " ",$P(^FH(118,FHSF1,0),U,1)," = ",$S('$P(FHSF10,U,FHI+1):1,1:$P(FHSF10,U,FHI+1))
  1. ..I FHSF2'["^^^^^^^" D
  1. ...I $Y>(IOSL-4) D PG I EX=U Q
  1. ...W !,?9,"2PM:"
  1. ...F FHI=1,3,5,7 S FHSF1=$P(FHSF2,U,FHI) I FHSF1,$D(^FH(118,FHSF1,0)) W " ",$P(^FH(118,FHSF1,0),U,1)," = ",$S('$P(FHSF2,U,FHI+1):1,1:$P(FHSF2,U,FHI+1))
  1. ..I FHSF8'["^^^^^^^" D
  1. ...I $Y>(IOSL-4) D PG I EX=U Q
  1. ...W !,?9,"8PM:"
  1. ...F FHI=1,3,5,7 S FHSF1=$P(FHSF8,U,FHI) I FHSF1,$D(^FH(118,FHSF1,0)) W " ",$P(^FH(118,FHSF1,0),U,1)," = ",$S('$P(FHSF8,U,FHI+1):1,1:$P(FHSF8,U,FHI+1))
  1. .Q
  1. W ! Q
  1. DIETPAT ;
  1. S FHDIETS=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,7,11)
  1. S FHDIETP=""
  1. F PCE=1:1:5 D
  1. .S FHDPTR=$P(FHDIETS,U,PCE) I FHDPTR="" Q
  1. .S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,7)
  1. .I FHDNM="" S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,1)
  1. .S FHDIETP=FHDIETP_FHDNM_"," Q
  1. S FHDIETP=$E(FHDIETP,1,$L(FHDIETP)-1)
  1. Q
  1. PG ;
  1. Q:$O(^FHPT(FHDFN,"OP","B",FHRMDT))'>0
  1. I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
  1. D HDR Q
  1. HDR ;
  1. I $G(FHPP)'=1 W:$Y @IOF
  1. K FHPP W !?15,"R E C U R R I N G M E A L S"
  1. W !!?3,"NAME: " D PATNAME^FHOMUTL W FHPTNM," ",FHSSN
  1. W !!?27,"Ordering",?38,"Service"
  1. W !?2,"#",?6,"Date/Time",?27,"Location",?38,"Point"
  1. W ?50,"Meal",?55,"Bag",?60,"Diet Ordered",?74,"Status"
  1. W !?1,"===",?6,"==================",?26,"=========="
  1. W ?38,"==========",?50,"====",?55,"===",?60,"============",?74,"======"
  1. Q
  1. END ;
  1. K EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM
  1. K FHRNUM,FHDPTR,FHDNM,FHTZCNT,FHTZSON,FHTZSOCN,FHTZSO8,FHTZSOL,FHTZSO2,FHTZSO6,FHTZ,FHTZSO Q