FHOMRP1 ;Hines OIFO/RTK RECURRING MEALS PRINT EXPIRING LIST  ;4/17/03  09:45
 ;;5.5;DIETETICS;**1**;Jan 28, 2005
 W ! K DIR,DIC S DIR("A")="Select Outpatient Ordering Location: "
 S DIR(0)="PAO^119.6:EMQZ" D ^DIR Q:$D(DIRUT)
 I Y'=-1 S FHLOC=+Y
 S FHPARAM=$P($G(^FH(119.6,FHLOC,1)),U,3),FHNOEP=0
 I FHPARAM="" D  Q
 .W !!?5,"NOTICE: No value set for 'NUMBER OF DAYS FOR REVIEW' "
 .W !?5,"parameter -- CAN'T CONTINUE",!! Q
 D NOW^%DTC S FHTODAY=X,X1=FHTODAY,X2=FHPARAM D C^%DTC S FHDSDT=X
 S FHD=$$FMTE^XLFDT(FHDSDT,"P")
 W ! K DIR,DIC S DIR("A")="Display recurring meals expiring by: "
 S DIR(0)="DAEO^"_DT,DIR("B")=FHD D ^DIR Q:$D(DIRUT)
 I Y'=-1 S FHNDAYS=+Y
DEV ;get device and set up queue
 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
 I '$D(IO("Q")) U IO D DISP,^%ZISC,END Q
 S ZTRTN="DISP^FHOMRP1"
 S ZTSAVE("FHLOC")="",ZTSAVE("FHPARAM")="",ZTSAVE("FHNDAYS")=""
 S ZTSAVE("FHTODAY")="",ZTSAVE("FHNOEP")=""
 S ZTDESC="Print Recurring Meals Expiration List" D ^%ZTLOAD
 D ^%ZISC K %ZIS,IOP
 D END Q
DISP ;
 S FHLZN=$G(^FH(119.6,FHLOC,0)),FHLOCNM=$P(FHLZN,U,1)
 W !!?2,"OUTPATIENT LOCATION: ",FHLOCNM
 F FHDFN=0:0 S FHDFN=$O(^FHPT("C",FHLOC,FHDFN)) Q:FHDFN'>0  D
 .S FHRNUM=$O(^FHPT("C",FHLOC,FHDFN,""),-1)
 .S FHDT=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
 .I FHDT<FHNDAYS,FHDT>FHTODAY D
 ..S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0))
 ..D PATNAME^FHOMUTL S FHNOEP=1
 ..S FHDATE=$$FMTE^XLFDT(FHDT,"P")
 ..W !!?3,FHPTNM,"  RECURRING DIET ORDER EXPIRES ON: ",$E(FHDATE,1,12)
 ..W !?26,"Ordering",?38,"Service",!?6,"Date/Time",?26,"Location"
 ..W ?38,"Point",?50,"Meal",?56,"Diet Ordered"
 ..W !?6,"==================",?26,"=========="
 ..W ?38,"==========",?50,"====",?56,"================"
 ..;S FHDTP=$$FMTE^XLFDT(FHRM,"P") W ?6,FHDOW," - ",$E(FHDTP,1,12)
 ..S FHLNM=$E($P(FHLZN,U,1),1,10),FHSERV=$P(FHLZN,U,10)
 ..S FHSRV=$S(FHSERV["T":$P(FHLZN,U,5),FHSERV["C":$P(FHLZN,U,6),1:"")
 ..I FHSRV="" S FHSRVPT="" Q
 ..S FHSRVPT=$P($G(^FH(119.72,FHSRV,0)),U,1)
 ..W !?6,$E(FHDATE,1,12),?26,FHLNM,?38,$E(FHSRVPT,1,9),?51,$P(FHNODE,U,4)
 ..I $P($G(^FH(119.6,FHLOC,1)),U,4)="Y" D DIETPAT^FHOMRR1 W ?56,$E(FHDIETP,1,24)
 ..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)
 I FHNOEP=0 D
 .S FHDSPDT=$$FMTE^XLFDT(FHNDAYS,"P")
 .W !!?3,"NO RECURRING MEAL PLANS EXPIRING FOR ",FHLOCNM
 .W " BEFORE ",FHDSPDT,"."
 Q
END ;
 K FHLOC,FHPARAM Q