- FHWOR2 ; HISC/NCA - HL7 Diet Order ;11/22/00 11:05
- ;;5.5;DIETETICS;;Jan 28, 2005
- S (DATE,D1)=SDT I DATE="" S TXT="No Start Date." D ERR^FHWOR Q
- D NOW^%DTC D CVT^FHWOR S D1=DATE
- S (DATE,D2)=EDT
- I DATE D CVT^FHWOR S D2=DATE
- I D2,D1>D2 S TXT="Wrong Stop Date." D ERR^FHWOR Q
- S DATE=NOW D CVT^FHWOR S NOW=DATE
- S FHRDER=+FHORN
- I D1<% S D1=%
- K DI S N1=0 F K=5:1 S X=$G(FHMSG(K)) Q:X="" D
- .I $E(X,1,3)'="ODS" S TXT="Msg Error." Q
- .S TYP=$E($P(X,"|",2),2) I TYP="" S TXT="No Type of Service." Q
- .I "TCD"'[TYP S TXT="Wrong Type of Tray." Q
- .S DIET=$P(X,"|",4),Y=$P(DIET,"^",4),FILE=$P(DIET,"^",6),COM=$E($P(X,"|",5),1,80)
- .I $E(FILE,1,5)'="99FHD" S TXT="Msg Error." Q
- .S PREC=$P($G(^FH(111,+Y,0)),"^",4) I $D(DI(PREC)) S TXT="Msg Error." Q
- .S N1=N1+1,DI(PREC)=Y_"^"_$G(^FH(111,+Y,0)) Q
- I TXT'="" D ERR^FHWOR Q
- I N1>1 D I CHK S TXT="Can not order REGULAR with another Diet." D ERR^FHWOR Q
- .S CHK=0 F D0=0:0 S D0=$O(DI(D0)) Q:D0="" I +DI(D0)=1 S CHK=1 Q
- I N1>5 S TXT="Can not order more than 5 Diets." D ERR^FHWOR Q
- S D4=0,FHOR="^^^^",FHEVTX="",N1=0 F D0=0:0 S D0=$O(DI(D0)) Q:D0<1 S N1=N1+1,$P(FHOR,"^",N1)=+DI(D0),FHEVTX=FHEVTX_", "_$P(DI(D0),"^",8) S:$P(DI(D0),"^",7)="Y" D4=1
- S FHLD=""
- I '$O(^FH(111.1,"AB",FHOR,0)),$P($G(^FH(119.9,1,4)),"^",2)="Y" S EVT="M^O^^No Diet Pattern ("_$E(FHEVTX,3,999)_")" D ^FHORX
- ; Process PROC
- D PROC^FHORD1
- S CAN=$$CANCEL^ORCDFH(FHRDER)
- I CAN S FHTF=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",4) D:FHTF ORCAN^FHWOR5 K FHRDER
- K FHRDER G KIL
- CAN ; Process Cancel or Discontinue
- S FHORD=$P(FILL,";",3) I 'FHORD D CSEND^FHWOR Q
- D GADM^FHWORR
- S FHREA=$P(DATA,"|",17),FHREA=$P(FHREA,"^",5) I FHREA="Discharge" D DIS^FHWOR4,CSEND^FHWOR K FHREA Q
- D NC
- D CSEND^FHWOR
- D KIL^FHORD3 Q
- NC ; Cancel Diet Order
- D NOW^%DTC S NOW=% S OLD=""
- I '$D(^FHPT(FHDFN,"A",+ADM,"DI",+FHORD,0)) Q
- I $P($G(^FHPT(FHDFN,"A",ADM,"DI",+FHORD,0)),"^",19)'="" Q
- S NSTR=0 F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1!(KK'<NOW) S NSTR=KK
- F KK=NSTR-.000001:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1 I $P(^(KK,0),"^",2)=FHORD G F1
- Q
- F1 D T0^FHORD3
- Q
- DO ; Code Diet Orders
- K MSG S FILL=$G(FHNEW)
- S SDT=D1,DATE1="" D SET
- ; Code MSH, PID, and PV1
- D MSH^FHWOR
- ; code ORC
- S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_DUZ_"|||"_DATE
- ; Code ODS
- F A1=5:1 S A2=$P(FHOR,"^",A1-4) Q:'A2 D
- .;S MSG(A1)="ODS|ZT||^^^"_A2_"^"_$P($G(^FH(111,+A2,0)),"^",1)_"^99FHD" Q
- .I $G(TYP)="" S TYP="T"
- .S MSG(A1)="ODS|Z"_TYP_"||^^^"_A2_"^"_$P($G(^FH(111,+A2,0)),"^",1)_"^99FHD" Q
- K DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT,VAL
- Q
- SET ; Set Date/Time in HL7 format
- S:SDT SDT=$$FMTHL7^XLFDT(SDT)
- S:NOW DATE=$$FMTHL7^XLFDT(NOW)
- S:D2 DATE1=$$FMTHL7^XLFDT(D2) S:'DATE1 DATE1=""
- Q
- KIL ; Kill
- G KIL^FHORD1
- CODE ; Code Cancel/Discontinue Diet Order Status Change
- K MSG N ACT,FILL S FILL=$G(FHMSG1) S ACT=$S(FHSTS=6:"IP",FHSTS=8:"SC",FHSTS=1:"DC",1:"") Q:ACT="" D SITE^FH
- ; code MSH
- S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||"_$S($D(FHORR):"ORR",1:"ORM")
- ; code PID
- S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
- ; code ORC
- S DATE=$S(FHDAT'="":$P(FHDAT,"^",1),1:"")
- I DATE S DATE=$$FMTHL7^XLFDT(DATE) S $P(FHDAT,"^",1)=DATE
- S DATE=$S(FHDAT'="":$P(FHDAT,"^",2),1:"")
- I DATE S DATE=$$FMTHL7^XLFDT(DATE) S $P(FHDAT,"^",2)=DATE
- S MSG(3)="ORC|"_$S($D(FHORR):"SR",1:"SC")_"|"_FHORN_"^OR|"_FILL_"^FH||"_ACT
- I FHDAT'="" S MSG(3)=MSG(3)_"||^^^"_FHDAT
- I ACT="DC" S MSG(3)=MSG(3)_"|||"_$S($D(FHPV):FHPV,1:"")_"||"_$S($D(FHPV):FHPV,1:"")
- K ACT,DATE,FHORR,FILL,SITE,WKDAYS Q
- NA ; OE/RR Number Assign
- S FHORD=+$P(FILL,";",3) S:ADM'=$P(FILL,";",2) ADM=$P(FILL,";",2)
- S $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",14)=+FHORN Q
- EL ; Late Trays HL7 to OE/RR
- K MSG S WKDAYS="",(EDT,SDT)=DTE
- S ITVL="ONCE",WKD="",SERV="L"
- S FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_MEAL_";"_TIM_";"_BAG
- D SET^FHWOR3
- ; Code MSH, PID, and PV1
- D MSH^FHWOR
- ; code ORC
- S MSG(4)="ORC|SN||"_FILL_"^FH||||^"_ITVL_"^^"_SDT_"^"_EDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
- ; code ODT
- S MSG(5)="ODT|"_$S(SERV="E":"EARLY",1:"LATE")_"|^^^"_MEAL_SERV_NUM_"^^99FHS|"_$S(BAG="Y":"bagged",1:"")
- K FHWARD,FILL,HOSP,ITVL,FHORN,RM,SITE,WARD,WKDAYS,Z
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR2 4263 printed Feb 18, 2025@23:21:44 Page 2
- FHWOR2 ; HISC/NCA - HL7 Diet Order ;11/22/00 11:05
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 SET (DATE,D1)=SDT
- IF DATE=""
- SET TXT="No Start Date."
- DO ERR^FHWOR
- QUIT
- +3 DO NOW^%DTC
- DO CVT^FHWOR
- SET D1=DATE
- +4 SET (DATE,D2)=EDT
- +5 IF DATE
- DO CVT^FHWOR
- SET D2=DATE
- +6 IF D2
- IF D1>D2
- SET TXT="Wrong Stop Date."
- DO ERR^FHWOR
- QUIT
- +7 SET DATE=NOW
- DO CVT^FHWOR
- SET NOW=DATE
- +8 SET FHRDER=+FHORN
- +9 IF D1<%
- SET D1=%
- +10 KILL DI
- SET N1=0
- FOR K=5:1
- SET X=$GET(FHMSG(K))
- if X=""
- QUIT
- Begin DoDot:1
- +11 IF $EXTRACT(X,1,3)'="ODS"
- SET TXT="Msg Error."
- QUIT
- +12 SET TYP=$EXTRACT($PIECE(X,"|",2),2)
- IF TYP=""
- SET TXT="No Type of Service."
- QUIT
- +13 IF "TCD"'[TYP
- SET TXT="Wrong Type of Tray."
- QUIT
- +14 SET DIET=$PIECE(X,"|",4)
- SET Y=$PIECE(DIET,"^",4)
- SET FILE=$PIECE(DIET,"^",6)
- SET COM=$EXTRACT($PIECE(X,"|",5),1,80)
- +15 IF $EXTRACT(FILE,1,5)'="99FHD"
- SET TXT="Msg Error."
- QUIT
- +16 SET PREC=$PIECE($GET(^FH(111,+Y,0)),"^",4)
- IF $DATA(DI(PREC))
- SET TXT="Msg Error."
- QUIT
- +17 SET N1=N1+1
- SET DI(PREC)=Y_"^"_$GET(^FH(111,+Y,0))
- QUIT
- End DoDot:1
- +18 IF TXT'=""
- DO ERR^FHWOR
- QUIT
- +19 IF N1>1
- Begin DoDot:1
- +20 SET CHK=0
- FOR D0=0:0
- SET D0=$ORDER(DI(D0))
- if D0=""
- QUIT
- IF +DI(D0)=1
- SET CHK=1
- QUIT
- End DoDot:1
- IF CHK
- SET TXT="Can not order REGULAR with another Diet."
- DO ERR^FHWOR
- QUIT
- +21 IF N1>5
- SET TXT="Can not order more than 5 Diets."
- DO ERR^FHWOR
- QUIT
- +22 SET D4=0
- SET FHOR="^^^^"
- SET FHEVTX=""
- SET N1=0
- FOR D0=0:0
- SET D0=$ORDER(DI(D0))
- if D0<1
- QUIT
- SET N1=N1+1
- SET $PIECE(FHOR,"^",N1)=+DI(D0)
- SET FHEVTX=FHEVTX_", "_$PIECE(DI(D0),"^",8)
- if $PIECE(DI(D0),"^",7)="Y"
- SET D4=1
- +23 SET FHLD=""
- +24 IF '$ORDER(^FH(111.1,"AB",FHOR,0))
- IF $PIECE($GET(^FH(119.9,1,4)),"^",2)="Y"
- SET EVT="M^O^^No Diet Pattern ("_$EXTRACT(FHEVTX,3,999)_")"
- DO ^FHORX
- +25 ; Process PROC
- +26 DO PROC^FHORD1
- +27 SET CAN=$$CANCEL^ORCDFH(FHRDER)
- +28 IF CAN
- SET FHTF=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",4)
- if FHTF
- DO ORCAN^FHWOR5
- KILL FHRDER
- +29 KILL FHRDER
- GOTO KIL
- CAN ; Process Cancel or Discontinue
- +1 SET FHORD=$PIECE(FILL,";",3)
- IF 'FHORD
- DO CSEND^FHWOR
- QUIT
- +2 DO GADM^FHWORR
- +3 SET FHREA=$PIECE(DATA,"|",17)
- SET FHREA=$PIECE(FHREA,"^",5)
- IF FHREA="Discharge"
- DO DIS^FHWOR4
- DO CSEND^FHWOR
- KILL FHREA
- QUIT
- +4 DO NC
- +5 DO CSEND^FHWOR
- +6 DO KIL^FHORD3
- QUIT
- NC ; Cancel Diet Order
- +1 DO NOW^%DTC
- SET NOW=%
- SET OLD=""
- +2 IF '$DATA(^FHPT(FHDFN,"A",+ADM,"DI",+FHORD,0))
- QUIT
- +3 IF $PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",+FHORD,0)),"^",19)'=""
- QUIT
- +4 SET NSTR=0
- FOR KK=0:0
- SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",KK))
- if KK<1!(KK'<NOW)
- QUIT
- SET NSTR=KK
- +5 FOR KK=NSTR-.000001:0
- SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",KK))
- if KK<1
- QUIT
- IF $PIECE(^(KK,0),"^",2)=FHORD
- GOTO F1
- +6 QUIT
- F1 DO T0^FHORD3
- +1 QUIT
- DO ; Code Diet Orders
- +1 KILL MSG
- SET FILL=$GET(FHNEW)
- +2 SET SDT=D1
- SET DATE1=""
- DO SET
- +3 ; Code MSH, PID, and PV1
- +4 DO MSH^FHWOR
- +5 ; code ORC
- +6 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_DUZ_"|||"_DATE
- +7 ; Code ODS
- +8 FOR A1=5:1
- SET A2=$PIECE(FHOR,"^",A1-4)
- if 'A2
- QUIT
- Begin DoDot:1
- +9 ;S MSG(A1)="ODS|ZT||^^^"_A2_"^"_$P($G(^FH(111,+A2,0)),"^",1)_"^99FHD" Q
- +10 IF $GET(TYP)=""
- SET TYP="T"
- +11 SET MSG(A1)="ODS|Z"_TYP_"||^^^"_A2_"^"_$PIECE($GET(^FH(111,+A2,0)),"^",1)_"^99FHD"
- QUIT
- End DoDot:1
- +12 KILL DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT,VAL
- +13 QUIT
- SET ; Set Date/Time in HL7 format
- +1 if SDT
- SET SDT=$$FMTHL7^XLFDT(SDT)
- +2 if NOW
- SET DATE=$$FMTHL7^XLFDT(NOW)
- +3 if D2
- SET DATE1=$$FMTHL7^XLFDT(D2)
- if 'DATE1
- SET DATE1=""
- +4 QUIT
- KIL ; Kill
- +1 GOTO KIL^FHORD1
- CODE ; Code Cancel/Discontinue Diet Order Status Change
- +1 KILL MSG
- NEW ACT,FILL
- SET FILL=$GET(FHMSG1)
- SET ACT=$SELECT(FHSTS=6:"IP",FHSTS=8:"SC",FHSTS=1:"DC",1:"")
- if ACT=""
- QUIT
- DO SITE^FH
- +2 ; code MSH
- +3 SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||"_$SELECT($DATA(FHORR):"ORR",1:"ORM")
- +4 ; code PID
- +5 SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)
- +6 ; code ORC
- +7 SET DATE=$SELECT(FHDAT'="":$PIECE(FHDAT,"^",1),1:"")
- +8 IF DATE
- SET DATE=$$FMTHL7^XLFDT(DATE)
- SET $PIECE(FHDAT,"^",1)=DATE
- +9 SET DATE=$SELECT(FHDAT'="":$PIECE(FHDAT,"^",2),1:"")
- +10 IF DATE
- SET DATE=$$FMTHL7^XLFDT(DATE)
- SET $PIECE(FHDAT,"^",2)=DATE
- +11 SET MSG(3)="ORC|"_$SELECT($DATA(FHORR):"SR",1:"SC")_"|"_FHORN_"^OR|"_FILL_"^FH||"_ACT
- +12 IF FHDAT'=""
- SET MSG(3)=MSG(3)_"||^^^"_FHDAT
- +13 IF ACT="DC"
- SET MSG(3)=MSG(3)_"|||"_$SELECT($DATA(FHPV):FHPV,1:"")_"||"_$SELECT($DATA(FHPV):FHPV,1:"")
- +14 KILL ACT,DATE,FHORR,FILL,SITE,WKDAYS
- QUIT
- NA ; OE/RR Number Assign
- +1 SET FHORD=+$PIECE(FILL,";",3)
- if ADM'=$PIECE(FILL,";",2)
- SET ADM=$PIECE(FILL,";",2)
- +2 SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",14)=+FHORN
- QUIT
- EL ; Late Trays HL7 to OE/RR
- +1 KILL MSG
- SET WKDAYS=""
- SET (EDT,SDT)=DTE
- +2 SET ITVL="ONCE"
- SET WKD=""
- SET SERV="L"
- +3 SET FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_MEAL_";"_TIM_";"_BAG
- +4 DO SET^FHWOR3
- +5 ; Code MSH, PID, and PV1
- +6 DO MSH^FHWOR
- +7 ; code ORC
- +8 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^"_ITVL_"^^"_SDT_"^"_EDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
- +9 ; code ODT
- +10 SET MSG(5)="ODT|"_$SELECT(SERV="E":"EARLY",1:"LATE")_"|^^^"_MEAL_SERV_NUM_"^^99FHS|"_$SELECT(BAG="Y":"bagged",1:"")
- +11 KILL FHWARD,FILL,HOSP,ITVL,FHORN,RM,SITE,WARD,WKDAYS,Z
- +12 QUIT