- 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 ;
