GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ;01/27/03 09:28
;;3.0;CONSULT/REQUEST TRACKING;**22,28,31**;DEC 27, 1997
Q ;no-no-no
RESUB(GMRCDA,GMRCACT) ;build HL7 msg with edits from resubit
;Input:
; GMRCDA = ien from file 123
; GMRCACT = ien of the activity from 40 multiple
;
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^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
. 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
;
;build ORC seg based on GMRCACT
S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"XO","IP",GMRCACT)
S SEG=SEG+1
;
; include Inpatient or Outpatient
S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
S SEG=SEG+1
;
D ;load up reason for request
. K ^TMP("GMRCRFR",$J)
. D OBXWP^GMRCISEG(GMRCDA,"XO",GMRCACT,$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
D ;prov DX changed, send it
. S ^TMP("HLS",$J,SEG)=$$OBXPD^GMRCISG1(GMRCDA)
. S SEG=SEG+1
;
D ;send ed-res comment and file as is
. N I
. K ^TMP("GMRCMT",$J)
. D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
. 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^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
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
;
SF(GMRCDA,GMRCACT) ;send SIG FINDING update
;Input:
; GMRCDA = ien from file 123
; GMRCACT = ien of the activity from 40 multiple
N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
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^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
. 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
;
;build ORC seg based on GMRCACT
S GMRCOS=$S($P(^GMR(123,GMRCDA,0),U,12)="2":"CM",1:"IP")
S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"RE","CM",GMRCACT)
S SEG=SEG+1
I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up comment to send
. K ^TMP("GMRCMT",$J)
. D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
. Q:'$O(^TMP("GMRCMT",$J,0))
. N I 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)=$$OBXSF^GMRCISEG(GMRCDA),SEG=SEG+1
S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
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
;
FWD(GMRCDA,GMRCACT) ;bld HL7 msg upon FWD action
;Input:
; GMRCDA = ien from file 123
; GMRCACT = ien of the activity from 40 multiple
N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
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^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
. 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
;
;build ORC seg based on GMRCACT
S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"XX","IP",GMRCACT)
S SEG=SEG+1
S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT),SEG=SEG+1
I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up comment to send
. K ^TMP("GMRCMT",$J)
. D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
. Q:'$O(^TMP("GMRCMT",$J,0))
. N I 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)=$$OBXSF^GMRCISEG(GMRCDA),SEG=SEG+1
S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
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
;
FWD2IFC(GMRCDA,GMRCACT) ;pkg up and send request upon fwd'ing into IFC serv
;Input:
; GMRCDA = ien from file 123
; GMRCACT = ien of the activity from 40 multiple
N GMRCACTN
I '$P(^GMR(123,GMRCDA,0),U,22),'$D(^GMR(123.6,"C",GMRCDA)) D Q
. D NW^GMRCIEVT(GMRCDA)
. S GMRCACTN=1
. F S GMRCACTN=$O(^GMR(123,GMRCDA,40,GMRCACTN)) Q:'GMRCACTN D
.. D TRIGR^GMRCIEVT(GMRCDA,GMRCACTN)
D FWD(GMRCDA,GMRCACT)
Q
GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ;01/27/03 09:28
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31**;DEC 27, 1997
+2 ;no-no-no
QUIT
RESUB(GMRCDA,GMRCACT) ;build HL7 msg with edits from resubit
+1 ;Input:
+2 ; GMRCDA = ien from file 123
+3 ; GMRCACT = ien of the activity from 40 multiple
+4 ;
+5 NEW HL,HLL,SEG,GMRC773,GMRCIQT
+6 SET SEG=1
+7 KILL ^TMP("HLS",$JOB)
+8 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+9 ; if HL array can't be built, log it with an error
IF $GET(HL)
Begin DoDot:1
+10 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
End DoDot:1
QUIT
+11 ;build PID seg
Begin DoDot:1
+12 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+13 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+14 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+15 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+16 SET ^TMP("HLS",$JOB,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+17 SET SEG=SEG+1
+18 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+19 ;
+20 ;build ORC seg based on GMRCACT
+21 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"XO","IP",GMRCACT)
+22 SET SEG=SEG+1
+23 ;
+24 ; include Inpatient or Outpatient
+25 SET ^TMP("HLS",$JOB,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
+26 SET SEG=SEG+1
+27 ;
+28 ;load up reason for request
Begin DoDot:1
+29 KILL ^TMP("GMRCRFR",$JOB)
+30 DO OBXWP^GMRCISEG(GMRCDA,"XO",GMRCACT,$NAME(^TMP("GMRCRFR",$JOB)))
+31 IF '$DATA(^TMP("GMRCRFR",$JOB))
QUIT
+32 NEW I
SET I=0
+33 FOR
SET I=$ORDER(^TMP("GMRCRFR",$JOB,I))
IF 'I
QUIT
Begin DoDot:2
+34 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCRFR",$JOB,I)
+35 SET SEG=SEG+1
End DoDot:2
+36 KILL ^TMP("GMRCRFR",$JOB)
+37 QUIT
End DoDot:1
+38 ;prov DX changed, send it
Begin DoDot:1
+39 SET ^TMP("HLS",$JOB,SEG)=$$OBXPD^GMRCISG1(GMRCDA)
+40 SET SEG=SEG+1
End DoDot:1
+41 ;
+42 ;send ed-res comment and file as is
Begin DoDot:1
+43 NEW I
+44 KILL ^TMP("GMRCMT",$JOB)
+45 DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+46 IF '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+47 SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
IF 'I
QUIT
Begin DoDot:2
+48 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+49 SET SEG=SEG+1
End DoDot:2
+50 KILL ^TMP("GMRCMT",$JOB)
+51 QUIT
End DoDot:1
+52 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+53 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+54 ;log error
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+55 DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
+56 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+57 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+58 QUIT
+59 ;
SF(GMRCDA,GMRCACT) ;send SIG FINDING update
+1 ;Input:
+2 ; GMRCDA = ien from file 123
+3 ; GMRCACT = ien of the activity from 40 multiple
+4 NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
+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
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^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+18 ;
+19 ;build ORC seg based on GMRCACT
+20 SET GMRCOS=$SELECT($PIECE(^GMR(123,GMRCDA,0),U,12)="2":"CM",1:"IP")
+21 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"RE","CM",GMRCACT)
+22 SET SEG=SEG+1
+23 ;load up comment to send
IF $ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))
Begin DoDot:1
+24 KILL ^TMP("GMRCMT",$JOB)
+25 DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+26 IF '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+27 NEW I
SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
IF 'I
QUIT
Begin DoDot:2
+28 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+29 SET SEG=SEG+1
End DoDot:2
+30 KILL ^TMP("GMRCMT",$JOB)
+31 QUIT
End DoDot:1
+32 SET ^TMP("HLS",$JOB,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
SET SEG=SEG+1
+33 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+34 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+35 ;log error
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+36 DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
+37 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+38 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+39 QUIT
+40 ;
FWD(GMRCDA,GMRCACT) ;bld HL7 msg upon FWD action
+1 ;Input:
+2 ; GMRCDA = ien from file 123
+3 ; GMRCACT = ien of the activity from 40 multiple
+4 NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
+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
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^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+18 ;
+19 ;build ORC seg based on GMRCACT
+20 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"XX","IP",GMRCACT)
+21 SET SEG=SEG+1
+22 SET ^TMP("HLS",$JOB,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
SET SEG=SEG+1
+23 ;load up comment to send
IF $ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))
Begin DoDot:1
+24 KILL ^TMP("GMRCMT",$JOB)
+25 DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+26 IF '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+27 NEW I
SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
IF 'I
QUIT
Begin DoDot:2
+28 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+29 SET SEG=SEG+1
End DoDot:2
+30 KILL ^TMP("GMRCMT",$JOB)
+31 QUIT
End DoDot:1
+32 SET ^TMP("HLS",$JOB,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
SET SEG=SEG+1
+33 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+34 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+35 ;log error
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+36 DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
+37 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+38 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+39 QUIT
+40 ;
FWD2IFC(GMRCDA,GMRCACT) ;pkg up and send request upon fwd'ing into IFC serv
+1 ;Input:
+2 ; GMRCDA = ien from file 123
+3 ; GMRCACT = ien of the activity from 40 multiple
+4 NEW GMRCACTN
+5 IF '$PIECE(^GMR(123,GMRCDA,0),U,22)
IF '$DATA(^GMR(123.6,"C",GMRCDA))
Begin DoDot:1
+6 DO NW^GMRCIEVT(GMRCDA)
+7 SET GMRCACTN=1
+8 FOR
SET GMRCACTN=$ORDER(^GMR(123,GMRCDA,40,GMRCACTN))
IF 'GMRCACTN
QUIT
Begin DoDot:2
+9 DO TRIGR^GMRCIEVT(GMRCDA,GMRCACTN)
End DoDot:2
End DoDot:1
QUIT
+10 DO FWD(GMRCDA,GMRCACT)
+11 QUIT
