- FHWOR4 ; HISC/NCA - HL7 NPO ;10/10/00 14:57
- ;;5.5;DIETETICS;;Jan 28, 2005
- S (DATE,D1)=SDT I DATE="" S TXT="No Start Date." D ERR^FHWOR Q
- D CVT^FHWOR S D1=DATE
- S (DATE,D2)=$P(DUR,"^",5)
- 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 COM=$E($P(MSG(5),"|",5),1,80)
- ; Process NPO
- D F7^FHORD3
- 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,CSEND^FHWOR K FHREA Q
- D NC
- D CSEND^FHWOR G KIL
- NC ; Cancel NPO
- 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
- KIL G KIL^FHORD3
- NPO ; Code NPO Order
- K MSG S FILL=$G(FHNEW) Q:FILL=""
- 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
- 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:SDT SDT=$$FMTHL7^XLFDT(SDT)
- S:NOW DATE=$$FMTHL7^XLFDT(NOW)
- S:D2 DATE1=$$FMTHL7^XLFDT(D2) S:'DATE1 DATE1=""
- Q
- CODE ; Code Cancel/Discontinue NPO Order Status Change
- K MSG N ACT,FILL S FILL=$G(FHMSG1) Q:FILL="" 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,FHORR,FILL,SITE,WKDAYS Q
- NA ; OE/RR Number Assign
- S FHORD=+$P(FILL,";",3) Q:'FHORD S:ADM'=$P(FILL,";",2) ADM=$P(FILL,";",2)
- S $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",14)=+FHORN Q
- DIS ; Process Cancel of Diet/NPO for Discharge
- S FHGET=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
- I $P(FHGET,"^",14)>0,$P(FHGET,"^",15)>2 S $P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",15)=1
- D NOW^%DTC S NOW=%
- F A1=NOW:0 S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1)) Q:A1="" K ^FHPT(FHDFN,"A",ADM,"AC",A1)
- F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"DI",FHDR)) Q:FHDR<1 D D1
- S FHGET=$G(^FHPT(FHDFN,"A",ADM,0)),FHGET=$P(FHGET,"^",2) Q:'FHGET
- S FHX=$G(^FHPT(FHDFN,"A",ADM,"DI",FHGET,0))
- Q:$P(FHX,"^",7)="X"
- D ORD^FHORD7 S ^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)=FHORD_"^^^^^^X^^"_NOW_"^^"_DUZ_"^"_NOW
- S ^FHPT(FHDFN,"A",ADM,"AC",NOW,0)=NOW_"^"_FHORD
- S $P(^FHPT(FHDFN,"A",ADM,0),"^",2,3)=FHORD_"^" K A1,FHDR,FHGET,FHX,FHOX1 Q
- D1 ; Get all filler fields for Diet
- S FHOX1=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14,15)
- I +FHOX1>0,$P(FHOX1,"^",2)>2 S FHOX1=+FHOX1,$P(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",15)=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR4 3346 printed Feb 18, 2025@23:21:47 Page 2
- FHWOR4 ; HISC/NCA - HL7 NPO ;10/10/00 14:57
- +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 CVT^FHWOR
- SET D1=DATE
- +4 SET (DATE,D2)=$PIECE(DUR,"^",5)
- +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 COM=$EXTRACT($PIECE(MSG(5),"|",5),1,80)
- +9 ; Process NPO
- +10 DO F7^FHORD3
- +11 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
- DO CSEND^FHWOR
- KILL FHREA
- QUIT
- +4 DO NC
- +5 DO CSEND^FHWOR
- GOTO KIL
- NC ; Cancel NPO
- +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
- QUIT
- KIL GOTO KIL^FHORD3
- NPO ; Code NPO Order
- +1 KILL MSG
- SET FILL=$GET(FHNEW)
- if FILL=""
- QUIT
- +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 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 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
- CODE ; Code Cancel/Discontinue NPO Order Status Change
- +1 KILL MSG
- NEW ACT,FILL
- SET FILL=$GET(FHMSG1)
- if FILL=""
- QUIT
- 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,FHORR,FILL,SITE,WKDAYS
- QUIT
- NA ; OE/RR Number Assign
- +1 SET FHORD=+$PIECE(FILL,";",3)
- if 'FHORD
- QUIT
- if ADM'=$PIECE(FILL,";",2)
- SET ADM=$PIECE(FILL,";",2)
- +2 SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",14)=+FHORN
- QUIT
- DIS ; Process Cancel of Diet/NPO for Discharge
- +1 SET FHGET=$GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
- +2 IF $PIECE(FHGET,"^",14)>0
- IF $PIECE(FHGET,"^",15)>2
- SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",15)=1
- +3 DO NOW^%DTC
- SET NOW=%
- +4 FOR A1=NOW:0
- SET A1=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",A1))
- if A1=""
- QUIT
- KILL ^FHPT(FHDFN,"A",ADM,"AC",A1)
- +5 FOR FHDR=0:0
- SET FHDR=$ORDER(^FHPT(FHDFN,"A",ADM,"DI",FHDR))
- if FHDR<1
- QUIT
- DO D1
- +6 SET FHGET=$GET(^FHPT(FHDFN,"A",ADM,0))
- SET FHGET=$PIECE(FHGET,"^",2)
- if 'FHGET
- QUIT
- +7 SET FHX=$GET(^FHPT(FHDFN,"A",ADM,"DI",FHGET,0))
- +8 if $PIECE(FHX,"^",7)="X"
- QUIT
- +9 DO ORD^FHORD7
- SET ^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)=FHORD_"^^^^^^X^^"_NOW_"^^"_DUZ_"^"_NOW
- +10 SET ^FHPT(FHDFN,"A",ADM,"AC",NOW,0)=NOW_"^"_FHORD
- +11 SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",2,3)=FHORD_"^"
- KILL A1,FHDR,FHGET,FHX,FHOX1
- QUIT
- D1 ; Get all filler fields for Diet
- +1 SET FHOX1=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14,15)
- +2 IF +FHOX1>0
- IF $PIECE(FHOX1,"^",2)>2
- SET FHOX1=+FHOX1
- SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",15)=1
- +3 QUIT