| 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
|
|---|
