- FHWORR ; HISC/NCA - Decode HL7 Utility (Cont.) ;1/30/97 14:22
- ;;5.5;DIETETICS;**2**;Jan 28, 2005
- GETOR ; Call to Get FHORN
- F FHD=0:0 S FHD=$O(FHMSG(FHD)) Q:FHD<1 S XX=$G(FHMSG(FHD)) S FHD1=$$RETURN(XX) I FHD1'="" Q
- S FHORN=FHD1
- Q
- MSH ; Code MSH message
- D SITE^FH
- S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
- ; code PID
- S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
- ; code PV1
- S WARD=$G(^DPT(DFN,.1)) Q:WARD="" S FHWRD=$O(^DIC(42,"B",WARD,0)) Q:'FHWRD S HOSP=+$P($G(^DIC(42,+FHWRD,44)),"^",1) Q:'HOSP S RM=$G(^DPT(DFN,.108)) S:RM RM=$P($G(^DG(405.4,+RM,0)),"^",1)
- S MSG(3)="PV1||I|"_HOSP_"^"_RM_"||||||||||||||||"
- Q
- GADM ; Get the correct Admission number with order.
- S:ADM'=$P(FILL,";",2) ADM=+$P(FILL,";",2)
- Q
- RETURN(FHDOR) ; Return FHORN
- S FHD2=""
- I $E(FHDOR,1,3)="ORC" S FHD2=$P(FHDOR,"|",3)
- Q FHD2
- CHK ; Check if Cancelling Discharged
- S CHK=0 S FHC=$G(FHMSG(3)) I $E(FHC,1,3)'="ORC" Q
- I $P(FHC,"|",2)="DC"!($P(FHC,"|",2)="CA") S CHK=1,X=$G(FHMSG(3)),ADM=$P(X,"|",4),ADM=+$P(ADM,";",2)
- Q
- STATUS ; Send Status As Requested
- I FOR=1 G KIL
- I FOR=2 D NOW^%DTC S NOW=% S FHORN1=+FHORN D OEU^FHORD71 G KIL
- I FOR=3 S FHSTS=$P(DATA,"|",6) I FHSTS="IP" S FHSTS="ZE" D STS G KIL
- I FOR=4 D NOW^%DTC S NOW=% S FHORN1=+FHORN D OEU^FHORD71 G KIL
- I FOR=5 G KIL
- G KIL
- STS ; Send Early/Late Tray Status
- D MSH^FHWOR S $P(MSG(1),"|",9)="ORR"
- S MSG(3)="ORC|SR|"_FHORN_"|"_FILL_"^FH||"_FHSTS
- D MSG^XQOR("FH EVSEND OR",.MSG) K MSG
- Q
- OMSTAT ; Send Outpatient Meals Status
- S FHORN=$P($P(MSG(4),"|",3),"^",1),FILL=$P(MSG(4),"|",4),FHSTTS="IP"
- S FHORNTMP=FHORN,FHCNORS="" D NOW^%DTC S FHTDAT=$P(%,".",1)
- I $E(FILL,1)="R" S FHREND=$P(FILL,";",4),FHMPNUM=$P(FILL,";",2) I FHTDAT>FHREND S FHSTTS="ZE",FHCNORS=FHCNORS_"^"_FHORN K MSG D MSHSS^FHOMUTL,MSG^XQOR("FH EVSEND OR",.MSG) K MSG D
- .F FHRM=0:0 S FHRM=$O(^FHPT(FHDFN,"OP","C",FHMPNUM,FHRM)) Q:FHRM'>0 D
- ..I $D(^FHPT(FHDFN,"OP",FHRM,1)) S FHORN=$P(^FHPT(FHDFN,"OP",FHRM,1),U,4) I FHCNORS'[FHORN S FHCNORS=FHCNORS_"^"_FHORN D MSHSS^FHOMUTL,MSG^XQOR("FH EVSEND OR",.MSG) K MSG
- ..I $D(^FHPT(FHDFN,"OP",FHRM,2)) S FHORN=$P(^FHPT(FHDFN,"OP",FHRM,2),U,5) I FHCNORS'[FHORN S FHCNORS=FHCNORS_"^"_FHORN D MSHSS^FHOMUTL,MSG^XQOR("FH EVSEND OR",.MSG) K MSG
- ..I $D(^FHPT(FHDFN,"OP",FHRM,3)) S FHORN=$P(^FHPT(FHDFN,"OP",FHRM,3),U,4) I FHCNORS'[FHORN S FHCNORS=FHCNORS_"^"_FHORN D MSHSS^FHOMUTL,MSG^XQOR("FH EVSEND OR",.MSG) K MSG
- .Q
- I $E(FILL,1)="S" S FHSEND=$P($P(FILL,";",2),"^",1) I FHTDAT>FHSEND S FHSTTS="ZE" D MSHSS^FHOMUTL,MSG^XQOR("FH EVSEND OR",.MSG) K MSG D
- .I $D(^FHPT(FHDFN,"SM",FHSEND,1)) S FHORN=$P(^FHPT(FHDFN,"SM",FHSEND,1),U,4) D MSHSS^FHOMUTL,MSG^XQOR("FH EVSEND OR",.MSG)
- .Q
- K ACT,FILL,FHORN,MSG S FHORN=FHORNTMP Q
- RESUME(DFN) ; Check whether to prompt resume tray
- ; Return Null for No Current Diet Order in file
- ; Return 0 for not to prompt the user
- ; Return 1 to prompt the user
- ; Return 2 to prompt the user and notify that it's a WITHHOLD SERVICE
- N ADM,A1,A2,D1,D2,FHLD,FHOR,FHORD,K1,TIM,WARD,X,X1,X2,Y
- S Y=0 S WARD=$G(^DPT(DFN,.1)) G:WARD="" EXIT
- S ADM=$G(^DPT("CN",WARD,DFN)) G:ADM<1 EXIT
- ; Get Diet
- S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
- S X1=^FHPT(FHDFN,"A",ADM,0),FHORD=$P(X1,"^",2),X1=$P(X1,"^",3),(FHLD,FHOR,X)="",Y=""
- G:'FHORD EXIT G:'$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)) EXIT
- ; Set FHOR & FHLD variables
- S X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),FHOR=$P(X,"^",2,6),FHLD=$P(X,"^",7),Y=0
- G:"^^^^"'[FHOR EXIT
- G:FHLD="" EXIT
- D NOW^%DTC S TIM=%
- S (D1,FHORD)=0 F K1=0:0 S K1=$O(^FHPT(FHDFN,"A",ADM,"AC",K1)) Q:K1<1!(K1>TIM) S D1=K1
- G:'D1 EXIT
- S0 ; Set AC cross-ref data field
- S X2=D1,D2=$O(^FHPT(FHDFN,"A",ADM,"AC",D1)) S:D2<1 D2=""
- S1 S A2=0 F A1=0:0 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) Q:A1<1!(A1'<X2) S A2=A1
- I A2 S X2=A2,A2=$P(^FHPT(FHDFN,"A",ADM,"AC",A2,0),"^",2),X1=$P(^FHPT(FHDFN,"A",ADM,"DI",A2,0),"^",10) I X1'="",X1'>D1 G S1
- G:'A2 EXIT
- S X=$G(^FHPT(FHDFN,"A",ADM,"DI",A2,0)),FHOR=$P(X,"^",2,6),FHLD=$P(X,"^",7)
- I "^^^^"'[FHOR S Y=1 G EXIT
- I FHLD="N" S Y=2 G EXIT
- EXIT Q Y
- KIL D KIL^FHWOR K FHORN1,FHSTS Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWORR 4126 printed Jan 18, 2025@02:56:51 Page 2
- FHWORR ; HISC/NCA - Decode HL7 Utility (Cont.) ;1/30/97 14:22
- +1 ;;5.5;DIETETICS;**2**;Jan 28, 2005
- GETOR ; Call to Get FHORN
- +1 FOR FHD=0:0
- SET FHD=$ORDER(FHMSG(FHD))
- if FHD<1
- QUIT
- SET XX=$GET(FHMSG(FHD))
- SET FHD1=$$RETURN(XX)
- IF FHD1'=""
- QUIT
- +2 SET FHORN=FHD1
- +3 QUIT
- MSH ; Code MSH message
- +1 DO SITE^FH
- +2 SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
- +3 ; code PID
- +4 SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)
- +5 ; code PV1
- +6 SET WARD=$GET(^DPT(DFN,.1))
- if WARD=""
- QUIT
- SET FHWRD=$ORDER(^DIC(42,"B",WARD,0))
- if 'FHWRD
- QUIT
- SET HOSP=+$PIECE($GET(^DIC(42,+FHWRD,44)),"^",1)
- if 'HOSP
- QUIT
- SET RM=$GET(^DPT(DFN,.108))
- if RM
- SET RM=$PIECE($GET(^DG(405.4,+RM,0)),"^",1)
- +7 SET MSG(3)="PV1||I|"_HOSP_"^"_RM_"||||||||||||||||"
- +8 QUIT
- GADM ; Get the correct Admission number with order.
- +1 if ADM'=$PIECE(FILL,";",2)
- SET ADM=+$PIECE(FILL,";",2)
- +2 QUIT
- RETURN(FHDOR) ; Return FHORN
- +1 SET FHD2=""
- +2 IF $EXTRACT(FHDOR,1,3)="ORC"
- SET FHD2=$PIECE(FHDOR,"|",3)
- +3 QUIT FHD2
- CHK ; Check if Cancelling Discharged
- +1 SET CHK=0
- SET FHC=$GET(FHMSG(3))
- IF $EXTRACT(FHC,1,3)'="ORC"
- QUIT
- +2 IF $PIECE(FHC,"|",2)="DC"!($PIECE(FHC,"|",2)="CA")
- SET CHK=1
- SET X=$GET(FHMSG(3))
- SET ADM=$PIECE(X,"|",4)
- SET ADM=+$PIECE(ADM,";",2)
- +3 QUIT
- STATUS ; Send Status As Requested
- +1 IF FOR=1
- GOTO KIL
- +2 IF FOR=2
- DO NOW^%DTC
- SET NOW=%
- SET FHORN1=+FHORN
- DO OEU^FHORD71
- GOTO KIL
- +3 IF FOR=3
- SET FHSTS=$PIECE(DATA,"|",6)
- IF FHSTS="IP"
- SET FHSTS="ZE"
- DO STS
- GOTO KIL
- +4 IF FOR=4
- DO NOW^%DTC
- SET NOW=%
- SET FHORN1=+FHORN
- DO OEU^FHORD71
- GOTO KIL
- +5 IF FOR=5
- GOTO KIL
- +6 GOTO KIL
- STS ; Send Early/Late Tray Status
- +1 DO MSH^FHWOR
- SET $PIECE(MSG(1),"|",9)="ORR"
- +2 SET MSG(3)="ORC|SR|"_FHORN_"|"_FILL_"^FH||"_FHSTS
- +3 DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- +4 QUIT
- OMSTAT ; Send Outpatient Meals Status
- +1 SET FHORN=$PIECE($PIECE(MSG(4),"|",3),"^",1)
- SET FILL=$PIECE(MSG(4),"|",4)
- SET FHSTTS="IP"
- +2 SET FHORNTMP=FHORN
- SET FHCNORS=""
- DO NOW^%DTC
- SET FHTDAT=$PIECE(%,".",1)
- +3 IF $EXTRACT(FILL,1)="R"
- SET FHREND=$PIECE(FILL,";",4)
- SET FHMPNUM=$PIECE(FILL,";",2)
- IF FHTDAT>FHREND
- SET FHSTTS="ZE"
- SET FHCNORS=FHCNORS_"^"_FHORN
- KILL MSG
- DO MSHSS^FHOMUTL
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- Begin DoDot:1
- +4 FOR FHRM=0:0
- SET FHRM=$ORDER(^FHPT(FHDFN,"OP","C",FHMPNUM,FHRM))
- if FHRM'>0
- QUIT
- Begin DoDot:2
- +5 IF $DATA(^FHPT(FHDFN,"OP",FHRM,1))
- SET FHORN=$PIECE(^FHPT(FHDFN,"OP",FHRM,1),U,4)
- IF FHCNORS'[FHORN
- SET FHCNORS=FHCNORS_"^"_FHORN
- DO MSHSS^FHOMUTL
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- +6 IF $DATA(^FHPT(FHDFN,"OP",FHRM,2))
- SET FHORN=$PIECE(^FHPT(FHDFN,"OP",FHRM,2),U,5)
- IF FHCNORS'[FHORN
- SET FHCNORS=FHCNORS_"^"_FHORN
- DO MSHSS^FHOMUTL
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- +7 IF $DATA(^FHPT(FHDFN,"OP",FHRM,3))
- SET FHORN=$PIECE(^FHPT(FHDFN,"OP",FHRM,3),U,4)
- IF FHCNORS'[FHORN
- SET FHCNORS=FHCNORS_"^"_FHORN
- DO MSHSS^FHOMUTL
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- End DoDot:2
- +8 QUIT
- End DoDot:1
- +9 IF $EXTRACT(FILL,1)="S"
- SET FHSEND=$PIECE($PIECE(FILL,";",2),"^",1)
- IF FHTDAT>FHSEND
- SET FHSTTS="ZE"
- DO MSHSS^FHOMUTL
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- Begin DoDot:1
- +10 IF $DATA(^FHPT(FHDFN,"SM",FHSEND,1))
- SET FHORN=$PIECE(^FHPT(FHDFN,"SM",FHSEND,1),U,4)
- DO MSHSS^FHOMUTL
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- +11 QUIT
- End DoDot:1
- +12 KILL ACT,FILL,FHORN,MSG
- SET FHORN=FHORNTMP
- QUIT
- RESUME(DFN) ; Check whether to prompt resume tray
- +1 ; Return Null for No Current Diet Order in file
- +2 ; Return 0 for not to prompt the user
- +3 ; Return 1 to prompt the user
- +4 ; Return 2 to prompt the user and notify that it's a WITHHOLD SERVICE
- +5 NEW ADM,A1,A2,D1,D2,FHLD,FHOR,FHORD,K1,TIM,WARD,X,X1,X2,Y
- +6 SET Y=0
- SET WARD=$GET(^DPT(DFN,.1))
- if WARD=""
- GOTO EXIT
- +7 SET ADM=$GET(^DPT("CN",WARD,DFN))
- if ADM<1
- GOTO EXIT
- +8 ; Get Diet
- +9 SET FHZ115="P"_DFN
- DO CHECK^FHOMDPA
- IF FHDFN=""
- QUIT
- +10 SET X1=^FHPT(FHDFN,"A",ADM,0)
- SET FHORD=$PIECE(X1,"^",2)
- SET X1=$PIECE(X1,"^",3)
- SET (FHLD,FHOR,X)=""
- SET Y=""
- +11 if 'FHORD
- GOTO EXIT
- if '$DATA(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
- GOTO EXIT
- +12 ; Set FHOR & FHLD variables
- +13 SET X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)
- SET FHOR=$PIECE(X,"^",2,6)
- SET FHLD=$PIECE(X,"^",7)
- SET Y=0
- +14 if "^^^^"'[FHOR
- GOTO EXIT
- +15 if FHLD=""
- GOTO EXIT
- +16 DO NOW^%DTC
- SET TIM=%
- +17 SET (D1,FHORD)=0
- FOR K1=0:0
- SET K1=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",K1))
- if K1<1!(K1>TIM)
- QUIT
- SET D1=K1
- +18 if 'D1
- GOTO EXIT
- S0 ; Set AC cross-ref data field
- +1 SET X2=D1
- SET D2=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",D1))
- if D2<1
- SET D2=""
- S1 SET A2=0
- FOR A1=0:0
- SET A1=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",A1))
- if A1<1!(A1'<X2)
- QUIT
- SET A2=A1
- +1 IF A2
- SET X2=A2
- SET A2=$PIECE(^FHPT(FHDFN,"A",ADM,"AC",A2,0),"^",2)
- SET X1=$PIECE(^FHPT(FHDFN,"A",ADM,"DI",A2,0),"^",10)
- IF X1'=""
- IF X1'>D1
- GOTO S1
- +2 if 'A2
- GOTO EXIT
- +3 SET X=$GET(^FHPT(FHDFN,"A",ADM,"DI",A2,0))
- SET FHOR=$PIECE(X,"^",2,6)
- SET FHLD=$PIECE(X,"^",7)
- +4 IF "^^^^"'[FHOR
- SET Y=1
- GOTO EXIT
- +5 IF FHLD="N"
- SET Y=2
- GOTO EXIT
- EXIT QUIT Y
- KIL DO KIL^FHWOR
- KILL FHORN1,FHSTS
- QUIT