FHWOR31.m

FHWOR31 ; HISC/NCA - HL7 Early/Late Tray (Cont.) ;10/10/00  14:56

 ;;5.5;DIETETICS;;Jan 28, 2005

CUR(FHDFN,ADM,FHDTE,FHV1,FHV2) ; This fuction pass the variable FHORD and FHLD back.

 N A1,FHN,KK,X

 S A1=0,(FHV1,FHV2)="" F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1!(KK>FHDTE)  S A1=KK

 Q:'A1  S FHN=$P(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2),X=^FHPT(FHDFN,"A",ADM,"DI",FHN,0),FHV1=$P(X,"^",2,6),FHV2=$P(X,"^",7) Q

PROC ; Process Add E/L Trays

 D NOW^%DTC S NOW=%

 I FHV2'="" S TXT="Patient is on a WITHHOLD ORDER at that time!" D ERR^FHWOR Q

 I "^^^^"[FHV1 S TXT="Patient has NO DIET ORDER at that time!" D ERR^FHWOR Q

 I SDT=EDT,SDT<NOW S TXT="Can Not Order a Meal for a Date/Time before now!" D ERR^FHWOR Q

 S FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_MEAL_";"_TIM_";"_BAG

 D ^FHORE1A

 I 'FHDAY S TXT="Day of Week Not Within Start and Stop Date." D ERR^FHWOR G EXIT^FHWOR3

 D SEND^FHWOR Q

WKD ; Get week days

 S X=EDT D H^%DTC S:%Y=0 %Y=7 Q:%Y<0

 S WKD=WKD_$E("MTWRFSX",%Y)

 Q

SET ; Set Date/Time in HL7 format

 S:SDT SDT=$$FMTHL7^XLFDT(SDT)

 S:EDT EDT=$$FMTHL7^XLFDT(EDT)

 S:NOW NOW=$$FMTHL7^XLFDT(NOW)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHWOR31   1144     printed  Apr 09, 2024@20:57:27                                                                                                                                                                                                     Page 2

FHWOR31   ; HISC/NCA - HL7 Early/Late Tray (Cont.) ;10/10/00  14:56

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

CUR(FHDFN,ADM,FHDTE,FHV1,FHV2) ; This fuction pass the variable FHORD and FHLD back.

 +1        NEW A1,FHN,KK,X

 +2        SET A1=0

           SET (FHV1,FHV2)=""

           FOR KK=0:0

               SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",KK))

               if KK<1!(KK>FHDTE)

                   QUIT 

               SET A1=KK

 +3        if 'A1

               QUIT 

           SET FHN=$PIECE(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2)

           SET X=^FHPT(FHDFN,"A",ADM,"DI",FHN,0)

           SET FHV1=$PIECE(X,"^",2,6)

           SET FHV2=$PIECE(X,"^",7)

           QUIT 

PROC      ; Process Add E/L Trays

 +1        DO NOW^%DTC

           SET NOW=%

 +2        IF FHV2'=""

               SET TXT="Patient is on a WITHHOLD ORDER at that time!"

               DO ERR^FHWOR

               QUIT 

 +3        IF "^^^^"[FHV1

               SET TXT="Patient has NO DIET ORDER at that time!"

               DO ERR^FHWOR

               QUIT 

 +4        IF SDT=EDT

               IF SDT<NOW

                   SET TXT="Can Not Order a Meal for a Date/Time before now!"

                   DO ERR^FHWOR

                   QUIT 

 +5        SET FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_MEAL_";"_TIM_";"_BAG

 +6        DO ^FHORE1A

 +7        IF 'FHDAY

               SET TXT="Day of Week Not Within Start and Stop Date."

               DO ERR^FHWOR

               GOTO EXIT^FHWOR3

 +8        DO SEND^FHWOR

           QUIT 

WKD       ; Get week days

 +1        SET X=EDT

           DO H^%DTC

           if %Y=0

               SET %Y=7

           if %Y<0

               QUIT 

 +2        SET WKD=WKD_$EXTRACT("MTWRFSX",%Y)

 +3        QUIT 

SET       ; Set Date/Time in HL7 format

 +1        if SDT

               SET SDT=$$FMTHL7^XLFDT(SDT)

 +2        if EDT

               SET EDT=$$FMTHL7^XLFDT(EDT)

 +3        if NOW

               SET NOW=$$FMTHL7^XLFDT(NOW)

 +4        QUIT