source: FOIAVistA/trunk/r/DIETETICS-FH/FHOMSS2.m@ 873

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1FHOMSS2 ;Hines OIFO/RTK SPECIAL MEALS STATUS LIST ;2/07/06 10:05
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3 ;
4 W @IOF,!!?20,"S P E C I A L M E A L S S T A T U S L I S T"
5START S (FHSELOC,FHSLCOM,FHSLPRO)=""
6 W !! K DIR S DIR("A")="Print by LOCATION, COMM OFFICE, PRODUCTION FACILITY or ALL: "
7 S DIR(0)="SAO^A:ALL;C:COMM OFFICE;L:LOCATION;P:PROD FACILITY" D ^DIR
8 Q:$D(DIRUT) S FHLBY=Y
9 I FHLBY="L" W ! D OUTLOC^FHOMUTL Q:FHLOC="" S FHSELOC=FHLOC,FHLOC=""
10 I FHLBY="C" D Q:FHSLCOM=""
11 .W ! K DIC S DIC=119.73,DIC("A")="Select Communication Office: "
12 .S DIC(0)="AEQZ" D ^DIC Q:$D(DUOUT) I Y=-1 S FHSLCOM="" Q
13 .S FHSLCOM=+Y
14 I FHLBY="P" D Q:FHSLPRO=""
15 .W ! K DIC S DIC=119.71,DIC("A")="Select Production Facility: "
16 .S DIC(0)="AEQZ" D ^DIC Q:$D(DUOUT) I Y=-1 S FHSLPRO="" Q
17 .S FHSLPRO=+Y
18 W ! D STDATE^FHOMUTL I STDT="" Q
19 W ! D ENDATE^FHOMUTL I ENDT="" Q
20 D DEV,START Q
21DEV ;get device and set up queue
22 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
23 I '$D(IO("Q")) U IO D LIST,^%ZISC,END Q
24 S ZTSAVE("STDT")="",ZTSAVE("ENDT")="",ZTSAVE("FHLBY")=""
25 S ZTSAVE("FHSELOC")="",ZTSAVE("FHSLCOM")="",ZTSAVE("FHSLPRO")=""
26 S ZTRTN="LIST^FHOMSS2",ZTDESC="Special Meals Display" D ^%ZTLOAD
27 D ^%ZISC K %ZIS,IOP
28 D END Q
29LIST ; First build data in ^TMP global
30 K ^TMP($J) S NUM=0,EX="",FHPG=0,ENDT=ENDT_.99
31 F FHSMDT=STDT:0 S FHSMDT=$O(^FHPT("SM",FHSMDT)) Q:FHSMDT'>0!(FHSMDT>ENDT)!(EX=U) D
32 .S FHSMDTX=$E(FHSMDT,1,7)
33 .S FHDFN=$O(^FHPT("SM",FHSMDT,"")) D PATNAME^FHOMUTL
34 .S FHNODE=$G(^FHPT(FHDFN,"SM",FHSMDT,0)),FHSTAT=$P(FHNODE,U,2)
35 .I FHSTAT="C" Q
36 .S FHLOC=$P(FHNODE,U,3) Q:FHLOC="" I FHLBY="L",FHSELOC'=FHLOC Q
37 .S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHLBY="C",FHSLCOM'=FHCOMM Q
38 .S FHPRD=$P($G(^FH(119.73,FHCOMM,0)),U,4) I FHLBY="P",FHSLPRO'=FHPRD Q
39 .S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
40 .S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
41 .S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1),FHML=$P(FHNODE,U,9)
42 .S FHML=$S(FHML="B":1,FHML="N":2,FHML="E":3)
43 .S ^TMP($J,FHPRORD_"~"_FHLOCNM,FHSMDTX_"."_FHML,FHPTNM_"~"_FHDFN)=FHNODE
44 .Q
45 ; Now display data from the ^TMP global
46 I '$D(^TMP($J)) W !!,"NO SPECIAL MEALS TO PRINT FOR GIVEN DATE RANGE" Q
47 S FHLSRT="" F S FHLSRT=$O(^TMP($J,FHLSRT)) Q:FHLSRT=""!(EX=U) D
48 .D:FHPG>0&(IOST?1"C".E) PG Q:EX=U
49 .D HDR S FHPG=FHPG+1
50 .F FHSMDT=0:0 S FHSMDT=$O(^TMP($J,FHLSRT,FHSMDT)) Q:FHSMDT'>0!(EX=U) D
51 ..S FHPTN="" F S FHPTN=$O(^TMP($J,FHLSRT,FHSMDT,FHPTN)) Q:FHPTN=""!(EX=U) D
52 ...S FHNODE=$G(^TMP($J,FHLSRT,FHSMDT,FHPTN)),FHLOC=$P(FHNODE,U,3)
53 ...S FHLOCZN=$G(^FH(119.6,FHLOC,0)),FHDFN=$P(FHPTN,"~",2)
54 ...S FHSTAT=$P(FHNODE,U,2),FHSTAT=$S(FHSTAT="P":"PENDING",FHSTAT="A":"AUTH",FHSTAT="D":"DENIED",1:"CANCEL")
55 ...S NUM=NUM+1 D PATNAME^FHOMUTL W !,$E(FHPTNM,1,20)
56 ...S FHSMDTX=$P(FHNODE,U,1)
57 ...S FHD=$$FMTE^XLFDT(FHSMDTX,"P") W ?22,$E(FHD,1,12)
58 ...S FHLPT=$P(FHNODE,U,3),FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,10)
59 ...S FHRMBD=$P(FHNODE,U,13),FHRMBNM=""
60 ...I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,14)
61 ...W ?36,FHRMBNM
62 ...S FHDPT=$P(FHNODE,U,4),FHDIET=$E($P($G(^FH(111,FHDPT,0)),U,1),1,15)
63 ...W ?52,FHDIET
64 ...S FHMEAL=$P(FHNODE,U,9) W ?69,FHMEAL,?73,FHSTAT
65 ...I $E(FHSTAT,1)="D" D
66 ....S FHDENY=$P(FHNODE,U,6) W !?6,"Denied by: "
67 ....I FHDENY'="" W $P($G(^VA(200,FHDENY,0)),U,1)
68 ...S FHCMNT=$P(FHNODE,U,8) I FHCMNT'="" W !?6,"Comment: ",FHCMNT
69 ...I $D(^FHPT(FHDFN,"SM",FHSMDTX,1)) D
70 ....S FHEL=$G(^FHPT(FHDFN,"SM",FHSMDTX,1))
71 ....W !?6,"Early/Late Tray Time: ",$P(FHEL,U,1)
72 ....W " Bagged Meal: ",$P(FHEL,U,2)
73 ....Q
74 ...Q
75 ..Q
76 .I $Y>(IOSL-4) D PG I EX=U Q
77 .Q
78 Q
79PG ;
80 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
81 D HDR Q
82HDR ;
83 W:$Y @IOF
84 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"
85 W !!?5,"LOCATION: ",$P(FHLSRT,"~",2)
86 W !!!,"Patient Name",?22,"Date",?36,"Room-Bed"
87 W ?52,"Diet Ordered",?68,"Meal",?73,"Status"
88 W !,"====================",?22,"============",?36,"=============="
89 W ?52,"===============",?68,"====",?73,"======="
90 Q
91END ;
92 K STDT,ENDT,EX,FHNODE,FHSELOC,FHSLCOM,FHSLPRO,FHPRD,FHSTAT Q
Note: See TracBrowser for help on using the repository browser.