source: FOIAVistA/tag/r/DIETETICS-FH/FHOMRR1.m@ 1251

Last change on this file since 1251 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1FHOMRR1 ;Hines OIFO/RTK RECURRING MEALS REVIEW/DISPLAY ;2/04/03 14:05
2 ;;5.5;DIETETICS;**1,5**;Jan 28, 2005;Build 53
3 ;11/30/05 patch 5 - added outpatient standing order & SFs.
4 ;
5STRT K FHPSDT D GETOPT^FHOMUTL I FHFIND=0 Q
6 I STDT="" Q
7 D ENDATE^FHOMUTL I ENDT="" Q
8 S ENDT=ENDT_.99
9 D DEV D STRT Q
10 ;I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q
11 ;
12DEV ;get device and set up queue
13 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
14 I '$D(IO("Q")) U IO D DISP,^%ZISC,END Q
15 S ZTRTN="DISP^FHOMRR1"
16 S ZTSAVE("STDT")="",ZTSAVE("FHDFN")=""
17 S ZTDESC="Outpatient Meals Recurring Meals Display" D ^%ZTLOAD
18 D ^%ZISC K %ZIS,IOP
19 D END Q
20DISP ;
21 S X1=STDT,X2=-1 D C^%DTC S STDT=X
22 I '$O(^FHPT(FHDFN,"OP","B",STDT)) W !!,"No Recurring Meals to Display" Q
23 K FHLIST S EX="",NUM=0 D HDR I $G(ENDT)="" S ENDT=9999999.99
24 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
25 .S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0)) Q:FHNODE=""
26 .I $P(FHNODE,U,15)="C" Q
27 .S FHRM=$P(FHNODE,U,1)
28 .S NUM=NUM+1,PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
29 .S FHLIST(NUM)=FHRNUM_"^"_FHRM
30 .S FHDTP=$$FMTE^XLFDT(FHRM,"P") W ?5,$E(FHDTP,1,12)
31 .S FHRMBD=$P(FHNODE,U,18),FHRMBNM=""
32 .I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,11)
33 .S FHLPT=$P(FHNODE,U,3),FHLOCZN=$G(^FH(119.6,FHLPT,0)) D
34 ..S FHLOC=$E($P(FHLOCZN,U,1),1,11),FHSERV=$P(FHLOCZN,U,10)
35 ..S FHSRV=$S(FHSERV["T":$P(FHLOCZN,U,5),FHSERV["C":$P(FHLOCZN,U,6),1:"")
36 ..I FHSRV="" S FHSRVPT="" Q
37 ..S FHSRVPT=$P($G(^FH(119.72,FHSRV,0)),U,1)
38 ..Q
39 .W ?19,FHLOC,?31,FHRMBNM,?44,$E(FHSRVPT,1,11),?58,$P(FHNODE,U,4)
40 .I $P($G(^FH(119.6,FHLPT,1)),U,4)="Y" D DIETPAT W ?63,$E(FHDIETP,1,17)
41 .I $P($G(^FH(119.6,FHLPT,1)),U,4)'="Y" S FHDPTR=$P(FHNODE,U,2) Q:FHDPTR="" W ?63,$E($P($G(^FH(111,FHDPTR,0)),U,1),1,17)
42 .I $Y>(IOSL-4) D PG I EX=U Q
43 .I $D(^FHPT(FHDFN,"OP",FHRNUM,1)) D
44 ..S FHNODE1=$G(^FHPT(FHDFN,"OP",FHRNUM,1)) I $P(FHNODE1,U,5)="C" Q
45 ..W !?7,"Additional Orders: ",$P(FHNODE1,U,1)
46 .I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
47 ..S FHNODE2=$G(^FHPT(FHDFN,"OP",FHRNUM,2))
48 ..S FHEL=FHNODE2 I $P(FHNODE2,U,6)="C" Q
49 ..W !?7,"Early/Late Tray Time: ",$P(FHEL,U,1)
50 ..W " Bagged Meal: ",$P(FHEL,U,2)
51 .I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
52 ..S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3))
53 ..S FHTU=FHNODE3 I $P(FHTU,U,5)="C" Q
54 ..W !?7,"Tubefeeding: "
55 ..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ)) Q:FHTZ'>0!(EX=U) D
56 ...S FHTUZN=$G(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ,0))
57 ...S FHTUPTR=$P(FHTUZN,U,1),FHTUSTR=$P(FHTUZN,U,2)
58 ...W !?9,$P($G(^FH(118.2,FHTUPTR,0)),U,1)," Strength: "
59 ...W $S(FHTUSTR=1:"1/4",FHTUSTR=2:"1/2",FHTUSTR=3:"3/4",1:"FULL")
60 ...I $P(FHTUZN,U,3)["CC" D ;print ml instead of cc.
61 ....S QUA=$P(FHTUZN,U,3)
62 ....S QUAFI=$P(QUA,"CC",1),QUASE=$P(QUA,"CC",2)
63 ....S $P(FHTUZN,U,3)=QUAFI_"ML"_QUASE
64 ...W " Quantity: ",$P(FHTUZN,U,3)
65 ...I $Y>(IOSL-4) D PG I EX=U Q
66 ..W !?7,"Total ML's: ",$P(FHTU,U,2)," Total KCALS/DAY: ",$P(FHTU,U,3)
67 ..S FHTCOMM=$P(FHTU,U,1) I FHTCOMM'="" W !?7,"Comment: ",FHTCOMM
68 .Q:EX=U I $D(^FHPT(FHDFN,"OP",FHRNUM,"SP")) D
69 ..I $Y>(IOSL-4) D PG I EX=U Q
70 ..W !,?7,"Standing Orders:"
71 ..S FHTZSOL=23,FHTZCNT=0
72 ..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ)) Q:FHTZ'>0 D
73 ...S FHTZSO=$G(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHTZ,0))
74 ...S FHTZSO2=$P(FHTZSO,U,2)
75 ...S FHTZSO6=$P(FHTZSO,U,6)
76 ...S FHTZSO8=$P(FHTZSO,U,8)
77 ...S FHTZSOCN="" I FHTZSO6'="" QUIT ;S FHTZSOCN=" (C) "
78 ...I $G(FHTZSO2),$D(^FH(118.3,FHTZSO2,0)) D
79 ....S FHTZSON=$P(^FH(118.3,FHTZSO2,0),U,1)
80 ....S FHTZSOL=FHTZSOL+$L(FHTZSON)+$L(FHTZSOCN)+7
81 ....I FHTZSOL>80 W !,?23 S FHTZSOL=30+$L(FHTZSON)+$L(FHTZSOCN),FHTZCNT=0
82 ....I $G(FHTZCNT) W ", ",FHTZSON,FHTZSOCN," = ",FHTZSO8
83 ....E W " ",FHTZSON,FHTZSOCN," = ",FHTZSO8
84 ....S FHTZCNT=FHTZCNT+1
85 .Q:EX=U I $D(^FHPT(FHDFN,"OP",FHRNUM,"SF")) D
86 ..Q:'$D(^FHPT(FHDFN,"OP",FHRNUM,"SF",0))
87 ..S SF=""
88 ..I $D(^FHPT(FHDFN,"OP",FHRNUM,"SF",0)) S SF=$P(^(0),U,3)
89 ..Q:'SF
90 ..S FHSFDAT=$G(^FHPT(FHDFN,"OP",FHRNUM,"SF",SF,0))
91 ..I SF,$P(FHSFDAT,U,32) Q
92 ..I $Y>(IOSL-4) D PG I EX=U Q
93 ..W !,?7,"Supplemental Feeding: " I $P(FHSFDAT,U,4),$D(^FH(118.1,$P(FHSFDAT,U,4),0)) W $P(^(0),U,1)
94 ..S FHSF10=$P(FHSFDAT,U,5,12)
95 ..S FHSF2=$P(FHSFDAT,U,13,20)
96 ..S FHSF8=$P(FHSFDAT,U,21,28)
97 ..I FHSF10'["^^^^^^^" D
98 ...W !,?9,"10AM:"
99 ...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))
100 ..I FHSF2'["^^^^^^^" D
101 ...I $Y>(IOSL-4) D PG I EX=U Q
102 ...W !,?9,"2PM:"
103 ...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))
104 ..Q:EX=U I FHSF8'["^^^^^^^" D
105 ...I $Y>(IOSL-4) D PG I EX=U Q
106 ...W !,?9,"8PM:"
107 ...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))
108 .Q
109 W ! Q
110DIETPAT ;
111 S FHDIETS=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,7,11)
112 S FHDIETP=""
113 F PCE=1:1:5 D
114 .S FHDPTR=$P(FHDIETS,U,PCE) I FHDPTR="" Q
115 .S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,7)
116 .I FHDNM="" S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,1)
117 .S FHDIETP=FHDIETP_FHDNM_"," Q
118 S FHDIETP=$E(FHDIETP,1,$L(FHDIETP)-1)
119 Q
120PG ;
121 Q:$O(^FHPT(FHDFN,"OP","B",FHRMDT))'>0
122 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
123 D HDR Q
124HDR ;
125 I $G(FHPP)'=1 W:$Y @IOF
126 K FHPP W !?5,"R E C U R R I N G M E A L D I S P L A Y"
127 W !!?3,"OUTPATIENT NAME: " D PATNAME^FHOMUTL W FHPTNM," ",FHSSN
128 W ?65,FHSEX," Age ",FHAGE
129 W !!," #",?5,"Date/Time",?19,"Location Room-Bed",?44,"Service Pnt"
130 W ?57,"Meal",?63,"Diet Ordered"
131 W !,"===",?5,"============",?19,"=========== ==========="
132 W ?44,"===========",?57,"====",?63,"================="
133 Q
134END ;
135 K ENDT,EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM,DIR,BID,DFN,FHDFN
136 K FHRNUM,FHDPTR,FHDNM,FHAGE,FHBID,FHDFN,FHDOB,FHDOW,FHDTDF,FHI,FHLIST,FHLOCZN,FHPCZN
137 K FHPTNM,FHRMDT,FHSERV,FHSEX,FHSF1,FHSF10,FHSF2,FHSF8,FHSFDAT,FHSRV,FHSRVPT,FHSSN,FHTZ,FHTZCNT,FHTZSO
138 K FHTZSO2,FHTZSO6,FHTZSO8,FHTZSOCN,FHTZSOL,FHTZSON,FHZ115,FILE,FLAG,IEN,IEN200,J,NUM,PAD,PCE,PID,POP,SF,STDT
139 Q
Note: See TracBrowser for help on using the repository browser.