78 lines
3.2 KiB
Mathematica
78 lines
3.2 KiB
Mathematica
|
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
|