1 | FHOMRP1 ;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
|
---|
15 | DEV ;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
|
---|
24 | DISP ;
|
---|
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
|
---|
52 | END ;
|
---|
53 | K FHLOC,FHPARAM Q
|
---|