FHORD1A.m

FHORD1A ; HISC/REL/NCA - Diet Order Window ;7/11/96  12:21 ;

 ;;5.5;DIETETICS;;Jan 28, 2005

WIN Q:$P(D1,".",1)'=$P(NOW,".",1)  S X1=+$E($P(D1,".",2)_"0000",1,4)

 S X2=+$E($P(NOW,".",2)_"0000",1,4),K1=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8)

 S DP=$P($G(^FH(119.6,+K1,0)),"^",8)

 S X=$G(^FH(119.73,+DP,2))

 F K=1:2:5 S A1=$P(X,"^",K),A2=$P(X,"^",K+1) I A1,A2,X1'<A1,X1'>A2,X2'<A1,X2'>A2 G W1

 Q

W1 S MEAL=$S(K=1:"B",K=3:"N",1:"E"),A1=$P(D1,".",1)

 F K=A1:0 S K=$O(^FHPT(FHDFN,"A",ADM,"EL",K)) Q:K<1!(K\1'=A1)  I $P(^(K,0),"^",2)=MEAL G W5

 W *7,!!,"You have missed the ",$S(MEAL="B":"BREAKFAST",MEAL="N":"NOON",1:"EVENING")," cut-off."

W2 R !!,"Do you wish to order a LATE TRAY? (Y/N): ",YN:DTIME Q:'$T!(YN["^")  S:YN="" YN="^" S X=YN D TR^FH S YN=X I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7," Answer YES or NO" G W2

 Q:YN?1"N".E

 S A1=$G(^FH(119.73,+DP,1)),K=$S(MEAL="B":3,MEAL="N":9,1:15)

 K N S %DT="XT",K2=0 F K1=K+1:1:K+3 S X2=$P(A1,"^",K1) I X2'="" S X=$P(D1,".",1)_"@"_X2 D ^%DT I Y'<NOW S K2=K2+1,N(K2)=X2_"^"_Y

 I 'K2 W *7,!!,"No Late Tray Delivery Times -- Notify Dietetics" Q

 I K2=1 S K1=1 G W4

W3 W !,"Select Time ( " F K1=1:1:K2 W K1,"=",$P(N(K1),"^",1)," "

 R "): ",K1:DTIME Q:'$T!(K1["^")  I K1<1!(K1>K2)!(K1'?1N) W *7,!,"Enter the number of the desired time" G W3

W4 S TIM=$P(N(K1),"^",1),DTE=$P(N(K1),"^",2) N FHORN S FHORN="",NUM=K1

 S BAG="N" D FIL^FHORE1A W "  .. done" Q

W5 Q

FHORD1A   ; HISC/REL/NCA - Diet Order Window ;7/11/96  12:21 ;

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

WIN        IF $PIECE(D1,".",1)'=$PIECE(NOW,".",1)

               QUIT 

           SET X1=+$EXTRACT($PIECE(D1,".",2)_"0000",1,4)

 +1        SET X2=+$EXTRACT($PIECE(NOW,".",2)_"0000",1,4)

           SET K1=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",8)

 +2        SET DP=$PIECE($GET(^FH(119.6,+K1,0)),"^",8)

 +3        SET X=$GET(^FH(119.73,+DP,2))

 +4        FOR K=1:2:5

               SET A1=$PIECE(X,"^",K)

               SET A2=$PIECE(X,"^",K+1)

               IF A1

                   IF A2

                       IF X1'<A1

                           IF X1'>A2

                               IF X2'<A1

                                   IF X2'>A2

                                       GOTO W1

 +5        QUIT 

W1         SET MEAL=$SELECT(K=1:"B",K=3:"N",1:"E")

           SET A1=$PIECE(D1,".",1)

 +1        FOR K=A1:0

               SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",K))

               IF K<1!(K\1'=A1)

                   QUIT 

               IF $PIECE(^(K,0),"^",2)=MEAL

                   GOTO W5

 +2        WRITE *7,!!,"You have missed the ",$SELECT(MEAL="B":"BREAKFAST",MEAL="N":"NOON",1:"EVENING")," cut-off."

W2         READ !!,"Do you wish to order a LATE TRAY? (Y/N): ",YN:DTIME

           IF '$TEST!(YN["^")

               QUIT 

           IF YN=""

               SET YN="^"

           SET X=YN

           DO TR^FH

           SET YN=X

           IF $PIECE("YES",YN,1)'=""

               IF $PIECE("NO",YN,1)'=""

                   WRITE *7," Answer YES or NO"

                   GOTO W2

 +1        IF YN?1"N".E

               QUIT 

 +2        SET A1=$GET(^FH(119.73,+DP,1))

           SET K=$SELECT(MEAL="B":3,MEAL="N":9,1:15)

 +3        KILL N

           SET %DT="XT"

           SET K2=0

           FOR K1=K+1:1:K+3

               SET X2=$PIECE(A1,"^",K1)

               IF X2'=""

                   SET X=$PIECE(D1,".",1)_"@"_X2

                   DO ^%DT

                   IF Y'<NOW

                       SET K2=K2+1

                       SET N(K2)=X2_"^"_Y

 +4        IF 'K2

               WRITE *7,!!,"No Late Tray Delivery Times -- Notify Dietetics"

               QUIT 

 +5        IF K2=1

               SET K1=1

               GOTO W4

W3         WRITE !,"Select Time ( "

           FOR K1=1:1:K2

               WRITE K1,"=",$PIECE(N(K1),"^",1)," "

 +1        READ "): ",K1:DTIME

           IF '$TEST!(K1["^")

               QUIT 

           IF K1<1!(K1>K2)!(K1'?1N)

               WRITE *7,!,"Enter the number of the desired time"

               GOTO W3

W4         SET TIM=$PIECE(N(K1),"^",1)

           SET DTE=$PIECE(N(K1),"^",2)

           NEW FHORN

           SET FHORN=""

           SET NUM=K1

 +1        SET BAG="N"

           DO FIL^FHORE1A

           WRITE "  .. done"

           QUIT 

W5         QUIT