FHORE1A ; HISC/REL - File Early/Late Order ;6/21/96 10:14
;;5.5;DIETETICS;;Jan 28, 2005
PROC ; File complete order
S FHDAY=0,DTE=SDT I SDT=EDT D FIL G F13
F11 G:DTE<NOW F12
S X=DTE\1 D DOW^%DTC G:WKD'[$E("XMTWRFS",Y+1) F12
F K=X:0 S K=$O(^FHPT(FHDFN,"A",ADM,"EL",K)) Q:K<1!(K\1'=X) I $P(^(K,0),"^",2)=MEAL W:FHWF'=2 *7,!,"Early/Late Meal Already Ordered for ",$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3),! G F12
D FIL W:FHWF'=2 "."
F12 S X1=DTE\1,X2=1 D C^%DTC G:X>EDT F13
S X=X_"@"_TIM,%DT="XT" D ^%DT S DTE=Y G F11
F13 W:FHWF'=2 "... done" Q
FIL ; File daily order
I '$D(^FHPT(FHDFN,"A",ADM,"EL",0)) S ^(0)="^115.05D^^"
S %=$P(^FHPT(FHDFN,"A",ADM,"EL",0),"^",4)+1,$P(^(0),"^",3,4)=DTE_"^"_%
S ^FHPT(FHDFN,"A",ADM,"EL",DTE,0)=DTE_"^"_MEAL_"^"_TIM_"^"_BAG_"^"_DUZ_"^"_NOW_"^"_+FHORN,FHDAY=1
S ^FHPT("ADLT",DTE,FHDFN,ADM)="" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORE1A 848 printed Dec 13, 2024@01:53:46 Page 2
FHORE1A ; HISC/REL - File Early/Late Order ;6/21/96 10:14
+1 ;;5.5;DIETETICS;;Jan 28, 2005
PROC ; File complete order
+1 SET FHDAY=0
SET DTE=SDT
IF SDT=EDT
DO FIL
GOTO F13
F11 if DTE<NOW
GOTO F12
+1 SET X=DTE\1
DO DOW^%DTC
if WKD'[$EXTRACT("XMTWRFS",Y+1)
GOTO F12
+2 FOR K=X:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",K))
if K<1!(K\1'=X)
QUIT
IF $PIECE(^(K,0),"^",2)=MEAL
if FHWF'=2
WRITE *7,!,"Early/Late Meal Already Ordered for ",$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3),!
GOTO F12
+3 DO FIL
if FHWF'=2
WRITE "."
F12 SET X1=DTE\1
SET X2=1
DO C^%DTC
if X>EDT
GOTO F13
+1 SET X=X_"@"_TIM
SET %DT="XT"
DO ^%DT
SET DTE=Y
GOTO F11
F13 if FHWF'=2
WRITE "... done"
QUIT
FIL ; File daily order
+1 IF '$DATA(^FHPT(FHDFN,"A",ADM,"EL",0))
SET ^(0)="^115.05D^^"
+2 SET %=$PIECE(^FHPT(FHDFN,"A",ADM,"EL",0),"^",4)+1
SET $PIECE(^(0),"^",3,4)=DTE_"^"_%
+3 SET ^FHPT(FHDFN,"A",ADM,"EL",DTE,0)=DTE_"^"_MEAL_"^"_TIM_"^"_BAG_"^"_DUZ_"^"_NOW_"^"_+FHORN
SET FHDAY=1
+4 SET ^FHPT("ADLT",DTE,FHDFN,ADM)=""
QUIT
