GMRCIEVT ;SLC/JFR - process events and build HL7 message; 1/27/03 09:23
;;3.0;CONSULT/REQUEST TRACKING;**22,28,31**;DEC 27, 1997
;
Q ;don't start at the top
TRIGR(IEN,ACTN) ;determine what action was taken on IFC and call event point
;Input:
; IEN = consult number from file 123
; ACT = ien in 40 multiple corresponding to activity
;
N ACTYPE
S ACTYPE=$P(^GMR(123,IEN,40,ACTN,0),U,2)
I 'ACTYPE Q
I ACTYPE=26 Q ;don't send admin corrections yet...
;
; check bkgrd job and run if overdue
I '$D(ZTQUEUED),$$GONOGO^GMRCIBKG D
. N ZTQUEUED S ZTQUEUED=1 D EN^GMRCIBKG ;remove ZTQUEUED?
;
I $O(^GMR(123.6,"AC",IEN,ACTN),-1) D Q ;earlier pending activities
. I ACTYPE=22 Q ; not a trigger or not done here
. I ACTYPE=6 N GMRCQT D I $D(GMRCQT) Q
.. ;complete all transactions if IFC DC'd before request ever sent
.. I $O(^GMR(123.6,"AC",IEN,ACTN),-1)'=1 Q ;new request already sent
.. S GMRCQT=1
.. N DA,DIE,DR,GMRCACTS
.. S GMRCACTS=0
.. F S GMRCACTS=$O(^GMR(123.6,"AC",IEN,GMRCACTS)) Q:'GMRCACTS D
... S DIE="^GMR(123.6,",DA=$O(^GMR(123.6,"AC",IEN,GMRCACTS,1,0))
... S DR=".06///@" D ^DIE
. D LOGMSG^GMRCIUTL(IEN,ACTN,"",902) ;msg log entry but no msg sent
I ACTYPE=2!(ACTYPE=1) D NW(IEN) Q ;send new order
I ACTYPE=9!(ACTYPE=14) D RSLT(IEN,ACTN) Q ;inc report or add'l notes
I ACTYPE=10,$P(^GMR(123,IEN,40,ACTN,0),U,9) D RSLT(IEN,ACTN) Q ;comp
I ACTYPE=12 D RSLT(IEN,ACTN) Q ;dis-associate result
I ACTYPE=11 D RESUB^GMRCIEV1(IEN,ACTN) Q ;ed/resubmit
I ACTYPE=13 D RSLT(IEN,ACTN) Q ; addendum added
I ACTYPE=4 D SF^GMRCIEV1(IEN,ACTN) Q ; sig finding update
I ACTYPE=22 Q ;printed to is not a trigger
I ACTYPE=17 D FWD^GMRCIEV1(IEN,ACTN) Q ; forward
I ACTYPE=25 D FWD2IFC^GMRCIEV1(IEN,ACTN) Q ; FWD into an IFC service
D GENUPD(IEN,ACTN) ;all other updates
Q
NW(GMRCDA) ;build new order message for IFC
; Input:
; GMRCDA = ien from file 123
;
N HL,HLL,SEG,GMRC773,GMRCIQT
S SEG=1
K ^TMP("HLS",$J)
D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
I $G(HL) D Q ; if HL array can't be built, log it with an error
. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
D I $D(GMRCIQT) D NOMPI(GMRCDA,1) Q ;build PID seg if not a local ICN
. N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
. I '$G(GMRCDFN) S GMRCIQT=1 Q
. I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
. I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
. S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
. S SEG=SEG+1
. Q
S ^TMP("HLS",$J,SEG)=$$NWORC^GMRCISG1(GMRCDA) ; get ORC for new ord
S SEG=SEG+1
S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA) ;get OBR segment
S SEG=SEG+1
D ;build reason for request into OBX segment(s)
. K ^TMP("GMRCRFR",$J)
. D OBXWP^GMRCISEG(GMRCDA,"NW",1,$NA(^TMP("GMRCRFR",$J)))
. I '$D(^TMP("GMRCRFR",$J)) Q
. N I S I=0
. F S I=$O(^TMP("GMRCRFR",$J,I)) Q:'I D
.. S ^TMP("HLS",$J,SEG)=^TMP("GMRCRFR",$J,I)
.. S SEG=SEG+1
. K ^TMP("GMRCRFR",$J)
. Q
S ^TMP("HLS",$J,SEG)=$$OBXPD^GMRCISG1(GMRCDA) ; build prov DX in OBX
S SEG=SEG+1
S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always send local time zone
S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
. D LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
N ERR S ERR=$S($P(GMRC773,U,2):904,1:"")
D LOGMSG^GMRCIUTL(GMRCDA,1,+GMRC773,ERR)
Q
;
GENUPD(GMRCDA,GMRCACT) ;build msg and send upon REC, SC or ADD CMT event
N HL,HLL,SEG,GMRC773,GMRCIQT
S SEG=1
K ^TMP("HLS",$J)
D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
I $G(HL) D Q ; if HL array can't be built, log it with an error
. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
D I $D(GMRCIQT) D NOMPI(GMRCDA,GMRCACT) Q ;build PID seg if nat'l ICN
. N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
. I '$G(GMRCDFN) S GMRCIQT=1 Q
. I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
. I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
. S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
. S SEG=SEG+1
. Q
D ;build ORC seg based on GMRCACT
. N ACTVT,OC,OS
. S ACTVT=$P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2) ; get activity
. ;set order control for ORC seg:
. ; v-- IP=cmt RE=adm comp OD=DC OC=cancel SC=sch or receive
. S OC=$S(ACTVT=20:"IP",ACTVT=10:"RE",ACTVT=6:"OD",ACTVT=19:"OC",1:"SC")
. ;set order status for ORC seg:
. ; v-- SC=sch RE=adm comp DC=DC CA=cancel IP=cmt or receive
. S OS=$S(ACTVT=8:"SC",ACTVT=10:"CM",ACTVT=6:"DC",ACTVT=19:"CA",1:"IP")
. S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
. S SEG=SEG+1
. Q
I $L($P(^GMR(123,GMRCDA,0),U,19)) D ;send sig findings
. S ^TMP("HLS",$J,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
. S SEG=SEG+1
I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up a comment if there
. N I
. K ^TMP("GMRCMT",$J)
. I $P(^TMP("HLS",$J,SEG-1),"|",2)'["O" D
.. D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
. I $P(^TMP("HLS",$J,SEG-1),"|",2)["O" D
.. N GMRCMT
.. D NTE^GMRCISEG(GMRCDA,GMRCACT,.GMRCMT)
.. I $D(GMRCMT) M ^TMP("GMRCMT",$J)=GMRCMT
. Q:'$O(^TMP("GMRCMT",$J,0))
. S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
.. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
.. S SEG=SEG+1
. K ^TMP("GMRCMT",$J)
. Q
S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
. D LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
Q
;
RSLT(GMRCDA,GMRCACT) ;attach or dis-associate results and update
N HL,HLL,SEG,GMRC773,GMRCIQT
S SEG=1
K ^TMP("HLS",$J)
D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
I $G(HL) D Q ; if HL array can't be built, log it with an error
. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
D I $D(GMRCIQT) D NOMPI(GMRCDA,GMRCACT) Q ;build PID seg if nat'l ICN
. N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
. I '$G(GMRCDFN) S GMRCIQT=1 Q
. I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
. I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
. S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
. S SEG=SEG+1
. Q
D ;build ORC seg based on GMRCACT
. N ACTVT,OC,OS
. S ACTVT=$P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2) ; get activity
. S OC="RE"
. S OS=$S(ACTVT=9:"A",ACTVT=12:"IP",1:"CM") ; A=part res CM=comp IP=dis
. S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
. S SEG=SEG+1
I $P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2)'=99 D
. S ^TMP("HLS",$J,SEG)=$$OBXRSLT^GMRCISEG(GMRCDA,GMRCACT)
. S SEG=SEG+1
S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
. D LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
Q
;
NOMPI(GMRCIEN,GMRCACTV) ;process MPI exception
N GMRCDFN
S GMRCDFN=$P(^GMR(123,GMRCIEN,0),U,2)
D PTMPIER^GMRCIERR(GMRCDFN) ; send msg to local group for ICN problem
D LOGMSG^GMRCIUTL(GMRCIEN,GMRCACTV,,202) ;put inc. entry in MSG log
Q
;
ROUTE(GMRCDA) ; determine correct routing for IFC msg
; Input:
; GMRCDA = ien from file 123
;
; Output:
; the logical link to send the message to in format
; "GMRC IFC SUBSC^VHAHIN"
;
N SITE,GMRCLINK,STA
S SITE=$P(^GMR(123,GMRCDA,0),U,23) I 'SITE Q "" ;no ROUTING FACILITY
S STA=$$STA^XUAF4(SITE)
I '$L(STA) Q "" ;can't find station num for that site
D LINK^HLUTIL3(STA,.GMRCLINK,"I")
S GMRCLINK=$O(GMRCLINK(0)) I 'GMRCLINK Q "" ; no link for that site
S GMRCLINK=GMRCLINK(GMRCLINK) I '$L(GMRCLINK) Q "" ;no link name
Q "GMRC IFC SUBSC^"_GMRCLINK
GMRCIEVT ;SLC/JFR - process events and build HL7 message; 1/27/03 09:23
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31**;DEC 27, 1997
+2 ;
+3 ;don't start at the top
QUIT
TRIGR(IEN,ACTN) ;determine what action was taken on IFC and call event point
+1 ;Input:
+2 ; IEN = consult number from file 123
+3 ; ACT = ien in 40 multiple corresponding to activity
+4 ;
+5 NEW ACTYPE
+6 SET ACTYPE=$PIECE(^GMR(123,IEN,40,ACTN,0),U,2)
+7 IF 'ACTYPE
QUIT
+8 ;don't send admin corrections yet...
IF ACTYPE=26
QUIT
+9 ;
+10 ; check bkgrd job and run if overdue
+11 IF '$DATA(ZTQUEUED)
IF $$GONOGO^GMRCIBKG
Begin DoDot:1
+12 ;remove ZTQUEUED?
NEW ZTQUEUED
SET ZTQUEUED=1
DO EN^GMRCIBKG
End DoDot:1
+13 ;
+14 ;earlier pending activities
IF $ORDER(^GMR(123.6,"AC",IEN,ACTN),-1)
Begin DoDot:1
+15 ; not a trigger or not done here
IF ACTYPE=22
QUIT
+16 IF ACTYPE=6
NEW GMRCQT
Begin DoDot:2
+17 ;complete all transactions if IFC DC'd before request ever sent
+18 ;new request already sent
IF $ORDER(^GMR(123.6,"AC",IEN,ACTN),-1)'=1
QUIT
+19 SET GMRCQT=1
+20 NEW DA,DIE,DR,GMRCACTS
+21 SET GMRCACTS=0
+22 FOR
SET GMRCACTS=$ORDER(^GMR(123.6,"AC",IEN,GMRCACTS))
IF 'GMRCACTS
QUIT
Begin DoDot:3
+23 SET DIE="^GMR(123.6,"
SET DA=$ORDER(^GMR(123.6,"AC",IEN,GMRCACTS,1,0))
+24 SET DR=".06///@"
DO ^DIE
End DoDot:3
End DoDot:2
IF $DATA(GMRCQT)
QUIT
+25 ;msg log entry but no msg sent
DO LOGMSG^GMRCIUTL(IEN,ACTN,"",902)
End DoDot:1
QUIT
+26 ;send new order
IF ACTYPE=2!(ACTYPE=1)
DO NW(IEN)
QUIT
+27 ;inc report or add'l notes
IF ACTYPE=9!(ACTYPE=14)
DO RSLT(IEN,ACTN)
QUIT
+28 ;comp
IF ACTYPE=10
IF $PIECE(^GMR(123,IEN,40,ACTN,0),U,9)
DO RSLT(IEN,ACTN)
QUIT
+29 ;dis-associate result
IF ACTYPE=12
DO RSLT(IEN,ACTN)
QUIT
+30 ;ed/resubmit
IF ACTYPE=11
DO RESUB^GMRCIEV1(IEN,ACTN)
QUIT
+31 ; addendum added
IF ACTYPE=13
DO RSLT(IEN,ACTN)
QUIT
+32 ; sig finding update
IF ACTYPE=4
DO SF^GMRCIEV1(IEN,ACTN)
QUIT
+33 ;printed to is not a trigger
IF ACTYPE=22
QUIT
+34 ; forward
IF ACTYPE=17
DO FWD^GMRCIEV1(IEN,ACTN)
QUIT
+35 ; FWD into an IFC service
IF ACTYPE=25
DO FWD2IFC^GMRCIEV1(IEN,ACTN)
QUIT
+36 ;all other updates
DO GENUPD(IEN,ACTN)
+37 QUIT
NW(GMRCDA) ;build new order message for IFC
+1 ; Input:
+2 ; GMRCDA = ien from file 123
+3 ;
+4 NEW HL,HLL,SEG,GMRC773,GMRCIQT
+5 SET SEG=1
+6 KILL ^TMP("HLS",$JOB)
+7 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+8 ; if HL array can't be built, log it with an error
IF $GET(HL)
Begin DoDot:1
+9 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
End DoDot:1
QUIT
+10 ;build PID seg if not a local ICN
Begin DoDot:1
+11 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+12 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+13 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+14 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+15 SET ^TMP("HLS",$JOB,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+16 SET SEG=SEG+1
+17 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI(GMRCDA,1)
QUIT
+18 ; get ORC for new ord
SET ^TMP("HLS",$JOB,SEG)=$$NWORC^GMRCISG1(GMRCDA)
+19 SET SEG=SEG+1
+20 ;get OBR segment
SET ^TMP("HLS",$JOB,SEG)=$$OBR^GMRCISG1(GMRCDA)
+21 SET SEG=SEG+1
+22 ;build reason for request into OBX segment(s)
Begin DoDot:1
+23 KILL ^TMP("GMRCRFR",$JOB)
+24 DO OBXWP^GMRCISEG(GMRCDA,"NW",1,$NAME(^TMP("GMRCRFR",$JOB)))
+25 IF '$DATA(^TMP("GMRCRFR",$JOB))
QUIT
+26 NEW I
SET I=0
+27 FOR
SET I=$ORDER(^TMP("GMRCRFR",$JOB,I))
IF 'I
QUIT
Begin DoDot:2
+28 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCRFR",$JOB,I)
+29 SET SEG=SEG+1
End DoDot:2
+30 KILL ^TMP("GMRCRFR",$JOB)
+31 QUIT
End DoDot:1
+32 ; build prov DX in OBX
SET ^TMP("HLS",$JOB,SEG)=$$OBXPD^GMRCISG1(GMRCDA)
+33 SET SEG=SEG+1
+34 ;always send local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+35 ;log error
SET HLL("LINKS",1)=$$ROUTE(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+36 DO LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
End DoDot:1
QUIT
+37 DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
+38 NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+39 DO LOGMSG^GMRCIUTL(GMRCDA,1,+GMRC773,ERR)
+40 QUIT
+41 ;
GENUPD(GMRCDA,GMRCACT) ;build msg and send upon REC, SC or ADD CMT event
+1 NEW HL,HLL,SEG,GMRC773,GMRCIQT
+2 SET SEG=1
+3 KILL ^TMP("HLS",$JOB)
+4 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+5 ; if HL array can't be built, log it with an error
IF $GET(HL)
Begin DoDot:1
+6 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
End DoDot:1
QUIT
+7 ;build PID seg if nat'l ICN
Begin DoDot:1
+8 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+9 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+10 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+11 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+12 SET ^TMP("HLS",$JOB,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+13 SET SEG=SEG+1
+14 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI(GMRCDA,GMRCACT)
QUIT
+15 ;build ORC seg based on GMRCACT
Begin DoDot:1
+16 NEW ACTVT,OC,OS
+17 ; get activity
SET ACTVT=$PIECE(^GMR(123,GMRCDA,40,GMRCACT,0),U,2)
+18 ;set order control for ORC seg:
+19 ; v-- IP=cmt RE=adm comp OD=DC OC=cancel SC=sch or receive
+20 SET OC=$SELECT(ACTVT=20:"IP",ACTVT=10:"RE",ACTVT=6:"OD",ACTVT=19:"OC",1:"SC")
+21 ;set order status for ORC seg:
+22 ; v-- SC=sch RE=adm comp DC=DC CA=cancel IP=cmt or receive
+23 SET OS=$SELECT(ACTVT=8:"SC",ACTVT=10:"CM",ACTVT=6:"DC",ACTVT=19:"CA",1:"IP")
+24 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
+25 SET SEG=SEG+1
+26 QUIT
End DoDot:1
+27 ;send sig findings
IF $LENGTH($PIECE(^GMR(123,GMRCDA,0),U,19))
Begin DoDot:1
+28 SET ^TMP("HLS",$JOB,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
+29 SET SEG=SEG+1
End DoDot:1
+30 ;load up a comment if there
IF $ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))
Begin DoDot:1
+31 NEW I
+32 KILL ^TMP("GMRCMT",$JOB)
+33 IF $PIECE(^TMP("HLS",$JOB,SEG-1),"|",2)'["O"
Begin DoDot:2
+34 DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
End DoDot:2
+35 IF $PIECE(^TMP("HLS",$JOB,SEG-1),"|",2)["O"
Begin DoDot:2
+36 NEW GMRCMT
+37 DO NTE^GMRCISEG(GMRCDA,GMRCACT,.GMRCMT)
+38 IF $DATA(GMRCMT)
MERGE ^TMP("GMRCMT",$JOB)=GMRCMT
End DoDot:2
+39 IF '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+40 SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
IF 'I
QUIT
Begin DoDot:2
+41 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+42 SET SEG=SEG+1
End DoDot:2
+43 KILL ^TMP("GMRCMT",$JOB)
+44 QUIT
End DoDot:1
+45 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+46 ;log error
SET HLL("LINKS",1)=$$ROUTE(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+47 DO LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
End DoDot:1
QUIT
+48 DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
+49 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+50 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+51 QUIT
+52 ;
RSLT(GMRCDA,GMRCACT) ;attach or dis-associate results and update
+1 NEW HL,HLL,SEG,GMRC773,GMRCIQT
+2 SET SEG=1
+3 KILL ^TMP("HLS",$JOB)
+4 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+5 ; if HL array can't be built, log it with an error
IF $GET(HL)
Begin DoDot:1
+6 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
End DoDot:1
QUIT
+7 ;build PID seg if nat'l ICN
Begin DoDot:1
+8 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+9 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+10 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+11 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+12 SET ^TMP("HLS",$JOB,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+13 SET SEG=SEG+1
+14 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI(GMRCDA,GMRCACT)
QUIT
+15 ;build ORC seg based on GMRCACT
Begin DoDot:1
+16 NEW ACTVT,OC,OS
+17 ; get activity
SET ACTVT=$PIECE(^GMR(123,GMRCDA,40,GMRCACT,0),U,2)
+18 SET OC="RE"
+19 ; A=part res CM=comp IP=dis
SET OS=$SELECT(ACTVT=9:"A",ACTVT=12:"IP",1:"CM")
+20 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
+21 SET SEG=SEG+1
End DoDot:1
+22 IF $PIECE(^GMR(123,GMRCDA,40,GMRCACT,0),U,2)'=99
Begin DoDot:1
+23 SET ^TMP("HLS",$JOB,SEG)=$$OBXRSLT^GMRCISEG(GMRCDA,GMRCACT)
+24 SET SEG=SEG+1
End DoDot:1
+25 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+26 ;log error
SET HLL("LINKS",1)=$$ROUTE(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+27 DO LOGMSG^GMRCIUTL(IEN,ACTN,"",903)
End DoDot:1
QUIT
+28 DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
+29 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+30 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+31 QUIT
+32 ;
NOMPI(GMRCIEN,GMRCACTV) ;process MPI exception
+1 NEW GMRCDFN
+2 SET GMRCDFN=$PIECE(^GMR(123,GMRCIEN,0),U,2)
+3 ; send msg to local group for ICN problem
DO PTMPIER^GMRCIERR(GMRCDFN)
+4 ;put inc. entry in MSG log
DO LOGMSG^GMRCIUTL(GMRCIEN,GMRCACTV,,202)
+5 QUIT
+6 ;
ROUTE(GMRCDA) ; determine correct routing for IFC msg
+1 ; Input:
+2 ; GMRCDA = ien from file 123
+3 ;
+4 ; Output:
+5 ; the logical link to send the message to in format
+6 ; "GMRC IFC SUBSC^VHAHIN"
+7 ;
+8 NEW SITE,GMRCLINK,STA
+9 ;no ROUTING FACILITY
SET SITE=$PIECE(^GMR(123,GMRCDA,0),U,23)
IF 'SITE
QUIT ""
+10 SET STA=$$STA^XUAF4(SITE)
+11 ;can't find station num for that site
IF '$LENGTH(STA)
QUIT ""
+12 DO LINK^HLUTIL3(STA,.GMRCLINK,"I")
+13 ; no link for that site
SET GMRCLINK=$ORDER(GMRCLINK(0))
IF 'GMRCLINK
QUIT ""
+14 ;no link name
SET GMRCLINK=GMRCLINK(GMRCLINK)
IF '$LENGTH(GMRCLINK)
QUIT ""
+15 QUIT "GMRC IFC SUBSC^"_GMRCLINK
