source: FOIAVistA/trunk/r/DIETETICS-FH/FHOMRL1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1FHOMRL1 ;Hines OIFO/RTK OUTPATIENT MEALS RECURRING MEALS LIST ;1/25/05 11:35
2 ;;5.5;DIETETICS;**1,5**;Dec 22, 2004;Build 53
3 ;
4 W @IOF,!!?20,"R E C U R R I N G M E A L 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 S X1=STDT,X2=-1 D C^%DTC S STDT=X
21 D DEV,START
22 Q
23DEV ;get device and set up queue
24 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
25 I '$D(IO("Q")) U IO D DISP,^%ZISC,END Q
26 S ZTRTN="DISP^FHOMRL1"
27 S ZTSAVE("STDT")="",ZTSAVE("ENDT")="",ZTSAVE("FHDFN")=""
28 S ZTSAVE("FHLBY")="",ZTSAVE("FHSELOC")="",ZTSAVE("FHSLCOM")="",ZTSAVE("FHSLPRO")=""
29 S ZTDESC="Outpatient Meals Recurring Meals List" D ^%ZTLOAD
30 D ^%ZISC K %ZIS,IOP
31 D END Q
32 Q
33DISP ; First build data in ^TMP global
34 K ^TMP($J) S EX="",FHPG=0
35 F FHXRDT=STDT:0 S FHXRDT=$O(^FHPT("RM",FHXRDT)) Q:FHXRDT'>0!(FHXRDT>ENDT)!(EX=U) D
36 .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHXRDT,FHDFN)) Q:FHDFN'>0!(EX=U) D
37 ..F FHRM=0:0 S FHRM=$O(^FHPT("RM",FHXRDT,FHDFN,FHRM)) Q:FHRM'>0!(EX=U) D
38 ...S FHZN=$G(^FHPT(FHDFN,"OP",FHRM,0)),FHST=$P(FHZN,U,15) I FHST="C" Q
39 ...D PATNAME^FHOMUTL
40 ...S FHLOC=$P(FHZN,U,3) Q:FHLOC="" I FHLBY="L",FHSELOC'=FHLOC Q
41 ...S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHLBY="C",FHSLCOM'=FHCOMM Q
42 ...S FHPRD=$P($G(^FH(119.73,FHCOMM,0)),U,4) I FHLBY="P",FHSLPRO'=FHPRD Q
43 ...S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
44 ...S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
45 ...S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1)
46 ...S ^TMP($J,FHPRORD_"~"_FHLOCNM,FHXRDT,FHPTNM_"~"_FHRM_"~"_FHDFN)=FHZN
47 ...Q
48 ..Q
49 .Q
50 ; Now display data from the ^TMP global
51 S FHLSRT="" F S FHLSRT=$O(^TMP($J,FHLSRT)) Q:FHLSRT=""!(EX=U) D
52 .D:FHPG>0&(IOST?1"C".E) PG Q:EX=U
53 .D HDR S FHPG=FHPG+1
54 .F FHXRDT=0:0 S FHXRDT=$O(^TMP($J,FHLSRT,FHXRDT)) Q:FHXRDT'>0!(EX=U) D
55 ..S FHPTN="" F S FHPTN=$O(^TMP($J,FHLSRT,FHXRDT,FHPTN)) Q:FHPTN=""!(EX=U) D
56 ...S FHZN=$G(^TMP($J,FHLSRT,FHXRDT,FHPTN)),FHLOC=$P(FHZN,U,3)
57 ...S FHLOCZN=$G(^FH(119.6,FHLOC,0)),FHRNUM=$P(FHPTN,"~",2)
58 ...S FHRMBD=$P(FHZN,U,18),FHRMBNM=""
59 ...I FHRMBD'="" S FHRMBNM=$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,14)
60 ...S FHDFN=$P(FHPTN,"~",3)
61 ...W ! S DTP=FHXRDT D DTP^FH W DTP
62 ...W ?11,$E($P(FHPTN,"~",1),1,19)
63 ...W ?32,$P(FHZN,U,4)
64 ...S FHSRV=$P(FHLOCZN,U,10)
65 ...S FHSPT=$S(FHSRV["T":$P(FHLOCZN,U,5),FHSRV["C":$P(FHLOCZN,U,6),1:"")
66 ...S FHSRVPT="" I FHSPT'="" S FHSRVPT=$P($G(^FH(119.72,FHSPT,0)),U,1)
67 ...W ?36,$E(FHSRVPT,1,11),?48,FHRMBNM
68 ...I $P($G(^FH(119.6,FHLOC,1)),U,4)="Y" D DIETPAT^FHOMRR1 W ?64,$E(FHDIETP,1,16)
69 ...I $P($G(^FH(119.6,FHLOC,1)),U,4)'="Y" S FHDPTR=$P(FHZN,U,2) Q:FHDPTR="" W ?64,$E($P($G(^FH(111,FHDPTR,0)),U,1),1,16)
70 ...I $Y>(IOSL-4) D PG I EX=U Q
71 Q
72PG ;
73 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
74 D HDR Q
75HDR ;
76 W:$Y @IOF
77 W !?25,"R E C U R R I N G M E A L L I S T"
78 W !!?5,"LOCATION: ",$P(FHLSRT,"~",2)
79 W !!,"Date",?11,"Patient Name",?31,"Meal",?36,"Service Pnt"
80 W ?48,"Room-Bed",?64,"Diet Ordered"
81 W !,"=========",?11,"===================",?31,"===="
82 W ?36,"===========",?48,"==============",?64,"================"
83 Q
84END ;
85 K ENDT,FHXRDT,FHRM,FHST,FHSLCOM,FHSLPRO,FHZN,STDT Q
Note: See TracBrowser for help on using the repository browser.