FHWOR ; HISC/NCA - Main Routine to Decode HL7 ;10/10/00 14:55
;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
EN(MSG) ; Entry Point for OE/RR 3 and pass MSG in FHMSG
N ACT,ADM,BID,COM,FHDFN,DFN,EDT,FHPV,FHMSG,FHWF,NOW,SDT,CHK,DA,DATA,DATE,DIET,DUR,FHC,FHD,FHD1,FHD2,FOR,FTYP,IEN,ITVL,LP,MEAL,NAM,PER,PID,SERV,TIM,TIME,TM,TXT,TYPC,WARD,X,XX,YR
S TXT="",FHWF=2 ; FHWF=2 - Orders from OE/RR
F L=0:0 S L=$O(MSG(L)) Q:L<1 S FHMSG(L)=$G(MSG(L))
Q:'$D(FHMSG)
; Decode MSH
S X=$G(FHMSG(1)) I $E(X,1,3)'="MSH" S TXT="MSH not first record" D GETOR G ERR
; Check PID
S X=$G(FHMSG(2)) I $E(X,1,3)'="PID" S TXT="PID not second record" D GETOR G ERR
S NAM=$P(X,"|",6),DFN=$P(X,"|",4)
I '$D(^DPT("B",$E(NAM,1,30),DFN)) S TXT="Name/DFN not found" D GETOR G ERR
S FHZ115="P"_DFN D ADD^FHOMDPA I FHDFN="" S TXT="Patient not found in File #115" D GETOR G ERR
D PID^VADPT6 S PID=$G(VA("PID")),BID=$G(VA("BID")) K VA
S X=$G(FHMSG(3)) I $E(X,1,5)="ORC|Z" G PURGE
I $E(X,1,6)="ORC|DE" Q ;6/2005 quit processing if "DE" returned
;Check for outpatient orders
I $P(X,"|",3)="O" D ^FHOMWOR Q
S WARD=$G(^DPT(DFN,.1)) I WARD="" D CHK^FHWORR G:CHK CANCEL S:'CHK TXT="Not an inpatient" D GETOR G ERR
S ADM=$G(^DPT("CN",WARD,DFN)) I ADM<1 S TXT="Admission not found" D GETOR G ERR
I '$D(^FHPT(FHDFN,"A",ADM,0)) I '$D(^DGPM(ADM,0)) S TXT="Admission not found" D GETOR G ERR
I '$D(^FHPT(FHDFN,"A",ADM,0)) S DA=DFN D ^FHWADM
; Check PV1
S X=$G(FHMSG(3)) G:$E(X,1,3)="ORC" CANCEL I $E(X,1,3)'="PV1" S TXT="Third message not ORC or PV1" D GETOR G ERR
; Decode ORC
S X=$G(FHMSG(4)) I $E(X,1,3)'="ORC" S TXT="Message 4 not ORC as expected" D GETOR G ERR
S ACT=$P(X,"|",2) I ACT'="NW" S TXT="Action not NW as expected" D GETOR G ERR
S FHORN=$P(X,"|",3),DUR=$P(X,"|",8)
S ITVL=$P(DUR,"^",2),SDT=$P(DUR,"^",4),EDT=$P(DUR,"^",5)
S FHPV=$P(X,"|",13),NOW=$P(X,"|",16) I NOW="" S TXT="No Effective Date" G ERR
S X=$G(FHMSG(5)) I $E(X,1,3)="ODT" D ^FHWOR3 G KIL
I $E(X,1,3)="OBR" D ^FHWOR61 G KIL
I $E(X,1,3)'="ODS" S TXT="Message 5 not ODT or ODS as expected" G ERR
S TYPC=$P(X,"|",2) I TYPC="ZE" D ^FHWOR5 G KIL
S DIET=$P(X,"|",4),DIET=$E(DIET,4,$L(DIET)),COM=$P(X,"|",5)
I $E(DIET,1,4)="FH-5" D ^FHWOR4 G KIL
I $E(DIET,1,4)="FH-6" D ^FHWOR1 G KIL
D ^FHWOR2 G KIL
CANCEL ; Cancel/Discontinue
S DATA=X,FOR=0
S ACT=$P(DATA,"|",2)
S FHORN=$P(DATA,"|",3),FILL=$P(DATA,"|",4),FTYP=$P(FILL,";",1)
I ACT'="CA",ACT'="DC",ACT'="NA",ACT'="DE",ACT'="SS" S TXT="Action not CA, DC, NA, or DE as expected" G CERR
I FTYP="R"!(FTYP="S") D OMSTAT^FHWORR Q ;Status update for outpt meals
I "ADEINT"'[FTYP G CSEND:ACT="CA"!(ACT="DC"),KIL
S FOR=$S(FTYP="A":1,FTYP="D":2,FTYP="E":3,FTYP="N":4,FTYP="T":5,FTYP="I":6,1:0)
I 'FOR G CSEND:ACT="CA"!(ACT="DC"),KIL
I ACT="SS" G STATUS^FHWORR
I ACT="NA" D NA K ACT,TXT K MSG Q
I ACT="DE" K MSG G KIL
CAN ; Cancel Order From OE
I FOR=1 D CAN^FHWOR1 G KIL
I FOR=2 D CAN^FHWOR2 G KIL
I FOR=3 D CAN^FHWOR3 G KIL
I FOR=4 D CAN^FHWOR4 G KIL
I FOR=5 D CAN^FHWOR5 G KIL
I FOR=6 D CAN^FHWOR61 G KIL
G KIL
PURGE ; Purge OE/RR Orders
I $E(X,5,6)'="Z@" G KIL
S FHORN=+$P(X,"|",3),FILL=$P(X,"|",4),FTYP=$P(FILL,";",1)
S FHDR=+$P(FILL,";",3),ADM=+$P(FILL,";",2)
I FTYP="A" S:$P($G(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)),"^",8)=FHORN $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=""
I FTYP="D" S:$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14)=FHORN $P(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",14)=""
I FTYP="E" S SDT=$P(FILL,";",4),EDT=$P(FILL,";",5) S:EDT<SDT EDT=SDT D
.F EL=SDT\1:0 S EL=$O(^FHPT(FHDFN,"A",ADM,"EL",EL)) Q:EL<1!(EL>EDT) D
..S:$P($G(^FHPT(FHDFN,"A",ADM,"EL",EL,0)),"^",7)=FHORN $P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)=""
..Q
.Q
I FTYP="N" S:$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14)=FHORN $P(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",14)=""
I FTYP="T" S:$P($G(^FHPT(FHDFN,"A",ADM,"TF",FHDR,0)),"^",14)=FHORN $P(^FHPT(FHDFN,"A",ADM,"TF",FHDR,0),"^",14)=""
I FTYP="I" S:$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",13)=FHORN $P(^FHPT(FHDFN,"A",ADM,0),"^",13)=""
K EL,FHDR
S $P(MSG(1),"|",9)="ORR",$P(MSG(3),"|",2)="ZR",$P(MSG(1),"|",3)="DIETETICS" G EVSEND
NA ; Number Assign
I FOR=1 D NA^FHWOR1 G KIL
I FOR=2 D NA^FHWOR2 G KIL
I FOR=3 D NA^FHWOR3 G KIL
I FOR=4 D NA^FHWOR4 G KIL
I FOR=5 D NA^FHWOR5 G KIL
I FOR=6 D NA^FHWOR61 G KIL
Q
CVT ; Convert HL7 date to FM date
Q:DATE="" S DATE=$$HL7TFM^XLFDT(DATE)
I $P(DATE,".",2)=24 S DATE=$$FMADD^XLFDT(DATE,0,0,1)
Q
ERR ; Send error MSG
K MSG D RMSH
S $P(MSG(3),"|",1,2)="ORC"_"|"_$S($P($G(MSG(3)),"|",1)="ORC":"U"_$E($P($G(MSG(3)),"|",2),1),1:"OC"),$P(MSG(3),"|",3)=FHORN
S $P(MSG(3),"|",4)=$S($P(FHMSG(3),"|",1)="ORC":$P(FHMSG(3),"|",4),1:"")
S $P(MSG(3),"|",13)=$S($P(FHMSG(3),"|",1)="ORC":$P(FHMSG(3),"|",13),1:$P(FHMSG(4),"|",13))
S $P(MSG(3),"|",16)=$S($P(FHMSG(3),"|",1)="ORC":$P(FHMSG(3),"|",16),1:$P(FHMSG(4),"|",16))
S $P(MSG(3),"|",17)=TXT G EVSEND
SEND ; Send OK MSG to OERR
K MSG D RMSH
S MSG(3)="ORC|OK|"_FHORN_"|"_FILL_"^"_"FH" G EVSEND
CERR ; Send unable MSG
K MSG D RMSH
S MSG(3)="ORC|U"_$E(ACT,1)_"|"_FHORN_"|"_FILL_"|||||||||||||"_TXT G EVSEND
CSEND ; Send Canceled/Discontinued MSG to OERR
K MSG D RMSH
S MSG(3)="ORC|"_$E(ACT,1)_"R"_"|"_FHORN_"|"_FILL
EVSEND ; Send Message to OE/RR
K ACT,FILL,FHORN,SITE,TXT D MSG^XQOR("FH EVSEND OR",.MSG) K MSG Q
MSH ; Code MSH message
D MSH^FHWORR
Q
RMSH ; Code MSH Return Message
D SITE^FH
S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORR"
; code PID
S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
Q
GETOR ; Call to Get FHORN
D GETOR^FHWORR Q
KIL ; Kill Variables
K ACT,ADM,BID,COM,FHDFN,DFN,EDT,FHPV,FHMSG,FHWF,NOW,SDT,CHK,DA,DATA,DATE,DIET,DUR,FHC,FHD,FHD1,FHD2,FOR,FTYP,IEN,ITVL,LP,MEAL,NAM,PER,PID,SERV,TIM,TIME,TM,TXT,TYPC,WARD,X,XX,YR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR 5836 printed Nov 22, 2024@17:05:30 Page 2
FHWOR ; HISC/NCA - Main Routine to Decode HL7 ;10/10/00 14:55
+1 ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
EN(MSG) ; Entry Point for OE/RR 3 and pass MSG in FHMSG
+1 NEW ACT,ADM,BID,COM,FHDFN,DFN,EDT,FHPV,FHMSG,FHWF,NOW,SDT,CHK,DA,DATA,DATE,DIET,DUR,FHC,FHD,FHD1,FHD2,FOR,FTYP,IEN,ITVL,LP,MEAL,NAM,PER,PID,SERV,TIM,TIME,TM,TXT,TYPC,WARD,X,XX,YR
+2 ; FHWF=2 - Orders from OE/RR
SET TXT=""
SET FHWF=2
+3 FOR L=0:0
SET L=$ORDER(MSG(L))
if L<1
QUIT
SET FHMSG(L)=$GET(MSG(L))
+4 if '$DATA(FHMSG)
QUIT
+5 ; Decode MSH
+6 SET X=$GET(FHMSG(1))
IF $EXTRACT(X,1,3)'="MSH"
SET TXT="MSH not first record"
DO GETOR
GOTO ERR
+7 ; Check PID
+8 SET X=$GET(FHMSG(2))
IF $EXTRACT(X,1,3)'="PID"
SET TXT="PID not second record"
DO GETOR
GOTO ERR
+9 SET NAM=$PIECE(X,"|",6)
SET DFN=$PIECE(X,"|",4)
+10 IF '$DATA(^DPT("B",$EXTRACT(NAM,1,30),DFN))
SET TXT="Name/DFN not found"
DO GETOR
GOTO ERR
+11 SET FHZ115="P"_DFN
DO ADD^FHOMDPA
IF FHDFN=""
SET TXT="Patient not found in File #115"
DO GETOR
GOTO ERR
+12 DO PID^VADPT6
SET PID=$GET(VA("PID"))
SET BID=$GET(VA("BID"))
KILL VA
+13 SET X=$GET(FHMSG(3))
IF $EXTRACT(X,1,5)="ORC|Z"
GOTO PURGE
+14 ;6/2005 quit processing if "DE" returned
IF $EXTRACT(X,1,6)="ORC|DE"
QUIT
+15 ;Check for outpatient orders
+16 IF $PIECE(X,"|",3)="O"
DO ^FHOMWOR
QUIT
+17 SET WARD=$GET(^DPT(DFN,.1))
IF WARD=""
DO CHK^FHWORR
if CHK
GOTO CANCEL
if 'CHK
SET TXT="Not an inpatient"
DO GETOR
GOTO ERR
+18 SET ADM=$GET(^DPT("CN",WARD,DFN))
IF ADM<1
SET TXT="Admission not found"
DO GETOR
GOTO ERR
+19 IF '$DATA(^FHPT(FHDFN,"A",ADM,0))
IF '$DATA(^DGPM(ADM,0))
SET TXT="Admission not found"
DO GETOR
GOTO ERR
+20 IF '$DATA(^FHPT(FHDFN,"A",ADM,0))
SET DA=DFN
DO ^FHWADM
+21 ; Check PV1
+22 SET X=$GET(FHMSG(3))
if $EXTRACT(X,1,3)="ORC"
GOTO CANCEL
IF $EXTRACT(X,1,3)'="PV1"
SET TXT="Third message not ORC or PV1"
DO GETOR
GOTO ERR
+23 ; Decode ORC
+24 SET X=$GET(FHMSG(4))
IF $EXTRACT(X,1,3)'="ORC"
SET TXT="Message 4 not ORC as expected"
DO GETOR
GOTO ERR
+25 SET ACT=$PIECE(X,"|",2)
IF ACT'="NW"
SET TXT="Action not NW as expected"
DO GETOR
GOTO ERR
+26 SET FHORN=$PIECE(X,"|",3)
SET DUR=$PIECE(X,"|",8)
+27 SET ITVL=$PIECE(DUR,"^",2)
SET SDT=$PIECE(DUR,"^",4)
SET EDT=$PIECE(DUR,"^",5)
+28 SET FHPV=$PIECE(X,"|",13)
SET NOW=$PIECE(X,"|",16)
IF NOW=""
SET TXT="No Effective Date"
GOTO ERR
+29 SET X=$GET(FHMSG(5))
IF $EXTRACT(X,1,3)="ODT"
DO ^FHWOR3
GOTO KIL
+30 IF $EXTRACT(X,1,3)="OBR"
DO ^FHWOR61
GOTO KIL
+31 IF $EXTRACT(X,1,3)'="ODS"
SET TXT="Message 5 not ODT or ODS as expected"
GOTO ERR
+32 SET TYPC=$PIECE(X,"|",2)
IF TYPC="ZE"
DO ^FHWOR5
GOTO KIL
+33 SET DIET=$PIECE(X,"|",4)
SET DIET=$EXTRACT(DIET,4,$LENGTH(DIET))
SET COM=$PIECE(X,"|",5)
+34 IF $EXTRACT(DIET,1,4)="FH-5"
DO ^FHWOR4
GOTO KIL
+35 IF $EXTRACT(DIET,1,4)="FH-6"
DO ^FHWOR1
GOTO KIL
+36 DO ^FHWOR2
GOTO KIL
CANCEL ; Cancel/Discontinue
+1 SET DATA=X
SET FOR=0
+2 SET ACT=$PIECE(DATA,"|",2)
+3 SET FHORN=$PIECE(DATA,"|",3)
SET FILL=$PIECE(DATA,"|",4)
SET FTYP=$PIECE(FILL,";",1)
+4 IF ACT'="CA"
IF ACT'="DC"
IF ACT'="NA"
IF ACT'="DE"
IF ACT'="SS"
SET TXT="Action not CA, DC, NA, or DE as expected"
GOTO CERR
+5 ;Status update for outpt meals
IF FTYP="R"!(FTYP="S")
DO OMSTAT^FHWORR
QUIT
+6 IF "ADEINT"'[FTYP
if ACT="CA"!(ACT="DC")
GOTO CSEND
GOTO KIL
+7 SET FOR=$SELECT(FTYP="A":1,FTYP="D":2,FTYP="E":3,FTYP="N":4,FTYP="T":5,FTYP="I":6,1:0)
+8 IF 'FOR
if ACT="CA"!(ACT="DC")
GOTO CSEND
GOTO KIL
+9 IF ACT="SS"
GOTO STATUS^FHWORR
+10 IF ACT="NA"
DO NA
KILL ACT,TXT
KILL MSG
QUIT
+11 IF ACT="DE"
KILL MSG
GOTO KIL
CAN ; Cancel Order From OE
+1 IF FOR=1
DO CAN^FHWOR1
GOTO KIL
+2 IF FOR=2
DO CAN^FHWOR2
GOTO KIL
+3 IF FOR=3
DO CAN^FHWOR3
GOTO KIL
+4 IF FOR=4
DO CAN^FHWOR4
GOTO KIL
+5 IF FOR=5
DO CAN^FHWOR5
GOTO KIL
+6 IF FOR=6
DO CAN^FHWOR61
GOTO KIL
+7 GOTO KIL
PURGE ; Purge OE/RR Orders
+1 IF $EXTRACT(X,5,6)'="Z@"
GOTO KIL
+2 SET FHORN=+$PIECE(X,"|",3)
SET FILL=$PIECE(X,"|",4)
SET FTYP=$PIECE(FILL,";",1)
+3 SET FHDR=+$PIECE(FILL,";",3)
SET ADM=+$PIECE(FILL,";",2)
+4 IF FTYP="A"
if $PIECE($GET(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)),"^",8)=FHORN
SET $PIECE(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=""
+5 IF FTYP="D"
if $PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14)=FHORN
SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",14)=""
+6 IF FTYP="E"
SET SDT=$PIECE(FILL,";",4)
SET EDT=$PIECE(FILL,";",5)
if EDT<SDT
SET EDT=SDT
Begin DoDot:1
+7 FOR EL=SDT\1:0
SET EL=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",EL))
if EL<1!(EL>EDT)
QUIT
Begin DoDot:2
+8 if $PIECE($GET(^FHPT(FHDFN,"A",ADM,"EL",EL,0)),"^",7)=FHORN
SET $PIECE(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)=""
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 IF FTYP="N"
if $PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14)=FHORN
SET $PIECE(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",14)=""
+12 IF FTYP="T"
if $PIECE($GET(^FHPT(FHDFN,"A",ADM,"TF",FHDR,0)),"^",14)=FHORN
SET $PIECE(^FHPT(FHDFN,"A",ADM,"TF",FHDR,0),"^",14)=""
+13 IF FTYP="I"
if $PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",13)=FHORN
SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",13)=""
+14 KILL EL,FHDR
+15 SET $PIECE(MSG(1),"|",9)="ORR"
SET $PIECE(MSG(3),"|",2)="ZR"
SET $PIECE(MSG(1),"|",3)="DIETETICS"
GOTO EVSEND
NA ; Number Assign
+1 IF FOR=1
DO NA^FHWOR1
GOTO KIL
+2 IF FOR=2
DO NA^FHWOR2
GOTO KIL
+3 IF FOR=3
DO NA^FHWOR3
GOTO KIL
+4 IF FOR=4
DO NA^FHWOR4
GOTO KIL
+5 IF FOR=5
DO NA^FHWOR5
GOTO KIL
+6 IF FOR=6
DO NA^FHWOR61
GOTO KIL
+7 QUIT
CVT ; Convert HL7 date to FM date
+1 if DATE=""
QUIT
SET DATE=$$HL7TFM^XLFDT(DATE)
+2 IF $PIECE(DATE,".",2)=24
SET DATE=$$FMADD^XLFDT(DATE,0,0,1)
+3 QUIT
ERR ; Send error MSG
+1 KILL MSG
DO RMSH
+2 SET $PIECE(MSG(3),"|",1,2)="ORC"_"|"_$SELECT($PIECE($GET(MSG(3)),"|",1)="ORC":"U"_$EXTRACT($PIECE($GET(MSG(3)),"|",2),1),1:"OC")
SET $PIECE(MSG(3),"|",3)=FHORN
+3 SET $PIECE(MSG(3),"|",4)=$SELECT($PIECE(FHMSG(3),"|",1)="ORC":$PIECE(FHMSG(3),"|",4),1:"")
+4 SET $PIECE(MSG(3),"|",13)=$SELECT($PIECE(FHMSG(3),"|",1)="ORC":$PIECE(FHMSG(3),"|",13),1:$PIECE(FHMSG(4),"|",13))
+5 SET $PIECE(MSG(3),"|",16)=$SELECT($PIECE(FHMSG(3),"|",1)="ORC":$PIECE(FHMSG(3),"|",16),1:$PIECE(FHMSG(4),"|",16))
+6 SET $PIECE(MSG(3),"|",17)=TXT
GOTO EVSEND
SEND ; Send OK MSG to OERR
+1 KILL MSG
DO RMSH
+2 SET MSG(3)="ORC|OK|"_FHORN_"|"_FILL_"^"_"FH"
GOTO EVSEND
CERR ; Send unable MSG
+1 KILL MSG
DO RMSH
+2 SET MSG(3)="ORC|U"_$EXTRACT(ACT,1)_"|"_FHORN_"|"_FILL_"|||||||||||||"_TXT
GOTO EVSEND
CSEND ; Send Canceled/Discontinued MSG to OERR
+1 KILL MSG
DO RMSH
+2 SET MSG(3)="ORC|"_$EXTRACT(ACT,1)_"R"_"|"_FHORN_"|"_FILL
EVSEND ; Send Message to OE/RR
+1 KILL ACT,FILL,FHORN,SITE,TXT
DO MSG^XQOR("FH EVSEND OR",.MSG)
KILL MSG
QUIT
MSH ; Code MSH message
+1 DO MSH^FHWORR
+2 QUIT
RMSH ; Code MSH Return Message
+1 DO SITE^FH
+2 SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORR"
+3 ; code PID
+4 SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)
+5 QUIT
GETOR ; Call to Get FHORN
+1 DO GETOR^FHWORR
QUIT
KIL ; Kill Variables
+1 KILL ACT,ADM,BID,COM,FHDFN,DFN,EDT,FHPV,FHMSG,FHWF,NOW,SDT,CHK,DA,DATA,DATE,DIET,DUR,FHC,FHD,FHD1,FHD2,FOR,FTYP,IEN,ITVL,LP,MEAL,NAM,PER,PID,SERV,TIM,TIME,TM,TXT,TYPC,WARD,X,XX,YR
QUIT
