GMRCIACT ;SLC/JFR - PROCESS ACTIONS ON IFC ; Jan 27, 2025@06:03:22
;;3.0;CONSULT/REQUEST TRACKING;**22,47,58,66,73,121,154,176,184,193,185,189,201,205**;DEC 27, 1997;Build 3
;
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Reference to $$FIND1^DIC in ICR #2051
; Reference to ^DIE in ICR #2053
; Reference to ^HLMA1 in ICR #2165
; Reference to ^MPIF001 in ICR #2701
; Reference to ^XLFDT in ICR #10103
; Reference to ^XLFNAME in ICR #3065
; Reference to ^XUAF4 in ICR #2171
; Reference to ^XLFSTR in ICR #10104
; Reference to $$ADD^DGPROSAD in ICR #7421
;
Q ;don't start here!
NW(ARRAY) ;process and file new order
;Input:
; ARRAY = name of array containing message parts
;
N GMRCFDA,GMRCORC,GMRCDA,GMRCITM,GMRCITER,GMRCROUT,GMRCFCN,GMRCLAC ;
K ^TMP("GMRCIN",$J)
M ^TMP("GMRCIN",$J)=@ARRAY
S GMRCORC=^TMP("GMRCIN",$J,"ORC")
D I $D(GMRCITER) Q ;Check for order already being on file
. S GMRCFCN=+$P(GMRCORC,"|",2)
. S GMRCROUT=$$IEN^XUAF4($P($P(GMRCORC,"|",2),U,2))
. I '$O(^GMR(123,"AIFC",GMRCROUT,GMRCFCN,0)) Q ;no dup
. S GMRCITER=802
. S GMRCCRNR=$G(GMRCCRNR),GMRCMSGI=$G(GMRCMSGI) D APPACK^GMRCIAC2(0,"AR",GMRCITER,GMRCCRNR,GMRCMSGI,$NA(^TMP("GMRCIN",$J))) ;send app. ack w/ error ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
. K ^TMP("GMRCIN",$J) Q
I '$D(^TMP("GMRCIN",$J,"PID")) Q ;prepare reject message (no PID)
D ;get patient DFN from ICN in message
. N PAT,CRNRACCT ; p184
. S PAT=$$GETDFN^MPIF001(+$P(^TMP("GMRCIN",$J,"PID"),"|",2))
. I +PAT'>1 S GMRCFDA(.02)="" Q
. S GMRCFDA(.02)=+PAT
;
; Save patient account number in field #502. Below code shifted out of patient lookup so CRNRACCT set whether patient found or not. Needed for proxy add code. p189
;
S CRNRACCT=$P(^TMP("GMRCIN",$J,"PID"),"|",18),GMRCFDA(502)=CRNRACCT ; p184, 189
;
; Save ordering provider data and placer field 1 from OBR-16 and OBR-19 in fields #507 and 508
;
N OBR16,OBR19,OBR20,OBR27 ; P201 WTC 11.2.23
I $D(^TMP("GMRCIN",$J,"OBR")) D ; P184, 189
. S OBR16=$P(^("OBR"),"|",16),GMRCFDA(507)=$E(OBR16,1,255) ;
. S OBR19=$P(^("OBR"),"|",19),GMRCFDA(508)=$E(OBR19,1,255) ; 184V10 WTC 6/28/2022
. S OBR20=$P(^("OBR"),"|",20) I OBR20'="" S GMRCFDA(511)=$E(OBR20,1) ; 185V2 WTC 4/24/2023
. S OBR27=$P($P(^("OBR"),"|",27),U,4) I OBR27'="" S GMRCFDA(512)=$E(OBR27,1,30) ; 185V2 WTC 4/24/2023
;
; If patient not found and placer is Cerner, call proxy add to create patient. p189 wtc 4/12/2023
; If ICN is missing from PID segment, generate 206 error and quit processing HL7 message. p201 wtc 5/8/2024
;
I '$G(GMRCFDA(.02)),$G(CRNRACCT)'="" D Q:$G(GMRCITER)=206 ;
. ;
. ; Extract EDIPI from PID-3.
. ;
. N ICN,EDIPI,RTNCODE,PIECE ;
. S ICN=$P(^TMP("GMRCIN",$J,"PID"),"|",2) ; P201 WTC 5/6/24
. S EDIPI="" I $P($P($P(^TMP("GMRCIN",$J,"PID"),"|",3),"~",2),U,4)="EDIPI" S EDIPI=$P($P($P(^("PID"),"|",3),"~",2),U,1) ; P201 WTC 3/21/2024
. ;
. ; ICN missing. Log error 206 and stop processing HL7 message.
. ;
. I ICN="" D Q ;
.. ;
.. S GMRCITER=206 ;
.. D ERR206^GMRCIAC3($P(GMRCMSGI,U,1),EDIPI,GMRCFCN,OBR19,$$HL7TFM^XLFDT($P(GMRCORC,"|",15)),$NA(^TMP("GMRCIN",$J))) ; P205 WTC 8/22/24
.. K ^TMP("GMRCIN",$J) ;
. ;
. Q:EDIPI="" ; unlikely to happen that both ICN and EDIPI missing from Cerner order. wtc 5/8/24
. ;
. ; Call proxy add. If successful, save DFN. Otherwise, allow 201 error to be generated.
. ;
. S RTNCODE=$$ADD^DGPROSAD(EDIPI_"~USDOD~NI~200DOD",$P($$SITE^VASITE(),U,3)) ; ICR 7421
. I RTNCODE<0 D FAILPRXY^GMRCIUT1($P(GMRCMSGI,U,1),EDIPI,"",GMRCFCN,OBR19,$P(GMRCORC,"|",15),$P($$SITE^VASITE(),U,3),$P(RTNCODE,U,2)) Q ; P189 WTC 6/24/24
. S GMRCFDA(.02)=$P(RTNCODE,U,4) ;
;
I '$G(GMRCFDA(.02)) D Q ;reject message, patient is unknown
. N STA S STA=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",2),U,2)
. N OBR S OBR=^TMP("GMRCIN",$J,"OBR")
. D PTERRMSG^GMRCIERR(^TMP("GMRCIN",$J,"PID"),STA,,OBR)
. S GMRCCRNR=$G(GMRCCRNR),GMRCMSGI=$G(GMRCMSGI) D APPACK^GMRCIAC2(0,"AR",201,GMRCCRNR,GMRCMSGI,$NA(^TMP("GMRCIN",$J))) ; send app. ack w/error ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
. K ^TMP("GMRCIN",$J) Q
D ;get ordered item and service
. S GMRCITM=$P(^TMP("GMRCIN",$J,"OBR"),"|",4)
. I GMRCITM["VA1233" D ; proc
.. N PROC
.. S PROC=$$GETPROC^GMRCIUTL(GMRCITM)
.. I +PROC'>0!('$P(PROC,U,2)) S GMRCITER=$P(PROC,U,3) Q
.. S GMRCFDA(4)=$P(PROC,U)_";GMR(123.3,"
.. S GMRCFDA(1)=$P(PROC,U,2)
. I GMRCITM["VA1235" D
.. N SERV
.. S SERV=$$GETSERV^GMRCIUTL(GMRCITM) ;consult
.. I +SERV'>0 S GMRCITER=$P(SERV,U,3)
.. S GMRCFDA(1)=SERV
I $D(GMRCITER) D Q ;error in procedure or service, reject new order
. S GMRCCRNR=$G(GMRCCRNR),GMRCMSGI=$G(GMRCMSGI) D APPACK^GMRCIAC2(0,"AR",GMRCITER,GMRCCRNR,GMRCMSGI,$NA(^TMP("GMRCIN",$J))) ; send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
. K ^TMP("GMRCIN",$J) Q
;
S GMRCFDA(.01)=$$NOW^XLFDT
S GMRCFDA(3)=$$HL7TFM^XLFDT($P(GMRCORC,"|",15))
S GMRCFDA(6)=$$FIND1^DIC(101,"","X","GMRCPLACE - ON CALL")
S GMRCFDA(17)=$$HL7TFM^XLFDT($P($P(GMRCORC,"|",7),U,4)) ;WAT/66 Earliest Date
D ;get urgency to file
. N URG
. S URG=$$URG^GMRCHL7A($P($P(GMRCORC,"|",7),U,6))
. ;I GMRCCRNR,URG="STAT" S URG="NEXT AVAILABLE" ;MKN *176
. I $G(GMRCCRNR) D ; WTC p201 10/20/23
.. I URG="STAT" S URG="STAT" ;
.. I URG="ROUTINE" S URG="ROUTINE" ;
.. I URG="URGENT"!(URG="U") S URG="STAT" ;
. S GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
S GMRCFDA(8)=5
S GMRCFDA(9)=$S($P(GMRCORC,"|",16)["FI":24,1:23),GMRCLAC=GMRCFDA(9)
S GMRCFDA(14)=$P(^TMP("GMRCIN",$J,"OBR"),"|",18)
S GMRCFDA(.05)=$$IEN^XUAF4(+$P(GMRCORC,"|",17))
S GMRCFDA(.06)=GMRCFCN
S GMRCFDA(.07)=GMRCROUT
D ;get and set ordering prov info & entering person info
. N GMRCOP
. S GMRCOP=$$FMNAME^XLFNAME($P(GMRCORC,"|",12))
. Q:'$L(GMRCOP)
. S GMRCFDA(.126)=GMRCOP
. Q
S GMRCFDA(.125)="F"
I $L($P(GMRCORC,"|",14)) D
. N GMRCP14 S GMRCP14=$P(GMRCORC,"|",14)
. S GMRCFDA(.132)=$P(GMRCP14,"B") ; requestor's phone number
. S GMRCFDA(.133)=$P(GMRCP14,"B",2) ; requestor's dig pager
S GMRCFDA(13)=$S($D(GMRCFDA(4)):"P",1:"C")
I $D(^TMP("GMRCIN",$J,"OBX",2)) D
. N GMRCCSYS,CODINTXT
. S GMRCFDA(30)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,2)
. S GMRCFDA(30.1)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U)
. S GMRCFDA(30.2)=$$HL7TFM^XLFDT($P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",14),U)) ;date OBX-14 WAT/73
. S GMRCCSYS=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,3) ;code system WAT/73
. S GMRCCSYS=$S($G(GMRCCSYS)="I9C":"ICD",1:"10D")
. S GMRCFDA(30.3)=GMRCCSYS
. I $D(GMRCFDA(30.1)) D ;if dx code exists, ensure that code is removed from dx text
.. S CODINTXT="("_GMRCFDA(30.1)_")"
.. I GMRCFDA(30)[CODINTXT D
... S GMRCFDA(30)=$E(GMRCFDA(30),0,($L(GMRCFDA(30))-$L(CODINTXT)))
... S GMRCFDA(30)=$$TRIM^XLFSTR(GMRCFDA(30),"R")
;
;BL;121;Adding UCID to FILE #123 FIELD 80
;check for NTE segment
I $D(^TMP("GMRCIN",$J,"NTE")) D
. N NODE,UCIDNODE
. S NODE=0
. F S NODE=$O(^TMP("GMRCIN",$J,"NTE",NODE)) Q:NODE="" D
. . S UCIDNODE=$P(^TMP("GMRCIN",$J,"NTE",NODE),"|",2)
. . S:UCIDNODE["UCID:" GMRCFDA(80)=$P(UCIDNODE,"UCID:",2)
;
M FDA(1,123,"+1,")=GMRCFDA
D UPDATE^DIE("","FDA(1)","GMRCDA","GMRCERR")
I '$D(GMRCDA) D Q ;couldn't get new consult #
. S GMRCCRNR=$G(GMRCCRNR),GMRCMSGI=$G(GMRCMSGI) D APPACK^GMRCIAC2(0,"AR",901,GMRCCRNR,GMRCMSGI,$NA(^TMP("GMRCIN",$J))) ; send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
. K ^TMP("GMRCIN",$J) Q
K GMRCFDA,FDA
D ; file reason for request
. ;
. I $G(OBR19)'="" D ; Re-sequence reasons for request if needed. wtc 201 11.2.2023
.. N IEN S IEN=$O(^GMR(123.7,"C",$$UP^XLFSTR(OBR19),0)) I IEN D RESEQNCE^GMRCIRSN(IEN) Q ;
. ;
. ; Add FIN to reason for request for Prosthetics orders. p201 wtc 3.21.2024
. ;
. I GMRCCRNR,$G(OBR19)'="",OBR19["PROSTHETICS IFC"!(OBR19["PSAS") D ;
.. N IDX S IDX=$O(^TMP("GMRCIN",$J,"OBX",1,"A"),-1)+1,^TMP("GMRCIN",$J,"OBX",1,IDX)="1|TX|2000.02^REASON FOR REQUEST^AS4|"_IDX_"|FIN: "_CRNRACCT ;
. ;
. D TRIMWP^GMRCIUTL($NA(^TMP("GMRCIN",$J,"OBX",1)),5)
. D WP^DIE(123,GMRCDA(1)_",",20,"K",$NA(^TMP("GMRCIN",$J,"OBX",1)))
. Q
D ;file activity tracking
. N GMRCSEG
. S GMRCSEG("ORC")=GMRCORC
. S GMRCSEG("OBX",5,1)=^TMP("GMRCIN",$J,"OBX",5,1)
. D FILEACT^GMRCIAC2(GMRCDA(1),GMRCLAC,,"GMRCSEG",$G(GMRCCRNR),$G(GMRCROUT)) ; P184
D ;print SF-513
. I GMRCLAC=24 Q ;don't print if part of a FWD to IFC
. D PRNT^GMRCUTL1("",GMRCDA(1))
D ;send notifications
. I GMRCLAC=24 Q ;no alerts yet if part of FWD to IFC
. N GMRCORTX
. S GMRCORTX="New remotely ordered consult "_$$ORTX^GMRCAU(+GMRCDA(1))
. D MSG^GMRCP($P(^GMR(123,GMRCDA(1),0),U,2),GMRCORTX,GMRCDA(1),27,,1)
D ;send appl ack :-(
. N GMRCRSLT
. D RESP^GMRCIUTL("AA",HL("MID"),$P(GMRCORC,"|"),GMRCDA(1))
. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
K ^TMP("GMRCIN",$J) Q:'GMRCCRNR ;
;
; Check if patient exists on converted VistA. If not, add the entry. p189 wtc 6/24/24
;
N RTNCODE,SITE,STA ;
S SITE=$P(^GMR(123,GMRCDA(1),0),U,23) Q:'SITE ;no ROUTING FACILITY
S STA=$$STA^XUAF4(SITE) I '$L(STA) Q ;can't find station num for that site
S RTNCODE=$$CHKPROXY^GMRCIUT1(GMRCDA(1),$P(^GMR(123,GMRCDA(1),0),U,2),STA,1) ;
Q
;
DIS(GMRCAR,GMRCCRNR,GMRCMSGI) ;dis-associate a result from a remote request ; MKN GMRC*3.0*154 added GMRCCRNR and GMRCMSGI
;Input:
; GMRCAR = array name containing message
; e.g. ^TMP("GMRCIF",$J)
; GMRCCRNR = 1 if message came from Cerner
; GMRCMSGI = message ID
;
K ^TMP("GMRCID",$J) ;p193
N GMRCDA,GMRCFDA,FDA,GMRCERR,GMRCORC
M ^TMP("GMRCID",$J)=@GMRCAR
S GMRCORC=^TMP("GMRCID",$J,"ORC")
S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
S GMRCCRNR=$G(GMRCCRNR,0),GMRCMSGI=$G(GMRCMSGI) ;MKN GMRC*3*154
I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
. D APPACK^GMRCIAC2(GMRCDA,"AR",901,GMRCCRNR,GMRCMSGI,$NA(^TMP("GMRCIN",$J))) ;send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
. K ^TMP("GMRCID",$J) Q
; v--check to see if a dup transmission
I $$DUPACT^GMRCIAC2(GMRCDA,12,GMRCORC,^TMP("GMRCID",$J,"OBX",4,1),GMRCCRNR,GMRCMSGI) K ^TMP("GMRCID",$J) Q ;MKN GMRC*3*154 added CRNR and MSGI ;p193
;
D FILEACT^GMRCIAC2(GMRCDA,12,,$NA(^TMP("GMRCID",$J)),$G(GMRCCRNR),$$GET1^DIQ(123,GMRCDA,.07,"I")) ; act. tracking ; P184
D FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCID",$J,"OBX",4,1)) ;file results
K GMRCERR,FDA,GMRCFDA
I $$STSCHG^GMRCDIS(GMRCDA) S FDA(1,123,GMRCDA_",",8)=6
S FDA(1,123,GMRCDA_",",9)=12
D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and status
D ;send notifications
. I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;DIS from placer before IFC
. N GMRCORTX
. S GMRCORTX="Remote result removed from "_$$ORTX^GMRCAU(+GMRCDA)
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,63,,1)
D ;send appl ACK
. D APPACK^GMRCIAC2(GMRCDA,"AA") ; send app. ACK and unlock record
K ^TMP("GMRCID",$J)
Q
;
OTHER(GMRCAR,GMRCCRNR,GMRCMSGI) ;process most IFC actions
;will process the receive, schedule, DC, cancel and added comment action
;
;Input:
; GMRCAR = array name containing message
; e.g. ^TMP("GMRCIF",$J)
; GMRCCRNR = 1 if message came from Cerner
; GMRCMSGI = message ID
;
N GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,GMRCROL,FDA
K ^TMP("GMRCIN",$J)
M ^TMP("GMRCIN",$J)=@GMRCAR
;
S GMRCORC=^TMP("GMRCIN",$J,"ORC")
S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC) ;get ien to work on
S GMRCROL=$P(^GMR(123,GMRCDA,12),U,5)
S GMRCCRNR=$G(GMRCCRNR,0),GMRCMSGI=$G(GMRCMSGI) ;MKN GMRC*3*154
I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
. D APPACK^GMRCIAC2(GMRCDA,"AR",901,GMRCCRNR,GMRCMSGI,$NA(^TMP("GMRCIN",$J))) ; send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
. K ^TMP("GMRCIN",$J) Q
;
I $P(GMRCORC,"|")'="IP" D ; status update
. N GMRCOS S GMRCOS=$P(GMRCORC,"|",5)
. S GMRCFDA(8)=$S(GMRCOS="IP":6,GMRCOS="SC":8,GMRCOS="CA":13,1:1)
. ; IP=receive, SC=schedule, CA=cancel, DC=discontinue
D ; get last action taken
. I '$G(GMRCFDA(8)) S (GMRCFDA(9),GMRCLAT)=20 Q
. ;
. ; Set last action taken to STATUS CHANGE (3) if appointment unscheduled and filler is converted site. p205 wtc 8/20/24
. ;
. I GMRCFDA(8)=6 S (GMRCFDA(9),GMRCLAT)=21 Q:'$$CNVTD^GMRCIEVT(GMRCDA) S:$P($P(GMRCORC,"|",16),U,1)="U" (GMRCFDA(9),GMRCLAT)=3 ;
. I GMRCFDA(8)=8 S (GMRCFDA(9),GMRCLAT)=8 Q
. I GMRCFDA(8)=1 S (GMRCFDA(9),GMRCLAT)=6 Q
. I GMRCFDA(8)=13 S (GMRCFDA(9),GMRCLAT)=19 Q
; ^--last action taken
; v-- check to see if a dup transmission
I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC,,GMRCCRNR,GMRCMSGI) K ^TMP("GMRCIN",$J) Q ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
;
M FDA(1,123,GMRCDA_",")=GMRCFDA
D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and update status
K GMRCFDA
;
; Add comment that appointment has been cancelled by converted filler site. wtc p205 8/15/24
;
I $$CNVTD^GMRCIEVT(GMRCDA),$P(GMRCORC,"|")="SC",$P(GMRCORC,"|",5)="IP",GMRCLAT=3 D ;
. N OBXIDX S OBXIDX=$O(^TMP("GMRCIN",$J,"OBX",3,"A"),-1) I 'OBXIDX S OBXIDX=0 ;
. S OBXIDX=OBXIDX+1,^TMP("GMRCIN",$J,"OBX",3,OBXIDX)="3|TX|^COMMENTS^|"_OBXIDX_"|Appointment has been cancelled." ;
;
D FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NA(^TMP("GMRCIN",$J)),$G(GMRCCRNR),$$GET1^DIQ(123,GMRCDA,.07,"I")) ; P184
D ;send notifications
. N GMRCTX,GMRCNOT,GMRCFL
. S GMRCFL=1
. I GMRCLAT=20!(GMRCLAT=8)!(GMRCLAT=21) D
.. I GMRCLAT=20 D I '$D(GMRCTX) Q
... I $P(^GMR(123,GMRCDA,40,1,0),U,2)'=24 D Q
.... S GMRCTX="Comment Added to remote"
... N ACT S ACT=1
... F S ACT=$O(^GMR(123,GMRCDA,40,ACT)) Q:'ACT!($D(GMRCTX)) D
.... I $P(^GMR(123,GMRCDA,40,ACT,0),U,2)=25,$O(^GMR(123,GMRCDA,40,ACT)) D
..... S GMRCTX="Comment Added to remote"
.. I '$D(GMRCTX),GMRCROL="F" Q ;sch & rec on filler part of FWD 2 IFC
.. I GMRCLAT=8 S GMRCTX="Scheduled remote"
.. I GMRCLAT=21 S GMRCTX="Received remote"
.. S GMRCTX=GMRCTX_" Consult: "_$$ORTX^GMRCAU(+GMRCDA)
.. S GMRCNOT=63
. I GMRCLAT=6 D
.. S GMRCFL=$$DCNOTE^GMRCADC(GMRCDA,.5)
.. S GMRCTX="Discontinued remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
.. S GMRCNOT=23
. I GMRCLAT=19 D
.. I GMRCROL="F" Q ;canc on a filler is part of FWD 2 IFC
.. S GMRCTX="Cancelled remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
.. S GMRCNOT=30
. I '$D(GMRCNOT) Q ;don't send any alerts
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,GMRCNOT,,GMRCFL)
;
D ;send appl ACK
. D APPACK^GMRCIAC2(GMRCDA,"AA") ;send app. ACK and unlock record
K ^TMP("GMRCIN",$J)
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCIACT 14839 printed Sep 23, 2025@19:21:56 Page 2
GMRCIACT ;SLC/JFR - PROCESS ACTIONS ON IFC ; Jan 27, 2025@06:03:22
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,47,58,66,73,121,154,176,184,193,185,189,201,205**;DEC 27, 1997;Build 3
+2 ;
+3 ;;Per VHA Directive 2004-038, this routine should not be modified.
+4 ;
+5 ; Reference to $$FIND1^DIC in ICR #2051
+6 ; Reference to ^DIE in ICR #2053
+7 ; Reference to ^HLMA1 in ICR #2165
+8 ; Reference to ^MPIF001 in ICR #2701
+9 ; Reference to ^XLFDT in ICR #10103
+10 ; Reference to ^XLFNAME in ICR #3065
+11 ; Reference to ^XUAF4 in ICR #2171
+12 ; Reference to ^XLFSTR in ICR #10104
+13 ; Reference to $$ADD^DGPROSAD in ICR #7421
+14 ;
+15 ;don't start here!
QUIT
NW(ARRAY) ;process and file new order
+1 ;Input:
+2 ; ARRAY = name of array containing message parts
+3 ;
+4 ;
NEW GMRCFDA,GMRCORC,GMRCDA,GMRCITM,GMRCITER,GMRCROUT,GMRCFCN,GMRCLAC
+5 KILL ^TMP("GMRCIN",$JOB)
+6 MERGE ^TMP("GMRCIN",$JOB)=@ARRAY
+7 SET GMRCORC=^TMP("GMRCIN",$JOB,"ORC")
+8 ;Check for order already being on file
Begin DoDot:1
+9 SET GMRCFCN=+$PIECE(GMRCORC,"|",2)
+10 SET GMRCROUT=$$IEN^XUAF4($PIECE($PIECE(GMRCORC,"|",2),U,2))
+11 ;no dup
IF '$ORDER(^GMR(123,"AIFC",GMRCROUT,GMRCFCN,0))
QUIT
+12 SET GMRCITER=802
+13 ;send app. ack w/ error ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
SET GMRCCRNR=$GET(GMRCCRNR)
SET GMRCMSGI=$GET(GMRCMSGI)
DO APPACK^GMRCIAC2(0,"AR",GMRCITER,GMRCCRNR,GMRCMSGI,$NAME(^TMP("GMRCIN",$JOB)))
+14 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
IF $DATA(GMRCITER)
QUIT
+15 ;prepare reject message (no PID)
IF '$DATA(^TMP("GMRCIN",$JOB,"PID"))
QUIT
+16 ;get patient DFN from ICN in message
Begin DoDot:1
+17 ; p184
NEW PAT,CRNRACCT
+18 SET PAT=$$GETDFN^MPIF001(+$PIECE(^TMP("GMRCIN",$JOB,"PID"),"|",2))
+19 IF +PAT'>1
SET GMRCFDA(.02)=""
QUIT
+20 SET GMRCFDA(.02)=+PAT
End DoDot:1
+21 ;
+22 ; Save patient account number in field #502. Below code shifted out of patient lookup so CRNRACCT set whether patient found or not. Needed for proxy add code. p189
+23 ;
+24 ; p184, 189
SET CRNRACCT=$PIECE(^TMP("GMRCIN",$JOB,"PID"),"|",18)
SET GMRCFDA(502)=CRNRACCT
+25 ;
+26 ; Save ordering provider data and placer field 1 from OBR-16 and OBR-19 in fields #507 and 508
+27 ;
+28 ; P201 WTC 11.2.23
NEW OBR16,OBR19,OBR20,OBR27
+29 ; P184, 189
IF $DATA(^TMP("GMRCIN",$JOB,"OBR"))
Begin DoDot:1
+30 ;
SET OBR16=$PIECE(^("OBR"),"|",16)
SET GMRCFDA(507)=$EXTRACT(OBR16,1,255)
+31 ; 184V10 WTC 6/28/2022
SET OBR19=$PIECE(^("OBR"),"|",19)
SET GMRCFDA(508)=$EXTRACT(OBR19,1,255)
+32 ; 185V2 WTC 4/24/2023
SET OBR20=$PIECE(^("OBR"),"|",20)
IF OBR20'=""
SET GMRCFDA(511)=$EXTRACT(OBR20,1)
+33 ; 185V2 WTC 4/24/2023
SET OBR27=$PIECE($PIECE(^("OBR"),"|",27),U,4)
IF OBR27'=""
SET GMRCFDA(512)=$EXTRACT(OBR27,1,30)
End DoDot:1
+34 ;
+35 ; If patient not found and placer is Cerner, call proxy add to create patient. p189 wtc 4/12/2023
+36 ; If ICN is missing from PID segment, generate 206 error and quit processing HL7 message. p201 wtc 5/8/2024
+37 ;
+38 ;
IF '$GET(GMRCFDA(.02))
IF $GET(CRNRACCT)'=""
Begin DoDot:1
+39 ;
+40 ; Extract EDIPI from PID-3.
+41 ;
+42 ;
NEW ICN,EDIPI,RTNCODE,PIECE
+43 ; P201 WTC 5/6/24
SET ICN=$PIECE(^TMP("GMRCIN",$JOB,"PID"),"|",2)
+44 ; P201 WTC 3/21/2024
SET EDIPI=""
IF $PIECE($PIECE($PIECE(^TMP("GMRCIN",$JOB,"PID"),"|",3),"~",2),U,4)="EDIPI"
SET EDIPI=$PIECE($PIECE($PIECE(^("PID"),"|",3),"~",2),U,1)
+45 ;
+46 ; ICN missing. Log error 206 and stop processing HL7 message.
+47 ;
+48 ;
IF ICN=""
Begin DoDot:2
+49 ;
+50 ;
SET GMRCITER=206
+51 ; P205 WTC 8/22/24
DO ERR206^GMRCIAC3($PIECE(GMRCMSGI,U,1),EDIPI,GMRCFCN,OBR19,$$HL7TFM^XLFDT($PIECE(GMRCORC,"|",15)),$NAME(^TMP("GMRCIN",$JOB)))
+52 ;
KILL ^TMP("GMRCIN",$JOB)
End DoDot:2
QUIT
+53 ;
+54 ; unlikely to happen that both ICN and EDIPI missing from Cerner order. wtc 5/8/24
if EDIPI=""
QUIT
+55 ;
+56 ; Call proxy add. If successful, save DFN. Otherwise, allow 201 error to be generated.
+57 ;
+58 ; ICR 7421
SET RTNCODE=$$ADD^DGPROSAD(EDIPI_"~USDOD~NI~200DOD",$PIECE($$SITE^VASITE(),U,3))
+59 ; P189 WTC 6/24/24
IF RTNCODE<0
DO FAILPRXY^GMRCIUT1($PIECE(GMRCMSGI,U,1),EDIPI,"",GMRCFCN,OBR19,$PIECE(GMRCORC,"|",15),$PIECE($$SITE^VASITE(),U,3),$PIECE(RTNCODE,U,2))
QUIT
+60 ;
SET GMRCFDA(.02)=$PIECE(RTNCODE,U,4)
End DoDot:1
if $GET(GMRCITER)=206
QUIT
+61 ;
+62 ;reject message, patient is unknown
IF '$GET(GMRCFDA(.02))
Begin DoDot:1
+63 NEW STA
SET STA=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"ORC"),"|",2),U,2)
+64 NEW OBR
SET OBR=^TMP("GMRCIN",$JOB,"OBR")
+65 DO PTERRMSG^GMRCIERR(^TMP("GMRCIN",$JOB,"PID"),STA,,OBR)
+66 ; send app. ack w/error ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
SET GMRCCRNR=$GET(GMRCCRNR)
SET GMRCMSGI=$GET(GMRCMSGI)
DO APPACK^GMRCIAC2(0,"AR",201,GMRCCRNR,GMRCMSGI,$NAME(^TMP("GMRCIN",$JOB)))
+67 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+68 ;get ordered item and service
Begin DoDot:1
+69 SET GMRCITM=$PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",4)
+70 ; proc
IF GMRCITM["VA1233"
Begin DoDot:2
+71 NEW PROC
+72 SET PROC=$$GETPROC^GMRCIUTL(GMRCITM)
+73 IF +PROC'>0!('$PIECE(PROC,U,2))
SET GMRCITER=$PIECE(PROC,U,3)
QUIT
+74 SET GMRCFDA(4)=$PIECE(PROC,U)_";GMR(123.3,"
+75 SET GMRCFDA(1)=$PIECE(PROC,U,2)
End DoDot:2
+76 IF GMRCITM["VA1235"
Begin DoDot:2
+77 NEW SERV
+78 ;consult
SET SERV=$$GETSERV^GMRCIUTL(GMRCITM)
+79 IF +SERV'>0
SET GMRCITER=$PIECE(SERV,U,3)
+80 SET GMRCFDA(1)=SERV
End DoDot:2
End DoDot:1
+81 ;error in procedure or service, reject new order
IF $DATA(GMRCITER)
Begin DoDot:1
+82 ; send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
SET GMRCCRNR=$GET(GMRCCRNR)
SET GMRCMSGI=$GET(GMRCMSGI)
DO APPACK^GMRCIAC2(0,"AR",GMRCITER,GMRCCRNR,GMRCMSGI,$NAME(^TMP("GMRCIN",$JOB)))
+83 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+84 ;
+85 SET GMRCFDA(.01)=$$NOW^XLFDT
+86 SET GMRCFDA(3)=$$HL7TFM^XLFDT($PIECE(GMRCORC,"|",15))
+87 SET GMRCFDA(6)=$$FIND1^DIC(101,"","X","GMRCPLACE - ON CALL")
+88 ;WAT/66 Earliest Date
SET GMRCFDA(17)=$$HL7TFM^XLFDT($PIECE($PIECE(GMRCORC,"|",7),U,4))
+89 ;get urgency to file
Begin DoDot:1
+90 NEW URG
+91 SET URG=$$URG^GMRCHL7A($PIECE($PIECE(GMRCORC,"|",7),U,6))
+92 ;I GMRCCRNR,URG="STAT" S URG="NEXT AVAILABLE" ;MKN *176
+93 ; WTC p201 10/20/23
IF $GET(GMRCCRNR)
Begin DoDot:2
+94 ;
IF URG="STAT"
SET URG="STAT"
+95 ;
IF URG="ROUTINE"
SET URG="ROUTINE"
+96 ;
IF URG="URGENT"!(URG="U")
SET URG="STAT"
End DoDot:2
+97 SET GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
End DoDot:1
+98 SET GMRCFDA(8)=5
+99 SET GMRCFDA(9)=$SELECT($PIECE(GMRCORC,"|",16)["FI":24,1:23)
SET GMRCLAC=GMRCFDA(9)
+100 SET GMRCFDA(14)=$PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",18)
+101 SET GMRCFDA(.05)=$$IEN^XUAF4(+$PIECE(GMRCORC,"|",17))
+102 SET GMRCFDA(.06)=GMRCFCN
+103 SET GMRCFDA(.07)=GMRCROUT
+104 ;get and set ordering prov info & entering person info
Begin DoDot:1
+105 NEW GMRCOP
+106 SET GMRCOP=$$FMNAME^XLFNAME($PIECE(GMRCORC,"|",12))
+107 if '$LENGTH(GMRCOP)
QUIT
+108 SET GMRCFDA(.126)=GMRCOP
+109 QUIT
End DoDot:1
+110 SET GMRCFDA(.125)="F"
+111 IF $LENGTH($PIECE(GMRCORC,"|",14))
Begin DoDot:1
+112 NEW GMRCP14
SET GMRCP14=$PIECE(GMRCORC,"|",14)
+113 ; requestor's phone number
SET GMRCFDA(.132)=$PIECE(GMRCP14,"B")
+114 ; requestor's dig pager
SET GMRCFDA(.133)=$PIECE(GMRCP14,"B",2)
End DoDot:1
+115 SET GMRCFDA(13)=$SELECT($DATA(GMRCFDA(4)):"P",1:"C")
+116 IF $DATA(^TMP("GMRCIN",$JOB,"OBX",2))
Begin DoDot:1
+117 NEW GMRCCSYS,CODINTXT
+118 SET GMRCFDA(30)=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U,2)
+119 SET GMRCFDA(30.1)=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U)
+120 ;date OBX-14 WAT/73
SET GMRCFDA(30.2)=$$HL7TFM^XLFDT($PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",14),U))
+121 ;code system WAT/73
SET GMRCCSYS=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U,3)
+122 SET GMRCCSYS=$SELECT($GET(GMRCCSYS)="I9C":"ICD",1:"10D")
+123 SET GMRCFDA(30.3)=GMRCCSYS
+124 ;if dx code exists, ensure that code is removed from dx text
IF $DATA(GMRCFDA(30.1))
Begin DoDot:2
+125 SET CODINTXT="("_GMRCFDA(30.1)_")"
+126 IF GMRCFDA(30)[CODINTXT
Begin DoDot:3
+127 SET GMRCFDA(30)=$EXTRACT(GMRCFDA(30),0,($LENGTH(GMRCFDA(30))-$LENGTH(CODINTXT)))
+128 SET GMRCFDA(30)=$$TRIM^XLFSTR(GMRCFDA(30),"R")
End DoDot:3
End DoDot:2
End DoDot:1
+129 ;
+130 ;BL;121;Adding UCID to FILE #123 FIELD 80
+131 ;check for NTE segment
+132 IF $DATA(^TMP("GMRCIN",$JOB,"NTE"))
Begin DoDot:1
+133 NEW NODE,UCIDNODE
+134 SET NODE=0
+135 FOR
SET NODE=$ORDER(^TMP("GMRCIN",$JOB,"NTE",NODE))
if NODE=""
QUIT
Begin DoDot:2
+136 SET UCIDNODE=$PIECE(^TMP("GMRCIN",$JOB,"NTE",NODE),"|",2)
+137 if UCIDNODE["UCID
SET GMRCFDA(80)=$PIECE(UCIDNODE,"UCID:",2)
End DoDot:2
End DoDot:1
+138 ;
+139 MERGE FDA(1,123,"+1,")=GMRCFDA
+140 DO UPDATE^DIE("","FDA(1)","GMRCDA","GMRCERR")
+141 ;couldn't get new consult #
IF '$DATA(GMRCDA)
Begin DoDot:1
+142 ; send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
SET GMRCCRNR=$GET(GMRCCRNR)
SET GMRCMSGI=$GET(GMRCMSGI)
DO APPACK^GMRCIAC2(0,"AR",901,GMRCCRNR,GMRCMSGI,$NAME(^TMP("GMRCIN",$JOB)))
+143 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+144 KILL GMRCFDA,FDA
+145 ; file reason for request
Begin DoDot:1
+146 ;
+147 ; Re-sequence reasons for request if needed. wtc 201 11.2.2023
IF $GET(OBR19)'=""
Begin DoDot:2
+148 ;
NEW IEN
SET IEN=$ORDER(^GMR(123.7,"C",$$UP^XLFSTR(OBR19),0))
IF IEN
DO RESEQNCE^GMRCIRSN(IEN)
QUIT
End DoDot:2
+149 ;
+150 ; Add FIN to reason for request for Prosthetics orders. p201 wtc 3.21.2024
+151 ;
+152 ;
IF GMRCCRNR
IF $GET(OBR19)'=""
IF OBR19["PROSTHETICS IFC"!(OBR19["PSAS")
Begin DoDot:2
+153 ;
NEW IDX
SET IDX=$ORDER(^TMP("GMRCIN",$JOB,"OBX",1,"A"),-1)+1
SET ^TMP("GMRCIN",$JOB,"OBX",1,IDX)="1|TX|2000.02^REASON FOR REQUEST^AS4|"_IDX_"|FIN: "_CRNRACCT
End DoDot:2
+154 ;
+155 DO TRIMWP^GMRCIUTL($NAME(^TMP("GMRCIN",$JOB,"OBX",1)),5)
+156 DO WP^DIE(123,GMRCDA(1)_",",20,"K",$NAME(^TMP("GMRCIN",$JOB,"OBX",1)))
+157 QUIT
End DoDot:1
+158 ;file activity tracking
Begin DoDot:1
+159 NEW GMRCSEG
+160 SET GMRCSEG("ORC")=GMRCORC
+161 SET GMRCSEG("OBX",5,1)=^TMP("GMRCIN",$JOB,"OBX",5,1)
+162 ; P184
DO FILEACT^GMRCIAC2(GMRCDA(1),GMRCLAC,,"GMRCSEG",$GET(GMRCCRNR),$GET(GMRCROUT))
End DoDot:1
+163 ;print SF-513
Begin DoDot:1
+164 ;don't print if part of a FWD to IFC
IF GMRCLAC=24
QUIT
+165 DO PRNT^GMRCUTL1("",GMRCDA(1))
End DoDot:1
+166 ;send notifications
Begin DoDot:1
+167 ;no alerts yet if part of FWD to IFC
IF GMRCLAC=24
QUIT
+168 NEW GMRCORTX
+169 SET GMRCORTX="New remotely ordered consult "_$$ORTX^GMRCAU(+GMRCDA(1))
+170 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA(1),0),U,2),GMRCORTX,GMRCDA(1),27,,1)
End DoDot:1
+171 ;send appl ack :-(
Begin DoDot:1
+172 NEW GMRCRSLT
+173 DO RESP^GMRCIUTL("AA",HL("MID"),$PIECE(GMRCORC,"|"),GMRCDA(1))
+174 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
End DoDot:1
+175 ;
KILL ^TMP("GMRCIN",$JOB)
if 'GMRCCRNR
QUIT
+176 ;
+177 ; Check if patient exists on converted VistA. If not, add the entry. p189 wtc 6/24/24
+178 ;
+179 ;
NEW RTNCODE,SITE,STA
+180 ;no ROUTING FACILITY
SET SITE=$PIECE(^GMR(123,GMRCDA(1),0),U,23)
if 'SITE
QUIT
+181 ;can't find station num for that site
SET STA=$$STA^XUAF4(SITE)
IF '$LENGTH(STA)
QUIT
+182 ;
SET RTNCODE=$$CHKPROXY^GMRCIUT1(GMRCDA(1),$PIECE(^GMR(123,GMRCDA(1),0),U,2),STA,1)
+183 QUIT
+184 ;
DIS(GMRCAR,GMRCCRNR,GMRCMSGI) ;dis-associate a result from a remote request ; MKN GMRC*3.0*154 added GMRCCRNR and GMRCMSGI
+1 ;Input:
+2 ; GMRCAR = array name containing message
+3 ; e.g. ^TMP("GMRCIF",$J)
+4 ; GMRCCRNR = 1 if message came from Cerner
+5 ; GMRCMSGI = message ID
+6 ;
+7 ;p193
KILL ^TMP("GMRCID",$JOB)
+8 NEW GMRCDA,GMRCFDA,FDA,GMRCERR,GMRCORC
+9 MERGE ^TMP("GMRCID",$JOB)=@GMRCAR
+10 SET GMRCORC=^TMP("GMRCID",$JOB,"ORC")
+11 SET GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
+12 ;MKN GMRC*3*154
SET GMRCCRNR=$GET(GMRCCRNR,0)
SET GMRCMSGI=$GET(GMRCMSGI)
+13 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+14 ;send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
DO APPACK^GMRCIAC2(GMRCDA,"AR",901,GMRCCRNR,GMRCMSGI,$NAME(^TMP("GMRCIN",$JOB)))
+15 KILL ^TMP("GMRCID",$JOB)
QUIT
End DoDot:1
QUIT
+16 ; v--check to see if a dup transmission
+17 ;MKN GMRC*3*154 added CRNR and MSGI ;p193
IF $$DUPACT^GMRCIAC2(GMRCDA,12,GMRCORC,^TMP("GMRCID",$JOB,"OBX",4,1),GMRCCRNR,GMRCMSGI)
KILL ^TMP("GMRCID",$JOB)
QUIT
+18 ;
+19 ; act. tracking ; P184
DO FILEACT^GMRCIAC2(GMRCDA,12,,$NAME(^TMP("GMRCID",$JOB)),$GET(GMRCCRNR),$$GET1^DIQ(123,GMRCDA,.07,"I"))
+20 ;file results
DO FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCID",$JOB,"OBX",4,1))
+21 KILL GMRCERR,FDA,GMRCFDA
+22 IF $$STSCHG^GMRCDIS(GMRCDA)
SET FDA(1,123,GMRCDA_",",8)=6
+23 SET FDA(1,123,GMRCDA_",",9)=12
+24 ;file last action and status
DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+25 ;send notifications
Begin DoDot:1
+26 ;DIS from placer before IFC
IF $PIECE(^GMR(123,GMRCDA,12),U,5)="F"
QUIT
+27 NEW GMRCORTX
+28 SET GMRCORTX="Remote result removed from "_$$ORTX^GMRCAU(+GMRCDA)
+29 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,63,,1)
End DoDot:1
+30 ;send appl ACK
Begin DoDot:1
+31 ; send app. ACK and unlock record
DO APPACK^GMRCIAC2(GMRCDA,"AA")
End DoDot:1
+32 KILL ^TMP("GMRCID",$JOB)
+33 QUIT
+34 ;
OTHER(GMRCAR,GMRCCRNR,GMRCMSGI) ;process most IFC actions
+1 ;will process the receive, schedule, DC, cancel and added comment action
+2 ;
+3 ;Input:
+4 ; GMRCAR = array name containing message
+5 ; e.g. ^TMP("GMRCIF",$J)
+6 ; GMRCCRNR = 1 if message came from Cerner
+7 ; GMRCMSGI = message ID
+8 ;
+9 NEW GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,GMRCROL,FDA
+10 KILL ^TMP("GMRCIN",$JOB)
+11 MERGE ^TMP("GMRCIN",$JOB)=@GMRCAR
+12 ;
+13 SET GMRCORC=^TMP("GMRCIN",$JOB,"ORC")
+14 ;get ien to work on
SET GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
+15 SET GMRCROL=$PIECE(^GMR(123,GMRCDA,12),U,5)
+16 ;MKN GMRC*3*154
SET GMRCCRNR=$GET(GMRCCRNR,0)
SET GMRCMSGI=$GET(GMRCMSGI)
+17 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+18 ; send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
DO APPACK^GMRCIAC2(GMRCDA,"AR",901,GMRCCRNR,GMRCMSGI,$NAME(^TMP("GMRCIN",$JOB)))
+19 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+20 ;
+21 ; status update
IF $PIECE(GMRCORC,"|")'="IP"
Begin DoDot:1
+22 NEW GMRCOS
SET GMRCOS=$PIECE(GMRCORC,"|",5)
+23 SET GMRCFDA(8)=$SELECT(GMRCOS="IP":6,GMRCOS="SC":8,GMRCOS="CA":13,1:1)
+24 ; IP=receive, SC=schedule, CA=cancel, DC=discontinue
End DoDot:1
+25 ; get last action taken
Begin DoDot:1
+26 IF '$GET(GMRCFDA(8))
SET (GMRCFDA(9),GMRCLAT)=20
QUIT
+27 ;
+28 ; Set last action taken to STATUS CHANGE (3) if appointment unscheduled and filler is converted site. p205 wtc 8/20/24
+29 ;
+30 ;
IF GMRCFDA(8)=6
SET (GMRCFDA(9),GMRCLAT)=21
if '$$CNVTD^GMRCIEVT(GMRCDA)
QUIT
if $PIECE($PIECE(GMRCORC,"|",16),U,1)="U"
SET (GMRCFDA(9),GMRCLAT)=3
+31 IF GMRCFDA(8)=8
SET (GMRCFDA(9),GMRCLAT)=8
QUIT
+32 IF GMRCFDA(8)=1
SET (GMRCFDA(9),GMRCLAT)=6
QUIT
+33 IF GMRCFDA(8)=13
SET (GMRCFDA(9),GMRCLAT)=19
QUIT
End DoDot:1
+34 ; ^--last action taken
+35 ; v-- check to see if a dup transmission
+36 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
IF $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC,,GMRCCRNR,GMRCMSGI)
KILL ^TMP("GMRCIN",$JOB)
QUIT
+37 ;
+38 MERGE FDA(1,123,GMRCDA_",")=GMRCFDA
+39 ;file last action and update status
DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+40 KILL GMRCFDA
+41 ;
+42 ; Add comment that appointment has been cancelled by converted filler site. wtc p205 8/15/24
+43 ;
+44 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)
IF $PIECE(GMRCORC,"|")="SC"
IF $PIECE(GMRCORC,"|",5)="IP"
IF GMRCLAT=3
Begin DoDot:1
+45 ;
NEW OBXIDX
SET OBXIDX=$ORDER(^TMP("GMRCIN",$JOB,"OBX",3,"A"),-1)
IF 'OBXIDX
SET OBXIDX=0
+46 ;
SET OBXIDX=OBXIDX+1
SET ^TMP("GMRCIN",$JOB,"OBX",3,OBXIDX)="3|TX|^COMMENTS^|"_OBXIDX_"|Appointment has been cancelled."
End DoDot:1
+47 ;
+48 ; P184
DO FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NAME(^TMP("GMRCIN",$JOB)),$GET(GMRCCRNR),$$GET1^DIQ(123,GMRCDA,.07,"I"))
+49 ;send notifications
Begin DoDot:1
+50 NEW GMRCTX,GMRCNOT,GMRCFL
+51 SET GMRCFL=1
+52 IF GMRCLAT=20!(GMRCLAT=8)!(GMRCLAT=21)
Begin DoDot:2
+53 IF GMRCLAT=20
Begin DoDot:3
+54 IF $PIECE(^GMR(123,GMRCDA,40,1,0),U,2)'=24
Begin DoDot:4
+55 SET GMRCTX="Comment Added to remote"
End DoDot:4
QUIT
+56 NEW ACT
SET ACT=1
+57 FOR
SET ACT=$ORDER(^GMR(123,GMRCDA,40,ACT))
if 'ACT!($DATA(GMRCTX))
QUIT
Begin DoDot:4
+58 IF $PIECE(^GMR(123,GMRCDA,40,ACT,0),U,2)=25
IF $ORDER(^GMR(123,GMRCDA,40,ACT))
Begin DoDot:5
+59 SET GMRCTX="Comment Added to remote"
End DoDot:5
End DoDot:4
End DoDot:3
IF '$DATA(GMRCTX)
QUIT
+60 ;sch & rec on filler part of FWD 2 IFC
IF '$DATA(GMRCTX)
IF GMRCROL="F"
QUIT
+61 IF GMRCLAT=8
SET GMRCTX="Scheduled remote"
+62 IF GMRCLAT=21
SET GMRCTX="Received remote"
+63 SET GMRCTX=GMRCTX_" Consult: "_$$ORTX^GMRCAU(+GMRCDA)
+64 SET GMRCNOT=63
End DoDot:2
+65 IF GMRCLAT=6
Begin DoDot:2
+66 SET GMRCFL=$$DCNOTE^GMRCADC(GMRCDA,.5)
+67 SET GMRCTX="Discontinued remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
+68 SET GMRCNOT=23
End DoDot:2
+69 IF GMRCLAT=19
Begin DoDot:2
+70 ;canc on a filler is part of FWD 2 IFC
IF GMRCROL="F"
QUIT
+71 SET GMRCTX="Cancelled remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
+72 SET GMRCNOT=30
End DoDot:2
+73 ;don't send any alerts
IF '$DATA(GMRCNOT)
QUIT
+74 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,GMRCNOT,,GMRCFL)
End DoDot:1
+75 ;
+76 ;send appl ACK
Begin DoDot:1
+77 ;send app. ACK and unlock record
DO APPACK^GMRCIAC2(GMRCDA,"AA")
End DoDot:1
+78 KILL ^TMP("GMRCIN",$JOB)
+79 ;
QUIT
+80 ;
