54 lines
2.3 KiB
Mathematica
54 lines
2.3 KiB
Mathematica
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
|