- 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 ---[H[J[2J[HFHWOR31 1144 printed Feb 18, 2025@23:21:46 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