source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHOMRP1.m@ 1005

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1FHOMRP1 ;Hines OIFO/RTK RECURRING MEALS PRINT EXPIRING LIST ;4/17/03 09:45
2 ;;5.5;DIETETICS;**1**;Jan 28, 2005
3 W ! K DIR,DIC S DIR("A")="Select Outpatient Ordering Location: "
4 S DIR(0)="PAO^119.6:EMQZ" D ^DIR Q:$D(DIRUT)
5 I Y'=-1 S FHLOC=+Y
6 S FHPARAM=$P($G(^FH(119.6,FHLOC,1)),U,3),FHNOEP=0
7 I FHPARAM="" D Q
8 .W !!?5,"NOTICE: No value set for 'NUMBER OF DAYS FOR REVIEW' "
9 .W !?5,"parameter -- CAN'T CONTINUE",!! Q
10 D NOW^%DTC S FHTODAY=X,X1=FHTODAY,X2=FHPARAM D C^%DTC S FHDSDT=X
11 S FHD=$$FMTE^XLFDT(FHDSDT,"P")
12 W ! K DIR,DIC S DIR("A")="Display recurring meals expiring by: "
13 S DIR(0)="DAEO^"_DT,DIR("B")=FHD D ^DIR Q:$D(DIRUT)
14 I Y'=-1 S FHNDAYS=+Y
15DEV ;get device and set up queue
16 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
17 I '$D(IO("Q")) U IO D DISP,^%ZISC,END Q
18 S ZTRTN="DISP^FHOMRP1"
19 S ZTSAVE("FHLOC")="",ZTSAVE("FHPARAM")="",ZTSAVE("FHNDAYS")=""
20 S ZTSAVE("FHTODAY")="",ZTSAVE("FHNOEP")=""
21 S ZTDESC="Print Recurring Meals Expiration List" D ^%ZTLOAD
22 D ^%ZISC K %ZIS,IOP
23 D END Q
24DISP ;
25 S FHLZN=$G(^FH(119.6,FHLOC,0)),FHLOCNM=$P(FHLZN,U,1)
26 W !!?2,"OUTPATIENT LOCATION: ",FHLOCNM
27 F FHDFN=0:0 S FHDFN=$O(^FHPT("C",FHLOC,FHDFN)) Q:FHDFN'>0 D
28 .S FHRNUM=$O(^FHPT("C",FHLOC,FHDFN,""),-1)
29 .S FHDT=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
30 .I FHDT<FHNDAYS,FHDT>FHTODAY D
31 ..S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0))
32 ..D PATNAME^FHOMUTL S FHNOEP=1
33 ..S FHDATE=$$FMTE^XLFDT(FHDT,"P")
34 ..W !!?3,FHPTNM," RECURRING DIET ORDER EXPIRES ON: ",$E(FHDATE,1,12)
35 ..W !?26,"Ordering",?38,"Service",!?6,"Date/Time",?26,"Location"
36 ..W ?38,"Point",?50,"Meal",?56,"Diet Ordered"
37 ..W !?6,"==================",?26,"=========="
38 ..W ?38,"==========",?50,"====",?56,"================"
39 ..;S FHDTP=$$FMTE^XLFDT(FHRM,"P") W ?6,FHDOW," - ",$E(FHDTP,1,12)
40 ..S FHLNM=$E($P(FHLZN,U,1),1,10),FHSERV=$P(FHLZN,U,10)
41 ..S FHSRV=$S(FHSERV["T":$P(FHLZN,U,5),FHSERV["C":$P(FHLZN,U,6),1:"")
42 ..I FHSRV="" S FHSRVPT="" Q
43 ..S FHSRVPT=$P($G(^FH(119.72,FHSRV,0)),U,1)
44 ..W !?6,$E(FHDATE,1,12),?26,FHLNM,?38,$E(FHSRVPT,1,9),?51,$P(FHNODE,U,4)
45 ..I $P($G(^FH(119.6,FHLOC,1)),U,4)="Y" D DIETPAT^FHOMRR1 W ?56,$E(FHDIETP,1,24)
46 ..I $P($G(^FH(119.6,FHLOC,1)),U,4)'="Y" S FHDPTR=$P(FHNODE,U,2) W ?56,$E($P($G(^FH(111,FHDPTR,0)),U,1),1,24)
47 I FHNOEP=0 D
48 .S FHDSPDT=$$FMTE^XLFDT(FHNDAYS,"P")
49 .W !!?3,"NO RECURRING MEAL PLANS EXPIRING FOR ",FHLOCNM
50 .W " BEFORE ",FHDSPDT,"."
51 Q
52END ;
53 K FHLOC,FHPARAM Q
Note: See TracBrowser for help on using the repository browser.