source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHDPSM.m@ 1474

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1FHDPSM ;Hines OIFO/RTK/FAI SPECIAL MEALS DISPLAY ;10/20/04 14:22
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4LIST ;
5 K FHLIST S FHS="ACDP",NUM=0,EX="" D HDR
6 F FHSMDT=STDT:0 S FHSMDT=$O(^FHPT(FHDFN,"SM",FHSMDT)) Q:FHSMDT'>0!(FHSMDT<STDT)!(FHSMDT>ENDT)!(EX=U) D
7 .S FHNODE=$G(^FHPT(FHDFN,"SM",FHSMDT,0)),FHSTAT=$P(FHNODE,U,2)
8 .I FHS'[FHSTAT Q
9 .S FHSTAT=$S(FHSTAT="P":"PENDING",FHSTAT="A":"AUTHORIZED",FHSTAT="D":"DENIED",1:"CANCELLED")
10 .S NUM=NUM+1,PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
11 .D PATNAME^FHOMUTL
12 .S FHD=$$FMTE^XLFDT(FHSMDT,"P") W ?8,$E(FHD,1,12)
13 .S FHLPT=$P($G(FHNODE),U,3),FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,10)
14 .W ?26,FHLOC
15 .S FHDPT=$P(FHNODE,U,4),FHDIET=$E($P($G(^FH(111,FHDPT,0)),U,1),1,12)
16 .W ?40,FHDIET
17 .S FHMEAL=$P(FHNODE,U,9) W ?57,FHMEAL,?65,FHSTAT
18 .S FHLIST(NUM)=FHDFN_"^"_FHSMDT
19 .I $E(FHSTAT,1)="D" D
20 ..S FHDENY=$P(FHNODE,U,6)
21 ..I FHDENY'="" W !,?6,"Denied By: ",$P($G(^VA(200,FHDENY,0)),U,1)
22 .S FHCOMM=$P(FHNODE,U,8) I FHCOMM'="" W !?6,"Comment: ",FHCOMM
23 .I $D(^FHPT(FHDFN,"SM",FHSMDT,1)) D
24 ..S FHEL=$G(^FHPT(FHDFN,"SM",FHSMDT,1))
25 ..W !?6,"Early/Late Tray Time: ",$P(FHEL,U,1)
26 ..W " Bagged Meal: ",$P(FHEL,U,2)
27 ..Q
28 .I $Y>(IOSL-4) D PG I EX=U Q
29 .Q
30 I NUM=0 W !!,"NO SPECIAL MEALS FOR THIS DATE RANGE" Q
31 Q
32PG ;
33 Q:$O(^FHPT(FHDFN,"SM",FHSMDT))'>0
34 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
35 D HDR Q
36HDR ;
37 W:$Y @IOF
38 W !?15,"S P E C I A L M E A L S "
39 W !!!?1,"#",?8,"Date/Time",?26,"Location",?40,"Diet Ordered",?57,"Meal",?65,"Status"
40 W !,"===",?7,"============",?25,"==========",?39,"============",?56,"====",?65,"========="
41 Q
42END ;
43 K EX,FHNODE,FHSTAT Q
Note: See TracBrowser for help on using the repository browser.