GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ; Jan 09, 2025@09:44:31
;;3.0;CONSULT/REQUEST TRACKING;**22,28,31,154,184,185,189,201**;DEC 27, 1997;Build 7
;#2161 HFLNC2, #2164 HLMA, #2701 MPIF001, #3105 VAFCPID, #2056 DIQ
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
;
; If HL7 message goes to Cerner, hold it until the Cerner order number is received. wtc 8/8/24
;
I '$P(^GMR(123,GMRCDA,0),U,22),$$ISCERNER^GMRCIEVT(GMRCDA) D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204) Q ;
;
N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCPD
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")
. ;
. ; If remote site is converted, enhance the PID segment. p184
. ;
. I $$CNVTD^GMRCIEVT(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDFN,$P($G(^GMR(123,GMRCDA,"CERNER")),U,3)) ;
. ;
. 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)
;
; If remote site is converted, enhance the OBR segment. p184
;
I $$CNVTD^GMRCIEVT(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2OBR^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDA) ;
;
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 GMRCPD=$$OBXPD^GMRCISG1(GMRCDA) ;bl;154 preventing blank line for OBX
. I GMRCPD'="" S ^TMP("HLS",$J,SEG)=GMRCPD ; build prov DX in OBX
. 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:'$$EXIST201(GMRCDA,GMRCACT) LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error ;MKN GMRC*3*154 '$$EXIST201
S HLP("SUBSCRIBER")="^^^^"_$P(HLL("LINKS",1),U,3) ;MKN GMRC*3*154 Station coming back from $$ROUTE
D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773,,.HLP) ;MKN GMRC*3*154 added 6th parameter that passes to HLP array in GENERATE^HLMA
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
;
; If HL7 message goes to Cerner, hold it until the Cerner order number is received. wtc 8/8/24
;
I '$P(^GMR(123,GMRCDA,0),U,22),$$ISCERNER^GMRCIEVT(GMRCDA) D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204) Q ;
;
N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS,GMRCCRNR,OBR,PROSTHCS ; P184
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")
. ;
. ; If remote site is converted, enhance the PID segment. p184
. ;
. I $$CNVTD^GMRCIEVT(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDFN,$P($G(^GMR(123,GMRCDA,"CERNER")),U,3)) ;
. ;
. 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
;
; If remote site is converted, add OBR segment. p184
;
I $$CNVTD^GMRCIEVT(GMRCDA)=1 D ;
. S OBR=$$OBR^GMRCISG1(GMRCDA) ;
. S OBR=$$ADD2OBR^GMRCIUTL(OBR,GMRCDA),^TMP("HLS",$J,SEG)=OBR ;
. S SEG=SEG+1
;
; Determine if order is for Prosthetics - p184 WTC 6/1/22
;
S PROSTHCS=$S($G(OBR)="":0,$P($P(OBR,"|",5),U,2)["PROSTHETICS IFC":1,1:0) ; P184
;
I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up comment to send
. K ^TMP("GMRCMT",$J)
. S GMRCCRNR=$$ISCERNER^GMRCIEVT(GMRCDA) ;MKN 184
. D:GMRCCRNR&'PROSTHCS CRNROBX(GMRCDA,$NA(^TMP("GMRCMT",$J))) ; P184 WTC 6/1/22
. D:'GMRCCRNR!PROSTHCS OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J))) ; P184 WTC 6/1/22
. 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
I $L($P(^GMR(123,GMRCDA,0),U,19)) 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:'$$EXIST201(GMRCDA,GMRCACT) LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error ;MKN GMRC*3*154 '$$EXIST201
S HLP("SUBSCRIBER")="^^^^"_$P(HLL("LINKS",1),U,3) ;MKN GMRC*3*154 Station coming back from $$ROUTE
;
D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773,,.HLP) ;MKN GMRC*3*154 added 6th parameter that passes to HLP array in GENERATE^HLMA
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
;
; If HL7 message goes to Cerner, hold it until the Cerner order number is received. wtc 8/8/24
;
I '$P(^GMR(123,GMRCDA,0),U,22),$$ISCERNER^GMRCIEVT(GMRCDA) D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204) Q ;
;
N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS,GMRCCRNR,OBR,PROSTHCS ; P184
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")
. ;
. ; If remote site is converted, enhance the PID segment. p184
. ;
. I $$CNVTD^GMRCIEVT(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDFN,$P($G(^GMR(123,GMRCDA,"CERNER")),U,3)) ;
. ;
. 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 OBR=$$OBR^GMRCISG1(GMRCDA,GMRCACT) ;
;
; If remote site is converted, enhance the OBR segment. p184
;
I $$CNVTD^GMRCIEVT(GMRCDA)=1 S OBR=$$ADD2OBR^GMRCIUTL(OBR,GMRCDA) ;
S ^TMP("HLS",$J,SEG)=OBR ;
;
S SEG=SEG+1 ;
;
; Determine if order is for Prosthetics - p184 WTC 6/1/22
;
S PROSTHCS=$S($G(OBR)="":0,$P($P(OBR,"|",5),U,2)["PROSTHETICS IFC":1,1:0) ; P184
;
S GMRCCRNR=$$ISCERNER^GMRCIEVT(GMRCDA) ;MKN 184
I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0))!GMRCCRNR D ;load up comment to send. P201 WTC 9/9/24
. K ^TMP("GMRCMT",$J)
. D:GMRCCRNR&'PROSTHCS CRNROBX(GMRCDA,$NA(^TMP("GMRCMT",$J))) ; P184 WTC 6/1/22
. D:'GMRCCRNR!PROSTHCS OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J))) ; P184 WTC 6/1/22
. 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
I $L($P(^GMR(123,GMRCDA,0),U,19)) 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:'$$EXIST201(GMRCDA,GMRCACT) LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error ;MKN GMRC*3*154 '$$EXIST201
S HLP("SUBSCRIBER")="^^^^"_$P(HLL("LINKS",1),U,3) ;MKN GMRC*3*154 Station coming back from $$ROUTE
;
D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773,,.HLP) ;MKN GMRC*3*154 added 6th parameter that passes to HLP array in GENERATE^HLMA
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))!($$ISCERNER^GMRCIEVT(GMRCDA)) D Q ;
. D NW^GMRCIEVT(GMRCDA,GMRCACT) ; Added GMRCACT parameter P 189 wtc 6/24/24
. ;
. ; If forward to site is Cerner-enabled, log error code 204 to delay sending message until new order processed by Cerner unless
. ; proxy add failed or did not complete (error code 203 or 205). p201 wtc 12/1/23, 12/19/24
. ;
. I $$ISCERNER^GMRCIEVT(GMRCDA) D Q ;
.. N OK2SEND,MSGLOGDA,ERRCODE S OK2SEND=1,MSGLOGDA="" ;
.. F S MSGLOGDA=$O(^GMR(123.6,"C",GMRCDA,GMRCACT,MSGLOGDA),-1) Q:'MSGLOGDA S ERRCODE=$P($G(^GMR(123.6,MSGLOGDA,0)),U,8) I ERRCODE=203!(ERRCODE=205) S OK2SEND=0 Q ;
.. I OK2SEND D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204) Q ;
. ;
. ; Send all actions if VistA-to-VistA.
. ;
. S GMRCACTN=1
. F S GMRCACTN=$O(^GMR(123,GMRCDA,40,GMRCACTN)) Q:'GMRCACTN D
.. D TRIGR^GMRCIEVT(GMRCDA,GMRCACTN)
;
; Do not send forward message if proxy add failed or is incomplete unless Cerner order number has been received. p201 12/19/24, 1/8/25
;
I $$ISCERNER^GMRCIEVT(GMRCDA) D Q ;
. N OK2SEND,MSGLOGDA,ERRCODE S OK2SEND=1,MSGLOGDA="" ;
. I '$P(^GMR(123,GMRCDA,0),U,22) F S MSGLOGDA=$O(^GMR(123.6,"C",GMRCDA,GMRCACT,MSGLOGDA),-1) Q:'MSGLOGDA S ERRCODE=$P($G(^GMR(123.6,MSGLOGDA,0)),U,8) I ERRCODE=203!(ERRCODE=205) S OK2SEND=0 Q ;
. I OK2SEND D FWD(GMRCDA,GMRCACT) ;
;
; VistA-to-VistA IFC, send forward message immediately. p201 12/19/24
;
I '$$ISCERNER^GMRCIEVT(GMRCDA) D FWD(GMRCDA,GMRCACT) ;
;
Q
;
EXIST201(GMRCDA,GMRCACT) ;
N IEN123P6 S IEN123P6=$O(^GMR(123.6,"C",GMRCDA,GMRCACT,"")) Q:'IEN123P6 0
Q $S($$GET1^DIQ(123.6,IEN123P6_",",.08)="Unknown Patient":1,1:0)
;
;MKN 184 ADDED CRNRNTE
CRNRNTE(IEN,GMRCNA) ;format an NTE seg with all comments to go to Cerner
;Output is all comments in ^TMP("GMRCMT",$J)
;
N CMT,GMRCACTD,GMRCDT,GMRCENBY,GMRCIENS,GMRCL,GMRCLOC,GMRCN,GMRCOUT,GMRCPCS,GMRCT,GMRCTMP,GMRCX,TCH
S CMT=0
D SETTCH2^GMRCIMSG() ;MKN GMRC*3.0*154 Get TCH array
S GMRCLOC=$P($$SITE^VASITE,U,2)
;
; Prepare list of consult activities that trigger generation of cumulative comments.
;
F GMRCACTD="ADDED COMMENT","DISCONTINUED","CANCELLED","RECEIVED","REMOTE REQUEST RECEIVED","SCHEDULED","SIG FINDING UPDATE","FORWARDED FROM","FWD TO REMOTE SERVICE","COMPLETE/UPDATE" D ;
. S GMRCX=$O(^GMR(123.1,"B",GMRCACTD,"")) S:GMRCX GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
F GMRCACTD="STATUS CHANGE","EDIT/RESUBMITTED","DISASSOCIATE RESULT","ADDENDUM ADDED TO","NEW NOTE ADDED" D ; wtc 3/2/23 P185
. S GMRCX=$O(^GMR(123.1,"B",GMRCACTD,"")) S:GMRCX GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
;
S GMRCT=0,GMRCN="@" F S GMRCN=$O(^GMR(123,IEN,40,GMRCN),-1) Q:'GMRCN S GMRCX=^(GMRCN,0) I $D(GMRCACTD($P(GMRCX,U,2))),$D(^GMR(123,IEN,40,GMRCN,1,1)) D
. S GMRCIENS=GMRCN_","_IEN_"," K GMRCOUT D GETS^DIQ(123.02,GMRCIENS,"2;4;.21","IE","GMRCOUT")
. S GMRCDT=$G(GMRCOUT(123.02,GMRCIENS,2,"I")),GMRCDT=$$UP^XLFSTR($$FMTE^XLFDT(GMRCOUT(123.02,GMRCIENS,2,"I"),"5PZ"))
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="NTE|1|L|Activity Type: "_GMRCACTD($P(GMRCX,U,2))
. S GMRCL=0 F S GMRCL=$O(^GMR(123,IEN,40,GMRCN,1,GMRCL)) Q:'GMRCL S GMRCT=GMRCT+1,GMRCX=$G(^(GMRCL,0)),(@GMRCNA@(GMRCT))="NTE|1|L|"_GMRCX
. S GMRCT=GMRCT+1,GMRCLOC=$$LOC(GMRCLOC,GMRCIENS),@GMRCNA@(GMRCT)="NTE|1|L|Entered At Location: "_GMRCLOC D SITE ; P184
. S GMRCENBY=$G(GMRCOUT(123.02,GMRCIENS,4,"E")) I GMRCENBY="" S GMRCENBY=$P($G(GMRCOUT(123.02,GMRCIENS,.21,"E")),U)
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="NTE|1|L|Entered By: "_GMRCENBY
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="NTE|1|L|"_GMRCDT
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="NTE|1|L| "
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="NTE|1|L| "
Q
;
CRNROBX(IEN,GMRCNA) ;If Add Comment going to Cerner, send ALL comments
;
; IEN = pointer to #123
; GMRCNA = name of array where HL7 segments are stored
;
;Output is all comments in ^TMP("GMRCMT",$J)
N GMRCACT,GMRCACTD,GMRCDT,GMRCENBY,GMRCIENS,GMRCL,GMRCLOC,GMRCN,GMRCO,GMRCT,GMRCTMP,GMRCX,LOCNAME ;
;
; Prepare list of consult activities that trigger generation of cumulative comments.
;
S GMRCLOC=$P($$SITE^VASITE,U,2) ;
F GMRCACTD="ADDED COMMENT","DISCONTINUED","CANCELLED","RECEIVED","REMOTE REQUEST RECEIVED","SCHEDULED","SIG FINDING UPDATE","FORWARDED FROM","COMPLETE/UPDATE","FWD TO REMOTE SERVICE" D ; wtc 2/4/22
. S GMRCX=$O(^GMR(123.1,"B",GMRCACTD,"")) S:GMRCX GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
F GMRCACTD="STATUS CHANGE","EDIT/RESUBMITTED","DISASSOCIATE RESULT","ADDENDUM ADDED TO","NEW NOTE ADDED" D ; wtc 3/2/23 P185
. S GMRCX=$O(^GMR(123.1,"B",GMRCACTD,"")) S:GMRCX GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
;
S GMRCTMP=$NA(^TMP("GMRCCRNRCMT",$J)) K @GMRCTMP
;
S GMRCT=0,GMRCN="@" ;
F S GMRCN=$O(^GMR(123,IEN,40,GMRCN),-1) Q:'GMRCN S GMRCX=^(GMRCN,0) I $D(GMRCACTD($P(GMRCX,U,2))) D ;
. Q:'$D(^GMR(123,IEN,40,GMRCN,1,1))&(GMRCACTD($P(GMRCX,U,2))'["Received") ; WTC P201 12/19/23
. S GMRCIENS=GMRCN_","_IEN_"," K GMRCO D GETS^DIQ(123.02,GMRCIENS,"2;4;.21;.32;.33","IE","GMRCO")
. S GMRCDT=$G(GMRCO(123.02,GMRCIENS,2,"I")),GMRCDT=$$UP^XLFSTR($$FMTE^XLFDT(GMRCO(123.02,GMRCIENS,2,"I"),"5PZ"))
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"| ||||||P" ;
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Activity Type: "_GMRCACTD($P(GMRCX,U,2))_"||||||P" ;
. ;
. ; If activity is received, insert "Referral received by CPRS" as a comment. wtc p201 12/19/23
. ;
. I GMRCACTD($P(GMRCX,U,2))["Received" S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Referral received by CPRS||||||P" ;
. ;
. K @GMRCTMP D OBXWP^GMRCISEG(IEN,"IP",GMRCN,GMRCTMP) ; WTC 2/4/22
. S GMRCL=0 F S GMRCL=$O(@GMRCTMP@(GMRCL)) Q:'GMRCL S GMRCT=GMRCT+1,GMRCX=@GMRCTMP@(GMRCL),$P(GMRCX,"|",5)=GMRCT,@GMRCNA@(GMRCT)=GMRCX ; WTC 6/10/22
. ;
. I GMRCO(123.02,GMRCIENS,.32,"I")'=1 S GMRCT=GMRCT+1 S (GMRCLOC,LOCNAME)=$$LOC^GMRCIEVT(GMRCLOC,GMRCIENS),@GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered At Location: "_GMRCLOC_"||||||P" ;
. I GMRCO(123.02,GMRCIENS,.32,"I")=1 D ;
.. N GMRCSITE,GMRCSTDA,GMRCSTNM S GMRCSITE=GMRCO(123.02,GMRCIENS,.33,"I"),GMRCSTDA=$O(^DIC(4,"D",GMRCSITE,0)),GMRCSTNM=$$GET1^DIQ(4,GMRCSTDA,.01) ;
.. S GMRCT=GMRCT+1 S @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered At Location: "_GMRCSTNM_"||||||P" ;
. S GMRCENBY=$G(GMRCO(123.02,GMRCIENS,4,"E")) I GMRCENBY="" S GMRCENBY=$P($G(GMRCO(123.02,GMRCIENS,.21,"E")),U)
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered By: "_GMRCENBY_"||||||P" ;
. S GMRCT=GMRCT+1,@GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|"_GMRCDT_"||||||P" ;
K @GMRCTMP
Q
;
LOC(GMRCLOC,GMRCIENS) ;DETERMINE LOCATION
N LOCNAME
I '$D(^GMR(123,$P(GMRCIENS,",",2),40,($P(GMRCIENS,",",1)-1),3)) D SITE Q GMRCLOC
S LOCNAME=^GMR(123,$P(GMRCIENS,",",2),40,($P(GMRCIENS,",",1)-1),3)
S LOCNAME=$P(LOCNAME,U,3)
S LOCNAME=$P(^DIC(4,LOCNAME,0),U,1)
Q LOCNAME
SITE ;SET LOCAL SITE
S GMRCLOC=$P($$SITE^VASITE,U,2)
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCIEV1 16361 printed Aug 26, 2025@22:01:48 Page 2
GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ; Jan 09, 2025@09:44:31
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31,154,184,185,189,201**;DEC 27, 1997;Build 7
+2 ;#2161 HFLNC2, #2164 HLMA, #2701 MPIF001, #3105 VAFCPID, #2056 DIQ
+3 ;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 ; If HL7 message goes to Cerner, hold it until the Cerner order number is received. wtc 8/8/24
+6 ;
+7 ;
IF '$PIECE(^GMR(123,GMRCDA,0),U,22)
IF $$ISCERNER^GMRCIEVT(GMRCDA)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204)
QUIT
+8 ;
+9 NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCPD
+10 SET SEG=1
+11 KILL ^TMP("HLS",$JOB)
+12 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+13 ; if HL array can't be built, log it with an error
IF $GET(HL)
Begin DoDot:1
+14 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
End DoDot:1
QUIT
+15 ;build PID seg
Begin DoDot:1
+16 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+17 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+18 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+19 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+20 SET ^TMP("HLS",$JOB,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+21 ;
+22 ; If remote site is converted, enhance the PID segment. p184
+23 ;
+24 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
SET ^TMP("HLS",$JOB,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$JOB,SEG),GMRCDFN,$PIECE($GET(^GMR(123,GMRCDA,"CERNER")),U,3))
+25 ;
+26 SET SEG=SEG+1
+27 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+28 ;
+29 ;build ORC seg based on GMRCACT
+30 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"XO","IP",GMRCACT)
+31 SET SEG=SEG+1
+32 ;
+33 ; include Inpatient or Outpatient
+34 SET ^TMP("HLS",$JOB,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
+35 ;
+36 ; If remote site is converted, enhance the OBR segment. p184
+37 ;
+38 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
SET ^TMP("HLS",$JOB,SEG)=$$ADD2OBR^GMRCIUTL(^TMP("HLS",$JOB,SEG),GMRCDA)
+39 ;
+40 SET SEG=SEG+1
+41 ;
+42 ;load up reason for request
Begin DoDot:1
+43 KILL ^TMP("GMRCRFR",$JOB)
+44 DO OBXWP^GMRCISEG(GMRCDA,"XO",GMRCACT,$NAME(^TMP("GMRCRFR",$JOB)))
+45 IF '$DATA(^TMP("GMRCRFR",$JOB))
QUIT
+46 NEW I
SET I=0
+47 FOR
SET I=$ORDER(^TMP("GMRCRFR",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+48 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCRFR",$JOB,I)
+49 SET SEG=SEG+1
End DoDot:2
+50 KILL ^TMP("GMRCRFR",$JOB)
+51 QUIT
End DoDot:1
+52 ;prov DX changed, send it
Begin DoDot:1
+53 ;bl;154 preventing blank line for OBX
SET GMRCPD=$$OBXPD^GMRCISG1(GMRCDA)
+54 ; build prov DX in OBX
IF GMRCPD'=""
SET ^TMP("HLS",$JOB,SEG)=GMRCPD
+55 SET SEG=SEG+1
End DoDot:1
+56 ;
+57 ;send ed-res comment and file as is
Begin DoDot:1
+58 NEW I
+59 KILL ^TMP("GMRCMT",$JOB)
+60 DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+61 if '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+62 SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+63 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+64 SET SEG=SEG+1
End DoDot:2
+65 KILL ^TMP("GMRCMT",$JOB)
+66 QUIT
End DoDot:1
+67 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+68 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+69 ;log error ;MKN GMRC*3*154 '$$EXIST201
if '$$EXIST201(GMRCDA,GMRCACT)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+70 ;MKN GMRC*3*154 Station coming back from $$ROUTE
SET HLP("SUBSCRIBER")="^^^^"_$PIECE(HLL("LINKS",1),U,3)
+71 ;MKN GMRC*3*154 added 6th parameter that passes to HLP array in GENERATE^HLMA
DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773,,.HLP)
+72 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+73 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+74 QUIT
+75 ;
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 ;
+5 ; If HL7 message goes to Cerner, hold it until the Cerner order number is received. wtc 8/8/24
+6 ;
+7 ;
IF '$PIECE(^GMR(123,GMRCDA,0),U,22)
IF $$ISCERNER^GMRCIEVT(GMRCDA)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204)
QUIT
+8 ;
+9 ; P184
NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS,GMRCCRNR,OBR,PROSTHCS
+10 SET SEG=1
+11 KILL ^TMP("HLS",$JOB)
+12 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+13 ; if HL array can't be built, log it with an error
IF $GET(HL)
Begin DoDot:1
+14 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
End DoDot:1
QUIT
+15 ;build PID seg
Begin DoDot:1
+16 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+17 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+18 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+19 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+20 SET ^TMP("HLS",$JOB,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+21 ;
+22 ; If remote site is converted, enhance the PID segment. p184
+23 ;
+24 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
SET ^TMP("HLS",$JOB,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$JOB,SEG),GMRCDFN,$PIECE($GET(^GMR(123,GMRCDA,"CERNER")),U,3))
+25 ;
+26 SET SEG=SEG+1
+27 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+28 ;
+29 ;build ORC seg based on GMRCACT
+30 SET GMRCOS=$SELECT($PIECE(^GMR(123,GMRCDA,0),U,12)="2":"CM",1:"IP")
+31 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"RE","CM",GMRCACT)
+32 SET SEG=SEG+1
+33 ;
+34 ; If remote site is converted, add OBR segment. p184
+35 ;
+36 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
Begin DoDot:1
+37 ;
SET OBR=$$OBR^GMRCISG1(GMRCDA)
+38 ;
SET OBR=$$ADD2OBR^GMRCIUTL(OBR,GMRCDA)
SET ^TMP("HLS",$JOB,SEG)=OBR
+39 SET SEG=SEG+1
End DoDot:1
+40 ;
+41 ; Determine if order is for Prosthetics - p184 WTC 6/1/22
+42 ;
+43 ; P184
SET PROSTHCS=$SELECT($GET(OBR)="":0,$PIECE($PIECE(OBR,"|",5),U,2)["PROSTHETICS IFC":1,1:0)
+44 ;
+45 ;load up comment to send
IF $ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))
Begin DoDot:1
+46 KILL ^TMP("GMRCMT",$JOB)
+47 ;MKN 184
SET GMRCCRNR=$$ISCERNER^GMRCIEVT(GMRCDA)
+48 ; P184 WTC 6/1/22
if GMRCCRNR&'PROSTHCS
DO CRNROBX(GMRCDA,$NAME(^TMP("GMRCMT",$JOB)))
+49 ; P184 WTC 6/1/22
if 'GMRCCRNR!PROSTHCS
DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+50 if '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+51 NEW I
SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+52 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+53 SET SEG=SEG+1
End DoDot:2
+54 KILL ^TMP("GMRCMT",$JOB)
+55 QUIT
End DoDot:1
+56 IF $LENGTH($PIECE(^GMR(123,GMRCDA,0),U,19))
SET ^TMP("HLS",$JOB,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
SET SEG=SEG+1
+57 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+58 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+59 ;log error ;MKN GMRC*3*154 '$$EXIST201
if '$$EXIST201(GMRCDA,GMRCACT)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+60 ;MKN GMRC*3*154 Station coming back from $$ROUTE
SET HLP("SUBSCRIBER")="^^^^"_$PIECE(HLL("LINKS",1),U,3)
+61 ;
+62 ;MKN GMRC*3*154 added 6th parameter that passes to HLP array in GENERATE^HLMA
DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773,,.HLP)
+63 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+64 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+65 QUIT
+66 ;
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 ;
+5 ; If HL7 message goes to Cerner, hold it until the Cerner order number is received. wtc 8/8/24
+6 ;
+7 ;
IF '$PIECE(^GMR(123,GMRCDA,0),U,22)
IF $$ISCERNER^GMRCIEVT(GMRCDA)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204)
QUIT
+8 ;
+9 ; P184
NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS,GMRCCRNR,OBR,PROSTHCS
+10 SET SEG=1
+11 KILL ^TMP("HLS",$JOB)
+12 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+13 ; if HL array can't be built, log it with an error
IF $GET(HL)
Begin DoDot:1
+14 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
End DoDot:1
QUIT
+15 ;build PID seg
Begin DoDot:1
+16 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+17 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+18 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+19 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+20 SET ^TMP("HLS",$JOB,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+21 ;
+22 ; If remote site is converted, enhance the PID segment. p184
+23 ;
+24 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
SET ^TMP("HLS",$JOB,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$JOB,SEG),GMRCDFN,$PIECE($GET(^GMR(123,GMRCDA,"CERNER")),U,3))
+25 ;
+26 SET SEG=SEG+1
+27 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+28 ;
+29 ;build ORC seg based on GMRCACT
+30 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"XX","IP",GMRCACT)
+31 SET SEG=SEG+1
+32 ;
+33 ;
SET OBR=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
+34 ;
+35 ; If remote site is converted, enhance the OBR segment. p184
+36 ;
+37 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
SET OBR=$$ADD2OBR^GMRCIUTL(OBR,GMRCDA)
+38 ;
SET ^TMP("HLS",$JOB,SEG)=OBR
+39 ;
+40 ;
SET SEG=SEG+1
+41 ;
+42 ; Determine if order is for Prosthetics - p184 WTC 6/1/22
+43 ;
+44 ; P184
SET PROSTHCS=$SELECT($GET(OBR)="":0,$PIECE($PIECE(OBR,"|",5),U,2)["PROSTHETICS IFC":1,1:0)
+45 ;
+46 ;MKN 184
SET GMRCCRNR=$$ISCERNER^GMRCIEVT(GMRCDA)
+47 ;load up comment to send. P201 WTC 9/9/24
IF $ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))!GMRCCRNR
Begin DoDot:1
+48 KILL ^TMP("GMRCMT",$JOB)
+49 ; P184 WTC 6/1/22
if GMRCCRNR&'PROSTHCS
DO CRNROBX(GMRCDA,$NAME(^TMP("GMRCMT",$JOB)))
+50 ; P184 WTC 6/1/22
if 'GMRCCRNR!PROSTHCS
DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+51 if '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+52 NEW I
SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+53 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+54 SET SEG=SEG+1
End DoDot:2
+55 KILL ^TMP("GMRCMT",$JOB)
+56 QUIT
End DoDot:1
+57 IF $LENGTH($PIECE(^GMR(123,GMRCDA,0),U,19))
SET ^TMP("HLS",$JOB,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
SET SEG=SEG+1
+58 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+59 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+60 ;log error ;MKN GMRC*3*154 '$$EXIST201
if '$$EXIST201(GMRCDA,GMRCACT)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+61 ;MKN GMRC*3*154 Station coming back from $$ROUTE
SET HLP("SUBSCRIBER")="^^^^"_$PIECE(HLL("LINKS",1),U,3)
+62 ;
+63 ;MKN GMRC*3*154 added 6th parameter that passes to HLP array in GENERATE^HLMA
DO GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773,,.HLP)
+64 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+65 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+66 QUIT
+67 ;
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))!($$ISCERNER^GMRCIEVT(GMRCDA))
Begin DoDot:1
+6 ; Added GMRCACT parameter P 189 wtc 6/24/24
DO NW^GMRCIEVT(GMRCDA,GMRCACT)
+7 ;
+8 ; If forward to site is Cerner-enabled, log error code 204 to delay sending message until new order processed by Cerner unless
+9 ; proxy add failed or did not complete (error code 203 or 205). p201 wtc 12/1/23, 12/19/24
+10 ;
+11 ;
IF $$ISCERNER^GMRCIEVT(GMRCDA)
Begin DoDot:2
+12 ;
NEW OK2SEND,MSGLOGDA,ERRCODE
SET OK2SEND=1
SET MSGLOGDA=""
+13 ;
FOR
SET MSGLOGDA=$ORDER(^GMR(123.6,"C",GMRCDA,GMRCACT,MSGLOGDA),-1)
if 'MSGLOGDA
QUIT
SET ERRCODE=$PIECE($GET(^GMR(123.6,MSGLOGDA,0)),U,8)
IF ERRCODE=203!(ERRCODE=205)
SET OK2SEND=0
QUIT
+14 ;
IF OK2SEND
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,204)
QUIT
End DoDot:2
QUIT
+15 ;
+16 ; Send all actions if VistA-to-VistA.
+17 ;
+18 SET GMRCACTN=1
+19 FOR
SET GMRCACTN=$ORDER(^GMR(123,GMRCDA,40,GMRCACTN))
if 'GMRCACTN
QUIT
Begin DoDot:2
+20 DO TRIGR^GMRCIEVT(GMRCDA,GMRCACTN)
End DoDot:2
End DoDot:1
QUIT
+21 ;
+22 ; Do not send forward message if proxy add failed or is incomplete unless Cerner order number has been received. p201 12/19/24, 1/8/25
+23 ;
+24 ;
IF $$ISCERNER^GMRCIEVT(GMRCDA)
Begin DoDot:1
+25 ;
NEW OK2SEND,MSGLOGDA,ERRCODE
SET OK2SEND=1
SET MSGLOGDA=""
+26 ;
IF '$PIECE(^GMR(123,GMRCDA,0),U,22)
FOR
SET MSGLOGDA=$ORDER(^GMR(123.6,"C",GMRCDA,GMRCACT,MSGLOGDA),-1)
if 'MSGLOGDA
QUIT
SET ERRCODE=$PIECE($GET(^GMR(123.6,MSGLOGDA,0)),U,8)
IF ERRCODE=203!(ERRCODE=205)
SET OK2SEND=0
QUIT
+27 ;
IF OK2SEND
DO FWD(GMRCDA,GMRCACT)
End DoDot:1
QUIT
+28 ;
+29 ; VistA-to-VistA IFC, send forward message immediately. p201 12/19/24
+30 ;
+31 ;
IF '$$ISCERNER^GMRCIEVT(GMRCDA)
DO FWD(GMRCDA,GMRCACT)
+32 ;
+33 QUIT
+34 ;
EXIST201(GMRCDA,GMRCACT) ;
+1 NEW IEN123P6
SET IEN123P6=$ORDER(^GMR(123.6,"C",GMRCDA,GMRCACT,""))
if 'IEN123P6
QUIT 0
+2 QUIT $SELECT($$GET1^DIQ(123.6,IEN123P6_",",.08)="Unknown Patient":1,1:0)
+3 ;
+4 ;MKN 184 ADDED CRNRNTE
CRNRNTE(IEN,GMRCNA) ;format an NTE seg with all comments to go to Cerner
+1 ;Output is all comments in ^TMP("GMRCMT",$J)
+2 ;
+3 NEW CMT,GMRCACTD,GMRCDT,GMRCENBY,GMRCIENS,GMRCL,GMRCLOC,GMRCN,GMRCOUT,GMRCPCS,GMRCT,GMRCTMP,GMRCX,TCH
+4 SET CMT=0
+5 ;MKN GMRC*3.0*154 Get TCH array
DO SETTCH2^GMRCIMSG()
+6 SET GMRCLOC=$PIECE($$SITE^VASITE,U,2)
+7 ;
+8 ; Prepare list of consult activities that trigger generation of cumulative comments.
+9 ;
+10 ;
FOR GMRCACTD="ADDED COMMENT","DISCONTINUED","CANCELLED","RECEIVED","REMOTE REQUEST RECEIVED","SCHEDULED","SIG FINDING UPDATE","FORWARDED FROM","FWD TO REMOTE SERVICE","COMPLETE/UPDATE"
Begin DoDot:1
+11 SET GMRCX=$ORDER(^GMR(123.1,"B",GMRCACTD,""))
if GMRCX
SET GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
End DoDot:1
+12 ; wtc 3/2/23 P185
FOR GMRCACTD="STATUS CHANGE","EDIT/RESUBMITTED","DISASSOCIATE RESULT","ADDENDUM ADDED TO","NEW NOTE ADDED"
Begin DoDot:1
+13 SET GMRCX=$ORDER(^GMR(123.1,"B",GMRCACTD,""))
if GMRCX
SET GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
End DoDot:1
+14 ;
+15 SET GMRCT=0
SET GMRCN="@"
FOR
SET GMRCN=$ORDER(^GMR(123,IEN,40,GMRCN),-1)
if 'GMRCN
QUIT
SET GMRCX=^(GMRCN,0)
IF $DATA(GMRCACTD($PIECE(GMRCX,U,2)))
IF $DATA(^GMR(123,IEN,40,GMRCN,1,1))
Begin DoDot:1
+16 SET GMRCIENS=GMRCN_","_IEN_","
KILL GMRCOUT
DO GETS^DIQ(123.02,GMRCIENS,"2;4;.21","IE","GMRCOUT")
+17 SET GMRCDT=$GET(GMRCOUT(123.02,GMRCIENS,2,"I"))
SET GMRCDT=$$UP^XLFSTR($$FMTE^XLFDT(GMRCOUT(123.02,GMRCIENS,2,"I"),"5PZ"))
+18 SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="NTE|1|L|Activity Type: "_GMRCACTD($PIECE(GMRCX,U,2))
+19 SET GMRCL=0
FOR
SET GMRCL=$ORDER(^GMR(123,IEN,40,GMRCN,1,GMRCL))
if 'GMRCL
QUIT
SET GMRCT=GMRCT+1
SET GMRCX=$GET(^(GMRCL,0))
SET (@GMRCNA@(GMRCT))="NTE|1|L|"_GMRCX
+20 ; P184
SET GMRCT=GMRCT+1
SET GMRCLOC=$$LOC(GMRCLOC,GMRCIENS)
SET @GMRCNA@(GMRCT)="NTE|1|L|Entered At Location: "_GMRCLOC
DO SITE
+21 SET GMRCENBY=$GET(GMRCOUT(123.02,GMRCIENS,4,"E"))
IF GMRCENBY=""
SET GMRCENBY=$PIECE($GET(GMRCOUT(123.02,GMRCIENS,.21,"E")),U)
+22 SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="NTE|1|L|Entered By: "_GMRCENBY
+23 SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="NTE|1|L|"_GMRCDT
+24 SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="NTE|1|L| "
+25 SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="NTE|1|L| "
End DoDot:1
+26 QUIT
+27 ;
CRNROBX(IEN,GMRCNA) ;If Add Comment going to Cerner, send ALL comments
+1 ;
+2 ; IEN = pointer to #123
+3 ; GMRCNA = name of array where HL7 segments are stored
+4 ;
+5 ;Output is all comments in ^TMP("GMRCMT",$J)
+6 ;
NEW GMRCACT,GMRCACTD,GMRCDT,GMRCENBY,GMRCIENS,GMRCL,GMRCLOC,GMRCN,GMRCO,GMRCT,GMRCTMP,GMRCX,LOCNAME
+7 ;
+8 ; Prepare list of consult activities that trigger generation of cumulative comments.
+9 ;
+10 ;
SET GMRCLOC=$PIECE($$SITE^VASITE,U,2)
+11 ; wtc 2/4/22
FOR GMRCACTD="ADDED COMMENT","DISCONTINUED","CANCELLED","RECEIVED","REMOTE REQUEST RECEIVED","SCHEDULED","SIG FINDING UPDATE","FORWARDED FROM","COMPLETE/UPDATE","FWD TO REMOTE SERVICE"
Begin DoDot:1
+12 SET GMRCX=$ORDER(^GMR(123.1,"B",GMRCACTD,""))
if GMRCX
SET GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
End DoDot:1
+13 ; wtc 3/2/23 P185
FOR GMRCACTD="STATUS CHANGE","EDIT/RESUBMITTED","DISASSOCIATE RESULT","ADDENDUM ADDED TO","NEW NOTE ADDED"
Begin DoDot:1
+14 SET GMRCX=$ORDER(^GMR(123.1,"B",GMRCACTD,""))
if GMRCX
SET GMRCACTD(GMRCX)=$$TITLE^XLFSTR(GMRCACTD)
End DoDot:1
+15 ;
+16 SET GMRCTMP=$NAME(^TMP("GMRCCRNRCMT",$JOB))
KILL @GMRCTMP
+17 ;
+18 ;
SET GMRCT=0
SET GMRCN="@"
+19 ;
FOR
SET GMRCN=$ORDER(^GMR(123,IEN,40,GMRCN),-1)
if 'GMRCN
QUIT
SET GMRCX=^(GMRCN,0)
IF $DATA(GMRCACTD($PIECE(GMRCX,U,2)))
Begin DoDot:1
+20 ; WTC P201 12/19/23
if '$DATA(^GMR(123,IEN,40,GMRCN,1,1))&(GMRCACTD($PIECE(GMRCX,U,2))'["Received")
QUIT
+21 SET GMRCIENS=GMRCN_","_IEN_","
KILL GMRCO
DO GETS^DIQ(123.02,GMRCIENS,"2;4;.21;.32;.33","IE","GMRCO")
+22 SET GMRCDT=$GET(GMRCO(123.02,GMRCIENS,2,"I"))
SET GMRCDT=$$UP^XLFSTR($$FMTE^XLFDT(GMRCO(123.02,GMRCIENS,2,"I"),"5PZ"))
+23 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"| ||||||P"
+24 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Activity Type: "_GMRCACTD($PIECE(GMRCX,U,2))_"||||||P"
+25 ;
+26 ; If activity is received, insert "Referral received by CPRS" as a comment. wtc p201 12/19/23
+27 ;
+28 ;
IF GMRCACTD($PIECE(GMRCX,U,2))["Received"
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Referral received by CPRS||||||P"
+29 ;
+30 ; WTC 2/4/22
KILL @GMRCTMP
DO OBXWP^GMRCISEG(IEN,"IP",GMRCN,GMRCTMP)
+31 ; WTC 6/10/22
SET GMRCL=0
FOR
SET GMRCL=$ORDER(@GMRCTMP@(GMRCL))
if 'GMRCL
QUIT
SET GMRCT=GMRCT+1
SET GMRCX=@GMRCTMP@(GMRCL)
SET $PIECE(GMRCX,"|",5)=GMRCT
SET @GMRCNA@(GMRCT)=GMRCX
+32 ;
+33 ;
IF GMRCO(123.02,GMRCIENS,.32,"I")'=1
SET GMRCT=GMRCT+1
SET (GMRCLOC,LOCNAME)=$$LOC^GMRCIEVT(GMRCLOC,GMRCIENS)
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered At Location: "_GMRCLOC_"||||||P"
+34 ;
IF GMRCO(123.02,GMRCIENS,.32,"I")=1
Begin DoDot:2
+35 ;
NEW GMRCSITE,GMRCSTDA,GMRCSTNM
SET GMRCSITE=GMRCO(123.02,GMRCIENS,.33,"I")
SET GMRCSTDA=$ORDER(^DIC(4,"D",GMRCSITE,0))
SET GMRCSTNM=$$GET1^DIQ(4,GMRCSTDA,.01)
+36 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered At Location: "_GMRCSTNM_"||||||P"
End DoDot:2
+37 SET GMRCENBY=$GET(GMRCO(123.02,GMRCIENS,4,"E"))
IF GMRCENBY=""
SET GMRCENBY=$PIECE($GET(GMRCO(123.02,GMRCIENS,.21,"E")),U)
+38 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered By: "_GMRCENBY_"||||||P"
+39 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|"_GMRCDT_"||||||P"
End DoDot:1
+40 KILL @GMRCTMP
+41 QUIT
+42 ;
LOC(GMRCLOC,GMRCIENS) ;DETERMINE LOCATION
+1 NEW LOCNAME
+2 IF '$DATA(^GMR(123,$PIECE(GMRCIENS,",",2),40,($PIECE(GMRCIENS,",",1)-1),3))
DO SITE
QUIT GMRCLOC
+3 SET LOCNAME=^GMR(123,$PIECE(GMRCIENS,",",2),40,($PIECE(GMRCIENS,",",1)-1),3)
+4 SET LOCNAME=$PIECE(LOCNAME,U,3)
+5 SET LOCNAME=$PIECE(^DIC(4,LOCNAME,0),U,1)
+6 QUIT LOCNAME
SITE ;SET LOCAL SITE
+1 SET GMRCLOC=$PIECE($$SITE^VASITE,U,2)
+2 ;
QUIT
+3 ;
