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 Apr 09, 2024@20:53:54 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
