- FHORR ; HISC/NCA/JH - Diet Order Utilities For OE/RR Interface ;10/10/00 14:54
- ;;5.5;DIETETICS;;Jan 28, 2005
- OE ; File OE/RR Diet Order For Re-instated Diet Order
- Q:$P(FHNO1,"^",7)="X"!($P(FHNO1,"^",7)="P")
- S FHO=$P(FHNO1,"^",2,6),VAL="" D VAL^FHWORP(FHO,.VAL) Q:VAL=""
- S FHNEW=$S($P(FHNO1,"^",7)'="":"N",1:"D")_";"_ADM_";"_FHORD1_";"_D2_";"_$P(FHNO1,"^",10)_";"_$P(FHNO1,"^",7)_";"_FHNO2_";"_$P(FHNO1,"^",8)_";"_0_";"_VAL
- S (FHSTS,FHDU)=$S(D2>NOW:8,1:6) S FHDIE=FHORD
- I $P(FHNO1,"^",7)="N" D NPO D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG S FHORD=FHDIE K FHDIE G SAV
- I $P(FHNO1,"^",7)="" D DO D:$D(MSG) MSG^XQOR("FH EVSEND OR",.MSG) K MSG
- S FHORD=FHDIE K FHDIE
- SAV S:FHDU $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD1,0),"^",15)=FHDU Q
- DO ; Code Re-instated Diet Orders
- K MSG S FILL=$G(FHNEW)
- S SDT=D2,DATE1="" D SET
- ; Code MSH, PID, and PV1
- D MSH^FHWOR
- ; code ORC
- S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_FHPV_"|||"_DATE
- ; Code ODS
- F A7=5:1 S A8=$P(FHNO1,"^",A7-3) Q:'A8 D
- .S MSG(A7)="ODS|ZT||^^^"_A8_"^"_$P($G(^FH(111,+A8,0)),"^",1)_"^99FHD" Q
- K A7,A8,DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT,VAL
- Q
- NPO ; Code Re-instated NPO Order
- K MSG S FILL=$G(FHNEW) Q:FILL=""
- S SDT=D2,DATE1="" D SET
- ; Code MSH, PID, and PV1
- D MSH^FHWOR
- ; code ORC
- S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_SDT_"^"_DATE1_"|||"_DUZ_"||"_FHPV_"|||"_DATE
- ; Code ODS
- S MSG(5)="ODS|D||^^^FH-5^NPO^99OTH|"_COM
- K DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT
- Q
- SET ; Set Date/Time in HL7 format
- S DATR=$S($P(FHNO1,"^",10):$P(FHNO1,"^",10),1:"")
- S:SDT SDT=$$FMTHL7^XLFDT(SDT)
- S:NOW DATE=$$FMTHL7^XLFDT(NOW)
- S:DATR DATE1=$$FMTHL7^XLFDT(DATR) S:'DATE1 DATE1="" K DATR
- Q
- ORD ; Get next order # for re-instate diet order
- L +^FHPT(FHDFN,"A",ADM,"DI",0)
- I '$D(^FHPT(FHDFN,"A",ADM,"DI",0)) S ^FHPT(FHDFN,"A",ADM,"DI",0)="^115.02A^^"
- S X=^FHPT(FHDFN,"A",ADM,"DI",0),FHORD1=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_FHORD1_"^"_($P(X,"^",4)+1)
- L -^FHPT(FHDFN,"A",ADM,"DI",0) Q:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD1)) G ORD
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORR 2064 printed Mar 13, 2025@20:58:29 Page 2
- FHORR ; HISC/NCA/JH - Diet Order Utilities For OE/RR Interface ;10/10/00 14:54
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- OE ; File OE/RR Diet Order For Re-instated Diet Order
- +1 if $PIECE(FHNO1,"^",7)="X"!($PIECE(FHNO1,"^",7)="P")
- QUIT
- +2 SET FHO=$PIECE(FHNO1,"^",2,6)
- SET VAL=""
- DO VAL^FHWORP(FHO,.VAL)
- if VAL=""
- QUIT
- +3 SET FHNEW=$SELECT($PIECE(FHNO1,"^",7)'="":"N",1:"D")_";"_ADM_";"_FHORD1_";"_D2_";"_$PIECE(FHNO1,"^",10)_";"_$PIECE(FHNO1,"^",7)_";"_FHNO2_";"_$PIECE(FHNO1,"^",8)_";"_0_";"_VAL
- +4 SET (FHSTS,FHDU)=$SELECT(D2>NOW:8,1:6)
- SET FHDIE=FHORD
- +5 IF $PIECE(FHNO1,"^",7)="N"
- DO NPO
- if $DATA(MSG)
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- SET FHORD=FHDIE
- KILL FHDIE
- GOTO SAV
- +6 IF $PIECE(FHNO1,"^",7)=""
- DO DO
- if $DATA(MSG)
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- +7 SET FHORD=FHDIE
- KILL FHDIE
- SAV if FHDU
- SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHORD1,0),"^",15)=FHDU
- QUIT
- DO ; Code Re-instated Diet Orders
- +1 KILL MSG
- SET FILL=$GET(FHNEW)
- +2 SET SDT=D2
- 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_"||"_FHPV_"|||"_DATE
- +7 ; Code ODS
- +8 FOR A7=5:1
- SET A8=$PIECE(FHNO1,"^",A7-3)
- if 'A8
- QUIT
- Begin DoDot:1
- +9 SET MSG(A7)="ODS|ZT||^^^"_A8_"^"_$PIECE($GET(^FH(111,+A8,0)),"^",1)_"^99FHD"
- QUIT
- End DoDot:1
- +10 KILL A7,A8,DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT,VAL
- +11 QUIT
- NPO ; Code Re-instated NPO Order
- +1 KILL MSG
- SET FILL=$GET(FHNEW)
- if FILL=""
- QUIT
- +2 SET SDT=D2
- 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_"||"_FHPV_"|||"_DATE
- +7 ; Code ODS
- +8 SET MSG(5)="ODS|D||^^^FH-5^NPO^99OTH|"_COM
- +9 KILL DATE,DATE1,FILL,FHWRD,HOSP,RM,SITE,SDT
- +10 QUIT
- SET ; Set Date/Time in HL7 format
- +1 SET DATR=$SELECT($PIECE(FHNO1,"^",10):$PIECE(FHNO1,"^",10),1:"")
- +2 if SDT
- SET SDT=$$FMTHL7^XLFDT(SDT)
- +3 if NOW
- SET DATE=$$FMTHL7^XLFDT(NOW)
- +4 if DATR
- SET DATE1=$$FMTHL7^XLFDT(DATR)
- if 'DATE1
- SET DATE1=""
- KILL DATR
- +5 QUIT
- ORD ; Get next order # for re-instate diet order
- +1 LOCK +^FHPT(FHDFN,"A",ADM,"DI",0)
- +2 IF '$DATA(^FHPT(FHDFN,"A",ADM,"DI",0))
- SET ^FHPT(FHDFN,"A",ADM,"DI",0)="^115.02A^^"
- +3 SET X=^FHPT(FHDFN,"A",ADM,"DI",0)
- SET FHORD1=$PIECE(X,"^",3)+1
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_FHORD1_"^"_($PIECE(X,"^",4)+1)
- +4 LOCK -^FHPT(FHDFN,"A",ADM,"DI",0)
- if '$DATA(^FHPT(FHDFN,"A",ADM,"DI",FHORD1))
- QUIT
- GOTO ORD
