FHIPST5 ; HISC/REL - Set Future Diets in TaskMan ;4/5/96 11:28
;;5.0;Dietetics;**2**;Mar 25, 1996
D NOW^%DTC S NOW=%
S NXWD="" F S NXWD=$O(^DPT("CN",NXWD)) Q:NXWD="" F DFN=0:0 S DFN=$O(^DPT("CN",NXWD,DFN)) Q:DFN<1 S ADM=$G(^(DFN)) D:ADM LOOK
Q
LOOK ; Check Patient
S X1=$G(^FHPT(DFN,"A",ADM,0)),FHORD=$P(X1,"^",2),X1=$P(X1,"^",3)
I X1>1,X1'>NOW D U1^FHORD7 G LOOK
F Z6=NOW:0 S Z6=$O(^FHPT(DFN,"A",ADM,"AC",Z6)) Q:Z6<1 D
.S ZTIO="",ZTRTN="UPD^FHORD7",ZTREQ="@",ZTDESC="Diet Update",ZTDTH=+Z6
.S ZTSAVE("DFN")=DFN,ZTSAVE("ADM")=ADM,ZTSAVE("Z6")=+Z6,ZTSAVE("ZTREQ")="" D ^%ZTLOAD K ZTSK Q
Q
FHIPST5 ; HISC/REL - Set Future Diets in TaskMan ;4/5/96 11:28
+1 ;;5.0;Dietetics;**2**;Mar 25, 1996
+2 DO NOW^%DTC
SET NOW=%
+3 SET NXWD=""
FOR
SET NXWD=$ORDER(^DPT("CN",NXWD))
IF NXWD=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^DPT("CN",NXWD,DFN))
IF DFN<1
QUIT
SET ADM=$GET(^(DFN))
IF ADM
DO LOOK
+4 QUIT
LOOK ; Check Patient
+1 SET X1=$GET(^FHPT(DFN,"A",ADM,0))
SET FHORD=$PIECE(X1,"^",2)
SET X1=$PIECE(X1,"^",3)
+2 IF X1>1
IF X1'>NOW
DO U1^FHORD7
GOTO LOOK
+3 FOR Z6=NOW:0
SET Z6=$ORDER(^FHPT(DFN,"A",ADM,"AC",Z6))
IF Z6<1
QUIT
Begin DoDot:1
+4 SET ZTIO=""
SET ZTRTN="UPD^FHORD7"
SET ZTREQ="@"
SET ZTDESC="Diet Update"
SET ZTDTH=+Z6
+5 SET ZTSAVE("DFN")=DFN
SET ZTSAVE("ADM")=ADM
SET ZTSAVE("Z6")=+Z6
SET ZTSAVE("ZTREQ")=""
DO ^%ZTLOAD
KILL ZTSK
QUIT
End DoDot:1
+6 QUIT