GMRCIMSG ;SLC/JFR - IFC MESSAGE HANDLING ROUTINE; 09/26/02 00:23
;;3.0;CONSULT/REQUEST TRACKING;**22,28,51**;DEC 27, 1997
;
Q ;don't start at the top
IN ;process incoming message and save segments to ^TMP(
K ^TMP("GMRCIF",$J)
N HLNODE,SEG,I,GMRCIER ;production code
F I=1:1 X HLNEXT Q:HLQUIT'>0 D
. I $P(HLNODE,"|")="OBX" D ;multiple segs for OBX
.. S ^TMP("GMRCIF",$J,"OBX",$P(HLNODE,"|",2),$P(HLNODE,"|",5))=$E(HLNODE,5,999)
. I $P(HLNODE,"|")="NTE" D ; may be multiple NTE's
.. S ^TMP("GMRCIF",$J,"NTE",$P(HLNODE,"|",2))=$E(HLNODE,5,999)
. I "OBXNTE"'[$P(HLNODE,"|") D ;all other segs are single
.. S ^TMP("GMRCIF",$J,$P(HLNODE,"|"))=$E(HLNODE,5,999)
. Q
;
I '$$VALMSG(^TMP("GMRCIF",$J,"ORC")) D EX Q ;chk msg for valid cslt #'s
;
I $P(^TMP("GMRCIF",$J,"ORC"),"|")="NW" D D EX Q
. I $P(^TMP("GMRCIF",$J,"ORC"),"|",2)["TST1234" D D EX Q ;testing impl
.. D TST^GMRCIAC2($NA(^TMP("GMRCIF",$J)))
. D NW^GMRCIACT($NA(^TMP("GMRCIF",$J)))
I $P(^TMP("GMRCIF",$J,"ORC"),"|")="XO" D D EX Q
. D RESUB^GMRCIAC1($NA(^TMP("GMRCIF",$J)))
I $P(^TMP("GMRCIF",$J,"ORC"),"|")="XX" D D EX Q
. D FWD^GMRCIAC1($NA(^TMP("GMRCIF",$J)))
I $P(^TMP("GMRCIF",$J,"ORC"),"|")="RE" D D EX Q
. I $P($G(^TMP("GMRCIF",$J,"OBX",4,1)),"|",11)="D" D Q
.. D DIS^GMRCIACT($NA(^TMP("GMRCIF",$J))) ; dis-assoc. result
. I $P($P(^TMP("GMRCIF",$J,"ORC"),"|",16),U)="S" D Q
.. D SF^GMRCIAC1($NA(^TMP("GMRCIF",$J))) ; significant findings
. D COMP^GMRCIAC1($NA(^TMP("GMRCIF",$J)))
D OTHER^GMRCIACT($NA(^TMP("GMRCIF",$J)))
D EX
Q
;
EX ; clean up ^TMP(
K ^TMP("GMRCIF",$J)
Q
;
ORRIN ;process IFC responses
K ^TMP("GMRCIF",$J)
N HLNODE,SEG,I ;production code
F I=1:1 X HLNEXT Q:HLQUIT'>0 D
.S ^TMP("GMRCIF",$J,$P(HLNODE,"|"))=$E(HLNODE,5,999)
I $D(^TMP("GMRCIF",$J,"ORC")),$P(^("ORC"),"|")="OK" D
. N GMRCFNUM,GMRCROUT,GMRCDA,FDA
. S GMRCROUT=$$IEN^XUAF4($P($P(^TMP("GMRCIF",$J,"ORC"),"|",3),U,2))
. S GMRCDA=+$P(^TMP("GMRCIF",$J,"ORC"),"|",2)
. ;I GMRCROUT'=$P(^GMR(123,GMRCDA,0),U,23) Q
. S GMRCFNUM=+$P(^TMP("GMRCIF",$J,"ORC"),"|",3)
. S FDA(1,123,GMRCDA_",",.06)=GMRCFNUM
. D UPDATE^DIE("","FDA(1)",,"GMRCERR")
. Q
I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AA" D
. N MSGID,MSGLOG,FDA,GMRCDA,GMRCACT,GMRCLOG
. S MSGID=$P(^TMP("GMRCIF",$J,"MSA"),"|",2)
. S MSGLOG=$O(^GMR(123.6,"AM",MSGID,0)) Q:'MSGLOG
. S FDA(1,123.6,MSGLOG_",",.06)="@"
. S FDA(1,123.6,MSGLOG_",",.08)="@"
. D UPDATE^DIE("","FDA(1)",,"GMRCERR")
. S GMRCDA=$P(^GMR(123.6,MSGLOG,0),U,4) Q:'GMRCDA
. S GMRCACT=$P(^GMR(123.6,MSGLOG,0),U,5) Q:'GMRCACT
. S GMRCACT=$O(^GMR(123.6,"AC",GMRCDA,GMRCACT)) D
.. I 'GMRCACT Q
.. S GMRCLOG=$O(^GMR(123.6,"AC",GMRCDA,GMRCACT,1,0)) Q:'GMRCLOG
.. I $P(^GMR(123.6,GMRCLOG,0),U,8)<900 Q ;re-send 901 & 902 immed.
.. D TRIGR^GMRCIEVT(GMRCDA,GMRCACT)
. Q
I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AR" D
. N MSGID,MSGLOG,FDA,GMRCERR,GMRCE
. S MSGID=$P(^TMP("GMRCIF",$J,"MSA"),"|",2)
. S MSGLOG=$O(^GMR(123.6,"AM",MSGID,0)) Q:'MSGLOG
. S GMRCE=$P(^TMP("GMRCIF",$J,"MSA"),"|",3)
. S FDA(1,123.6,MSGLOG_",",.08)=GMRCE
. I GMRCE=802 S FDA(1,123.6,MSGLOG_",",.06)="@"
. D UPDATE^DIE("","FDA(1)",,"GMRCERR")
. I GMRCE=901!(GMRCE=902) Q ;no alerts on these probs (yet)
. I GMRCE=201 D Q
.. I '$$GET^XPAR("SYS","GMRC IFC ALERT IMMED ON PT ERR",1) Q
.. D SNDALRT^GMRCIERR(MSGLOG,"C","IFC patient error at remote facility")
. D SNDALRT^GMRCIERR(MSGLOG,"C")
K ^TMP("GMRCIF",$J)
I $T(ORRIN^MAGDTR01)'="" D ;invoke Imaging code if tag^routine exists
. D ORRIN^MAGDTR01
Q
;
VALMSG(GMRCORC) ;check to make sure placer and filler # match current entry
; Input:
; GMRCORC = ORC segment from incoming HL7 msg
;
I $P(GMRCORC,"|")="NW" Q 1 ; no #'s to match on new order
N GMRCPDA,GMRCFDA,GMRCPSIT,GMRCFSIT,GMRCROL,GMRCOK
S GMRCPDA=+$P(GMRCORC,"|",2)
S GMRCPSIT=$$IEN^XUAF4($P($P(GMRCORC,"|",2),U,2))
S GMRCFDA=+$P(GMRCORC,"|",3)
S GMRCFSIT=$$IEN^XUAF4($P($P(GMRCORC,"|",3),U,2))
I $$KSP^XUPARAM("INST")=GMRCPSIT S GMRCROL="P"
I $$KSP^XUPARAM("INST")=GMRCFSIT S GMRCROL="F"
S GMRCOK=1
I '$D(GMRCROL) S GMRCOK=0,GMRCROL="" ;bad institutions in msg
I GMRCROL="P" D
. I '$D(^GMR(123,GMRCPDA,0)) S GMRCOK=0 Q ;no such cslt #
. I $P(^GMR(123,GMRCPDA,0),U,22)'=GMRCFDA S GMRCOK=0 Q ;cslt # prob
. I $P(^GMR(123,GMRCPDA,0),U,23)'=GMRCFSIT S GMRCOK=0 Q ;routing facil.
I GMRCROL="F" D
. I '$D(^GMR(123,GMRCFDA,0)) S GMRCOK=0 Q ;no such cslt #
. I $P(^GMR(123,GMRCFDA,0),U,22)'=GMRCPDA S GMRCOK=0 Q ;cslt # prob
. I $P(^GMR(123,GMRCFDA,0),U,23)'=GMRCPSIT S GMRCOK=0 Q ;routing facil.
I 'GMRCOK D ;return a 101 error to sending site
. N GMRCRSLT
. D RESP^GMRCIUTL("AR",HL("MID"),,,101) ;build HLA(
. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT) ;-(
Q GMRCOK
;
GMRCIMSG ;SLC/JFR - IFC MESSAGE HANDLING ROUTINE; 09/26/02 00:23
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,51**;DEC 27, 1997
+2 ;
+3 ;don't start at the top
QUIT
IN ;process incoming message and save segments to ^TMP(
+1 KILL ^TMP("GMRCIF",$JOB)
+2 ;production code
NEW HLNODE,SEG,I,GMRCIER
+3 FOR I=1:1
XECUTE HLNEXT
IF HLQUIT'>0
QUIT
Begin DoDot:1
+4 ;multiple segs for OBX
IF $PIECE(HLNODE,"|")="OBX"
Begin DoDot:2
+5 SET ^TMP("GMRCIF",$JOB,"OBX",$PIECE(HLNODE,"|",2),$PIECE(HLNODE,"|",5))=$EXTRACT(HLNODE,5,999)
End DoDot:2
+6 ; may be multiple NTE's
IF $PIECE(HLNODE,"|")="NTE"
Begin DoDot:2
+7 SET ^TMP("GMRCIF",$JOB,"NTE",$PIECE(HLNODE,"|",2))=$EXTRACT(HLNODE,5,999)
End DoDot:2
+8 ;all other segs are single
IF "OBXNTE"'[$PIECE(HLNODE,"|")
Begin DoDot:2
+9 SET ^TMP("GMRCIF",$JOB,$PIECE(HLNODE,"|"))=$EXTRACT(HLNODE,5,999)
End DoDot:2
+10 QUIT
End DoDot:1
+11 ;
+12 ;chk msg for valid cslt #'s
IF '$$VALMSG(^TMP("GMRCIF",$JOB,"ORC"))
DO EX
QUIT
+13 ;
+14 IF $PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|")="NW"
Begin DoDot:1
+15 ;testing impl
IF $PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|",2)["TST1234"
Begin DoDot:2
+16 DO TST^GMRCIAC2($NAME(^TMP("GMRCIF",$JOB)))
End DoDot:2
DO EX
QUIT
+17 DO NW^GMRCIACT($NAME(^TMP("GMRCIF",$JOB)))
End DoDot:1
DO EX
QUIT
+18 IF $PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|")="XO"
Begin DoDot:1
+19 DO RESUB^GMRCIAC1($NAME(^TMP("GMRCIF",$JOB)))
End DoDot:1
DO EX
QUIT
+20 IF $PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|")="XX"
Begin DoDot:1
+21 DO FWD^GMRCIAC1($NAME(^TMP("GMRCIF",$JOB)))
End DoDot:1
DO EX
QUIT
+22 IF $PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|")="RE"
Begin DoDot:1
+23 IF $PIECE($GET(^TMP("GMRCIF",$JOB,"OBX",4,1)),"|",11)="D"
Begin DoDot:2
+24 ; dis-assoc. result
DO DIS^GMRCIACT($NAME(^TMP("GMRCIF",$JOB)))
End DoDot:2
QUIT
+25 IF $PIECE($PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|",16),U)="S"
Begin DoDot:2
+26 ; significant findings
DO SF^GMRCIAC1($NAME(^TMP("GMRCIF",$JOB)))
End DoDot:2
QUIT
+27 DO COMP^GMRCIAC1($NAME(^TMP("GMRCIF",$JOB)))
End DoDot:1
DO EX
QUIT
+28 DO OTHER^GMRCIACT($NAME(^TMP("GMRCIF",$JOB)))
+29 DO EX
+30 QUIT
+31 ;
EX ; clean up ^TMP(
+1 KILL ^TMP("GMRCIF",$JOB)
+2 QUIT
+3 ;
ORRIN ;process IFC responses
+1 KILL ^TMP("GMRCIF",$JOB)
+2 ;production code
NEW HLNODE,SEG,I
+3 FOR I=1:1
XECUTE HLNEXT
IF HLQUIT'>0
QUIT
Begin DoDot:1
+4 SET ^TMP("GMRCIF",$JOB,$PIECE(HLNODE,"|"))=$EXTRACT(HLNODE,5,999)
End DoDot:1
+5 IF $DATA(^TMP("GMRCIF",$JOB,"ORC"))
IF $PIECE(^("ORC"),"|")="OK"
Begin DoDot:1
+6 NEW GMRCFNUM,GMRCROUT,GMRCDA,FDA
+7 SET GMRCROUT=$$IEN^XUAF4($PIECE($PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|",3),U,2))
+8 SET GMRCDA=+$PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|",2)
+9 ;I GMRCROUT'=$P(^GMR(123,GMRCDA,0),U,23) Q
+10 SET GMRCFNUM=+$PIECE(^TMP("GMRCIF",$JOB,"ORC"),"|",3)
+11 SET FDA(1,123,GMRCDA_",",.06)=GMRCFNUM
+12 DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+13 QUIT
End DoDot:1
+14 IF $PIECE(^TMP("GMRCIF",$JOB,"MSA"),"|")="AA"
Begin DoDot:1
+15 NEW MSGID,MSGLOG,FDA,GMRCDA,GMRCACT,GMRCLOG
+16 SET MSGID=$PIECE(^TMP("GMRCIF",$JOB,"MSA"),"|",2)
+17 SET MSGLOG=$ORDER(^GMR(123.6,"AM",MSGID,0))
IF 'MSGLOG
QUIT
+18 SET FDA(1,123.6,MSGLOG_",",.06)="@"
+19 SET FDA(1,123.6,MSGLOG_",",.08)="@"
+20 DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+21 SET GMRCDA=$PIECE(^GMR(123.6,MSGLOG,0),U,4)
IF 'GMRCDA
QUIT
+22 SET GMRCACT=$PIECE(^GMR(123.6,MSGLOG,0),U,5)
IF 'GMRCACT
QUIT
+23 SET GMRCACT=$ORDER(^GMR(123.6,"AC",GMRCDA,GMRCACT))
Begin DoDot:2
+24 IF 'GMRCACT
QUIT
+25 SET GMRCLOG=$ORDER(^GMR(123.6,"AC",GMRCDA,GMRCACT,1,0))
IF 'GMRCLOG
QUIT
+26 ;re-send 901 & 902 immed.
IF $PIECE(^GMR(123.6,GMRCLOG,0),U,8)<900
QUIT
+27 DO TRIGR^GMRCIEVT(GMRCDA,GMRCACT)
End DoDot:2
+28 QUIT
End DoDot:1
+29 IF $PIECE(^TMP("GMRCIF",$JOB,"MSA"),"|")="AR"
Begin DoDot:1
+30 NEW MSGID,MSGLOG,FDA,GMRCERR,GMRCE
+31 SET MSGID=$PIECE(^TMP("GMRCIF",$JOB,"MSA"),"|",2)
+32 SET MSGLOG=$ORDER(^GMR(123.6,"AM",MSGID,0))
IF 'MSGLOG
QUIT
+33 SET GMRCE=$PIECE(^TMP("GMRCIF",$JOB,"MSA"),"|",3)
+34 SET FDA(1,123.6,MSGLOG_",",.08)=GMRCE
+35 IF GMRCE=802
SET FDA(1,123.6,MSGLOG_",",.06)="@"
+36 DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+37 ;no alerts on these probs (yet)
IF GMRCE=901!(GMRCE=902)
QUIT
+38 IF GMRCE=201
Begin DoDot:2
+39 IF '$$GET^XPAR("SYS","GMRC IFC ALERT IMMED ON PT ERR",1)
QUIT
+40 DO SNDALRT^GMRCIERR(MSGLOG,"C","IFC patient error at remote facility")
End DoDot:2
QUIT
+41 DO SNDALRT^GMRCIERR(MSGLOG,"C")
End DoDot:1
+42 KILL ^TMP("GMRCIF",$JOB)
+43 ;invoke Imaging code if tag^routine exists
IF $TEXT(ORRIN^MAGDTR01)'=""
Begin DoDot:1
+44 DO ORRIN^MAGDTR01
End DoDot:1
+45 QUIT
+46 ;
VALMSG(GMRCORC) ;check to make sure placer and filler # match current entry
+1 ; Input:
+2 ; GMRCORC = ORC segment from incoming HL7 msg
+3 ;
+4 ; no #'s to match on new order
IF $PIECE(GMRCORC,"|")="NW"
QUIT 1
+5 NEW GMRCPDA,GMRCFDA,GMRCPSIT,GMRCFSIT,GMRCROL,GMRCOK
+6 SET GMRCPDA=+$PIECE(GMRCORC,"|",2)
+7 SET GMRCPSIT=$$IEN^XUAF4($PIECE($PIECE(GMRCORC,"|",2),U,2))
+8 SET GMRCFDA=+$PIECE(GMRCORC,"|",3)
+9 SET GMRCFSIT=$$IEN^XUAF4($PIECE($PIECE(GMRCORC,"|",3),U,2))
+10 IF $$KSP^XUPARAM("INST")=GMRCPSIT
SET GMRCROL="P"
+11 IF $$KSP^XUPARAM("INST")=GMRCFSIT
SET GMRCROL="F"
+12 SET GMRCOK=1
+13 ;bad institutions in msg
IF '$DATA(GMRCROL)
SET GMRCOK=0
SET GMRCROL=""
+14 IF GMRCROL="P"
Begin DoDot:1
+15 ;no such cslt #
IF '$DATA(^GMR(123,GMRCPDA,0))
SET GMRCOK=0
QUIT
+16 ;cslt # prob
IF $PIECE(^GMR(123,GMRCPDA,0),U,22)'=GMRCFDA
SET GMRCOK=0
QUIT
+17 ;routing facil.
IF $PIECE(^GMR(123,GMRCPDA,0),U,23)'=GMRCFSIT
SET GMRCOK=0
QUIT
End DoDot:1
+18 IF GMRCROL="F"
Begin DoDot:1
+19 ;no such cslt #
IF '$DATA(^GMR(123,GMRCFDA,0))
SET GMRCOK=0
QUIT
+20 ;cslt # prob
IF $PIECE(^GMR(123,GMRCFDA,0),U,22)'=GMRCPDA
SET GMRCOK=0
QUIT
+21 ;routing facil.
IF $PIECE(^GMR(123,GMRCFDA,0),U,23)'=GMRCPSIT
SET GMRCOK=0
QUIT
End DoDot:1
+22 ;return a 101 error to sending site
IF 'GMRCOK
Begin DoDot:1
+23 NEW GMRCRSLT
+24 ;build HLA(
DO RESP^GMRCIUTL("AR",HL("MID"),,,101)
+25 ;-(
DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
End DoDot:1
+26 QUIT GMRCOK
+27 ;
