FHORE1A.m

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

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