GMRCIEVT.m

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