GMRCIAC1 ;SLC/JFR - FILE IFC ACTIVITIES cont'd ; Jan 27, 2025@06:02:32
;;3.0;CONSULT/REQUEST TRACKING;**22,66,73,154,193,201,205**;DEC 27, 1997;Build 3
;
; Reference to $$FIND1^DIC in ICR #2051
; Reference to ^DIE in ICR #2053
; Reference to ^XLFSTR in ICR #10104
; Reference to ^DD(123 in ICR #4605
;
Q
COMP(GMRCAR,GMRCCRNR,GMRCMSGI) ;process partial result, clin complete and admin complete ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
;
K ^TMP("GMRCIN",$J) ;p193
N GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,FDA
N GMRCRES,GMRCERR,GMRCSTS,GMRCREAS
M ^TMP("GMRCIN",$J)=@GMRCAR
S GMRCORC=^TMP("GMRCIN",$J,"ORC")
S GMRCREAS=$P($P(GMRCORC,"|",16),U)
S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
S GMRCSTS=$P(^GMR(123,GMRCDA,0),U,12)
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
;
S GMRCFDA(8)=$S($P(GMRCORC,"|",5)="CM":2,GMRCSTS=2:2,1:9) ;comp or pr
S GMRCLAT=$S($P(GMRCORC,"|",5)="A":9,GMRCREAS="A":13,1:10)
S GMRCFDA(9)=GMRCLAT ;complete/upd or incomplete rpt
I $D(^TMP("GMRCIN",$J,"OBX",6,1)) D
. S GMRCFDA(15)=$P(^TMP("GMRCIN",$J,"OBX",6,1),"|",5)
; v-- check to see if a duplicate transmission
I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC,$S(GMRCLAT=13:"",1:$G(^TMP("GMRCIN",$J,"OBX",4,1))),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 status
; check GMRCERR and act if error
K GMRCERR
K GMRCFDA,FDA
D FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NA(^TMP("GMRCIN",$J)))
; ^--- file result and activities
I $D(^TMP("GMRCIN",$J,"OBX",4,1)) D ;file result if there
. I GMRCLAT=13 Q ; addendum carries the result that it's addending
. I GMRCLAT=9 Q ; don't file result on inc. report
. I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;no comp coming from placer
. D FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCIN",$J,"OBX",4,1))
D ;send notifications
. I GMRCLAT=9 Q
. I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;filler only gets historical comp
. N GMRCORTX S GMRCORTX=""
. I $O(^GMR(123,GMRCDA,51," "),-1)>1 D
.. S GMRCORTX="New remote result added to "
. I GMRCLAT=13 S GMRCORTX="Addendum added to "
. S GMRCORTX=GMRCORTX_"Remote Complete Consult: "_$$ORTX^GMRCAU(+GMRCDA)
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
D ;send appl ACK
. D APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI) ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
;
K ^TMP("GMRCIN",$J)
Q
;
FWD(GMRCAR,GMRCCRNR,GMRCMSGI) ;file forward action from a remote site ;MKN GMRC*3*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("GMRCIN",$J) ;p193
N GMRCFDA,GMRCDA,GMRCFWSR,GMRCFROM,GMRCORC,GMRCTIFC,GMRCLAC,GMRCROL
M ^TMP("GMRCIN",$J)=@GMRCAR
I '$D(^TMP("GMRCIN",$J,"OBR")) K ^TMP("GMRCIN",$J) Q ;p193
S GMRCORC=^TMP("GMRCIN",$J,"ORC")
S GMRCTIFC=$S($P($P(GMRCORC,"|",16),U)="F":0,1:1)
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("GMRCIN",$J) Q
S GMRCROL=$P(^GMR(123,GMRCDA,12),U,5)
I 'GMRCTIFC D
. S GMRCFDA(9)=17,GMRCLAC=17
. I GMRCROL="F" D Q
.. S GMRCFROM=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
. S GMRCFDA(.131)=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
. S GMRCFROM=$P($G(^GMR(123,GMRCDA,13)),U)
I GMRCTIFC D
. S GMRCFROM=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
. S GMRCFDA(9)=25,GMRCLAC=25
;
S GMRCFDA(8)=5
D ;get urgency to file
. N URG
. S URG=$$URG^GMRCHL7A($P($P(^TMP("GMRCIN",$J,"ORC"),"|",7),U,6))
. S GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
; v-- chk to see if activity is a dup transmission
I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCORC,,GMRCCRNR,GMRCMSGI) K ^TMP("GMRCIN",$J) Q ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
; GMRCMSGI = message ID
;
;
M FDA(1,123,GMRCDA_",")=GMRCFDA
D UPDATE^DIE("","FDA(1)",,"GMRCERR")
K GMRCFDA
;
; file activity tracking
D FILEACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCFROM,$NA(^TMP("GMRCIN",$J)))
;
; send alerts
I GMRCROL="F" D
. I GMRCLAC'=25 Q ; filler alerts only on FWD 2 IFC
. N GMRCTX
. S GMRCTX="New remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,27,,1)
. Q
I GMRCROL="P" D
. N GMRCTX
. S GMRCTX="Updated Remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,63,,1)
. Q
;
; print if FWD to IFC
I GMRCROL="F" D
. I GMRCLAC'=25 Q
. D PRNT^GMRCUTL1("",GMRCDA)
;
D ;send app. ACK and unlock record
. D APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI) ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
K ^TMP("GMRCIN",$J)
Q
;
SF(GMRCAR,GMRCCRNR,GMRCMSGI) ;add significant findings ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
; Input:
; GMRCAR = array name containing message
; e.g. ^TMP("GMRCIF",$J)
;
K ^TMP("GMRCIS",$J) ;p193
N FDA,GMRCERR,GMRCOSF,GMRCISF
M ^TMP("GMRCIS",$J)=@GMRCAR
I '$D(^TMP("GMRCIS",$J,"OBX",6,1)) K ^TMP("GMRCIS",$J) Q ;no SF flag sent ;-( ;p193
S GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIS",$J,"ORC"))
I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
. D APPACK^GMRCIAC2(GMRCDA,"AR",901,GMRCCRNR,GMRCMSGI,$NA(^TMP("GMRCIS",$J))) ;send app. ACK ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI. P205 WTC 8/22/24
. K ^TMP("GMRCIS",$J) Q ;p193 typo
;
S GMRCCRNR=$G(GMRCCRNR,0),GMRCMSGI=$G(GMRCMSGI) ;MKN GMRC*3*154
S GMRCOSF=$P(^GMR(123,GMRCDA,0),U,19)
S GMRCISF=$P(^TMP("GMRCIS",$J,"OBX",6,1),"|",5)
S FDA(1,123,GMRCDA_",",15)=GMRCISF
S FDA(1,123,GMRCDA_",",9)=4
; v-- quit if a duplicate activity
I $$DUPACT^GMRCIAC2(GMRCDA,4,^TMP("GMRCIS",$J,"ORC"),,GMRCCRNR,GMRCMSGI) K ^TMP("GMRCIS",$J) Q ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
;
D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and SF
D FILEACT^GMRCIAC2(GMRCDA,4,,$NA(^TMP("GMRCIS",$J))) ;activity track
D ;send notifications
. I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;filler only gets hist. SF
. N GMRCORTX
. S GMRCORTX=$S(GMRCISF="N":"No ",GMRCISF="Y":"",1:"Unknown ")
. S GMRCORTX=GMRCORTX_"Sig Findings for "_$$ORTX^GMRCAU(+GMRCDA)
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
D ;send appl ACK and unlock record
. D APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI) ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
K ^TMP("GMRCIS",$J)
Q
;
RESUB(GMRCAR,GMRCCRNR,GMRCMSGI) ;resubmit a cancelled, remote consult ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
; Input:
; GMRCAR - array name containing message
; e.g. ^TMP("GMRCIF",$J)
;
K ^TMP("GMRCIN",$J)
M ^TMP("GMRCIN",$J)=@GMRCAR
N GMRCDA,GMRCFDA,FDA
S GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIN",$J,"ORC"))
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
;
S GMRCFDA(8)=5,GMRCFDA(9)=11 ;status and last action
S GMRCCRNR=$G(GMRCCRNR,0),GMRCMSGI=$G(GMRCMSGI) ;MKN GMRC*3*154
;
N OBR19 ; P201 WTC 11.2.23
I $D(^TMP("GMRCIN",$J,"OBR")) D ; has INPATIENT or OUTPATIENT changed?
. N GMRCION
. S GMRCION=$P(^TMP("GMRCIN",$J,"OBR"),"|",18)
. I GMRCION'=$P(^GMR(123,GMRCDA,0),U,18) S GMRCFDA(14)=GMRCION
. S OBR19=$P(^TMP("GMRCIN",$J,"OBR"),"|",19) ; P201 WTC 11/2/2023
. Q
D ; check for change in urgency
. N GMRCURG
. S GMRCURG=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",7),U,6)
. I '$L(GMRCURG) Q
. S GMRCURG=$$URG^GMRCHL7A(GMRCURG)
. S GMRCURG=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_GMRCURG)
. I GMRCURG'>1 Q
. I GMRCURG=$P(^GMR(123,GMRCDA,0),U,9) Q ;no change
. S GMRCFDA(5)=GMRCURG
. Q
D ;check for change earliest date WAT/66
. N GMRCERDT
. S GMRCERDT=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",7),U,4)
. I '$L(GMRCERDT) Q
. S GMRCERDT=$$FMDATE^GMRCHL7(GMRCERDT)
. I GMRCERDT=$P(^GMR(123,GMRCDA,0),U,24) Q ;no change
. S GMRCFDA(17)=GMRCERDT
. Q
I $D(^TMP("GMRCIN",$J,"OBX",2)) D ; change in Prov. DX?
. N PROVDX,GMRCDXDT,GMRCCSYS,CODINTXT
. S PROVDX=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,2)
. S GMRCDXDT=$P(^TMP("GMRCIN",$J,"OBX",2,1),"|",14) S GMRCDXDT=$$HL7TFM^XLFDT($G(GMRCDXDT))
. S GMRCCSYS=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,3)
. S GMRCCSYS=$S($G(GMRCCSYS)="I9C":"ICD",1:"10D")
. I '$L(PROVDX) Q
. I PROVDX'=$G(^GMR(123,GMRCDA,30)) D
.. S GMRCFDA(30)=PROVDX
.. S GMRCFDA(30.1)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U),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")
. I $G(GMRCDXDT)'=""&($G(GMRCDXDT)'=$P($G(^GMR(123,GMRCDA,30.1)),U,2)) D
.. S:$D(^DD(123,30.2,0)) GMRCFDA(30.2)=$G(GMRCDXDT)
. I $G(GMRCCSYS)'=$P($G(^GMR(123,GMRCDA,30.1)),U,3) D
.. S:$D(^DD(123,30.3,0)) GMRCFDA(30.3)=$G(GMRCCSYS)
. Q
; v-- QUIT if a duplicate transmission
I $$DUPACT^GMRCIAC2(GMRCDA,11,^TMP("GMRCIN",$J,"ORC"),,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 edits
K GMRCFDA,FDA
;
I $D(^TMP("GMRCIN",$J,"OBX",1)) D ; reason for request change?
. ;
. I $G(OBR19)'="" D ; Re-sequence reason 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) ;
. ;
. D TRIMWP^GMRCIUTL($NA(^TMP("GMRCIN",$J,"OBX",1)),5)
. N DIFF S DIFF=0
. D I 'DIFF Q
.. I $O(^TMP("GMRCIN",$J,"OBX",1," "),-1)'=$O(^GMR(123,GMRCDA,20," "),-1) S DIFF=1 Q ; diff # of lines in new and existing
.. N LN S LN=0 F S LN=$O(^GMR(123,GMRCDA,20,LN)) Q:'LN!(DIFF) D
... I $G(^GMR(123,GMRCDA,20,LN,0))=$G(^TMP("GMRCIN",$J,"OBX",1,LN)) Q
... S DIFF=1 ;if the lines aren't the same, set DIFF and Q
. D WP^DIE(123,GMRCDA_",",20,"K",$NA(^TMP("GMRCIN",$J,"OBX",1)))
. Q
D ;file activity tracking
. D FILEACT^GMRCIAC2(GMRCDA,11,,$NA(^TMP("GMRCIN",$J)))
N GMRCNTIF
D ;determine if part of a FWD to IFC
. I $P(^GMR(123,GMRCDA,40,1,0),U,2)'=24 S GMRCNTIF=1 Q
. N ACT S ACT=1
. S GMRCNTIF=0
. F S ACT=$O(^GMR(123,GMRCDA,40,ACT)) Q:'ACT!($G(GMRCNTIF)) D
.. I ($P(^GMR(123,GMRCDA,40,ACT,0),U,2)=25),$O(^GMR(123,GMRCDA,40,ACT)) S GMRCNTIF=1 ;wat/66 Remedy 278355
;
D ;print SF-513 & send notifications
. I '$G(GMRCNTIF) Q ;part of a FWD to IFC
. D PRNT^GMRCUTL1("",GMRCDA)
. N GMRCORTX
. S GMRCORTX="New remotely re-submitted consult "
. S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCDA)
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,27,,1)
;
D ;send appl ACK and unlock record
. D APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI) ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
;
K ^TMP("GMRCIN",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCIAC1 11489 printed Sep 23, 2025@19:21:53 Page 2
GMRCIAC1 ;SLC/JFR - FILE IFC ACTIVITIES cont'd ; Jan 27, 2025@06:02:32
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,66,73,154,193,201,205**;DEC 27, 1997;Build 3
+2 ;
+3 ; Reference to $$FIND1^DIC in ICR #2051
+4 ; Reference to ^DIE in ICR #2053
+5 ; Reference to ^XLFSTR in ICR #10104
+6 ; Reference to ^DD(123 in ICR #4605
+7 ;
+8 QUIT
COMP(GMRCAR,GMRCCRNR,GMRCMSGI) ;process partial result, clin complete and admin complete ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
+1 ;
+2 ;p193
KILL ^TMP("GMRCIN",$JOB)
+3 NEW GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,FDA
+4 NEW GMRCRES,GMRCERR,GMRCSTS,GMRCREAS
+5 MERGE ^TMP("GMRCIN",$JOB)=@GMRCAR
+6 SET GMRCORC=^TMP("GMRCIN",$JOB,"ORC")
+7 SET GMRCREAS=$PIECE($PIECE(GMRCORC,"|",16),U)
+8 SET GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
+9 SET GMRCSTS=$PIECE(^GMR(123,GMRCDA,0),U,12)
+10 ;MKN GMRC*3*154
SET GMRCCRNR=$GET(GMRCCRNR,0)
SET GMRCMSGI=$GET(GMRCMSGI)
+11 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+12 ;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)))
+13 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+14 ;
+15 ;comp or pr
SET GMRCFDA(8)=$SELECT($PIECE(GMRCORC,"|",5)="CM":2,GMRCSTS=2:2,1:9)
+16 SET GMRCLAT=$SELECT($PIECE(GMRCORC,"|",5)="A":9,GMRCREAS="A":13,1:10)
+17 ;complete/upd or incomplete rpt
SET GMRCFDA(9)=GMRCLAT
+18 IF $DATA(^TMP("GMRCIN",$JOB,"OBX",6,1))
Begin DoDot:1
+19 SET GMRCFDA(15)=$PIECE(^TMP("GMRCIN",$JOB,"OBX",6,1),"|",5)
End DoDot:1
+20 ; v-- check to see if a duplicate transmission
+21 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
IF $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC,$SELECT(GMRCLAT=13:"",1:$GET(^TMP("GMRCIN",$JOB,"OBX",4,1))),GMRCCRNR,GMRCMSGI)
KILL ^TMP("GMRCIN",$JOB)
QUIT
+22 MERGE FDA(1,123,GMRCDA_",")=GMRCFDA
+23 ;file last action and status
DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+24 ; check GMRCERR and act if error
+25 KILL GMRCERR
+26 KILL GMRCFDA,FDA
+27 DO FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NAME(^TMP("GMRCIN",$JOB)))
+28 ; ^--- file result and activities
+29 ;file result if there
IF $DATA(^TMP("GMRCIN",$JOB,"OBX",4,1))
Begin DoDot:1
+30 ; addendum carries the result that it's addending
IF GMRCLAT=13
QUIT
+31 ; don't file result on inc. report
IF GMRCLAT=9
QUIT
+32 ;no comp coming from placer
IF $PIECE(^GMR(123,GMRCDA,12),U,5)="F"
QUIT
+33 DO FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCIN",$JOB,"OBX",4,1))
End DoDot:1
+34 ;send notifications
Begin DoDot:1
+35 IF GMRCLAT=9
QUIT
+36 ;filler only gets historical comp
IF $PIECE(^GMR(123,GMRCDA,12),U,5)="F"
QUIT
+37 NEW GMRCORTX
SET GMRCORTX=""
+38 IF $ORDER(^GMR(123,GMRCDA,51," "),-1)>1
Begin DoDot:2
+39 SET GMRCORTX="New remote result added to "
End DoDot:2
+40 IF GMRCLAT=13
SET GMRCORTX="Addendum added to "
+41 SET GMRCORTX=GMRCORTX_"Remote Complete Consult: "_$$ORTX^GMRCAU(+GMRCDA)
+42 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
End DoDot:1
+43 ;send appl ACK
Begin DoDot:1
+44 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
DO APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI)
End DoDot:1
+45 ;
+46 KILL ^TMP("GMRCIN",$JOB)
+47 QUIT
+48 ;
FWD(GMRCAR,GMRCCRNR,GMRCMSGI) ;file forward action from a remote site ;MKN GMRC*3*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("GMRCIN",$JOB)
+8 NEW GMRCFDA,GMRCDA,GMRCFWSR,GMRCFROM,GMRCORC,GMRCTIFC,GMRCLAC,GMRCROL
+9 MERGE ^TMP("GMRCIN",$JOB)=@GMRCAR
+10 ;p193
IF '$DATA(^TMP("GMRCIN",$JOB,"OBR"))
KILL ^TMP("GMRCIN",$JOB)
QUIT
+11 SET GMRCORC=^TMP("GMRCIN",$JOB,"ORC")
+12 SET GMRCTIFC=$SELECT($PIECE($PIECE(GMRCORC,"|",16),U)="F":0,1:1)
+13 SET GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
+14 ;MKN GMRC*3*154
SET GMRCCRNR=$GET(GMRCCRNR,0)
SET GMRCMSGI=$GET(GMRCMSGI)
+15 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+16 ;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)))
+17 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+18 SET GMRCROL=$PIECE(^GMR(123,GMRCDA,12),U,5)
+19 IF 'GMRCTIFC
Begin DoDot:1
+20 SET GMRCFDA(9)=17
SET GMRCLAC=17
+21 IF GMRCROL="F"
Begin DoDot:2
+22 SET GMRCFROM=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",4),U,2)
End DoDot:2
QUIT
+23 SET GMRCFDA(.131)=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",4),U,2)
+24 SET GMRCFROM=$PIECE($GET(^GMR(123,GMRCDA,13)),U)
End DoDot:1
+25 IF GMRCTIFC
Begin DoDot:1
+26 SET GMRCFROM=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",4),U,2)
+27 SET GMRCFDA(9)=25
SET GMRCLAC=25
End DoDot:1
+28 ;
+29 SET GMRCFDA(8)=5
+30 ;get urgency to file
Begin DoDot:1
+31 NEW URG
+32 SET URG=$$URG^GMRCHL7A($PIECE($PIECE(^TMP("GMRCIN",$JOB,"ORC"),"|",7),U,6))
+33 SET GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
End DoDot:1
+34 ; v-- chk to see if activity is a dup transmission
+35 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
IF $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCORC,,GMRCCRNR,GMRCMSGI)
KILL ^TMP("GMRCIN",$JOB)
QUIT
+36 ; GMRCMSGI = message ID
+37 ;
+38 ;
+39 MERGE FDA(1,123,GMRCDA_",")=GMRCFDA
+40 DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+41 KILL GMRCFDA
+42 ;
+43 ; file activity tracking
+44 DO FILEACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCFROM,$NAME(^TMP("GMRCIN",$JOB)))
+45 ;
+46 ; send alerts
+47 IF GMRCROL="F"
Begin DoDot:1
+48 ; filler alerts only on FWD 2 IFC
IF GMRCLAC'=25
QUIT
+49 NEW GMRCTX
+50 SET GMRCTX="New remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
+51 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,27,,1)
+52 QUIT
End DoDot:1
+53 IF GMRCROL="P"
Begin DoDot:1
+54 NEW GMRCTX
+55 SET GMRCTX="Updated Remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
+56 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,63,,1)
+57 QUIT
End DoDot:1
+58 ;
+59 ; print if FWD to IFC
+60 IF GMRCROL="F"
Begin DoDot:1
+61 IF GMRCLAC'=25
QUIT
+62 DO PRNT^GMRCUTL1("",GMRCDA)
End DoDot:1
+63 ;
+64 ;send app. ACK and unlock record
Begin DoDot:1
+65 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
DO APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI)
End DoDot:1
+66 KILL ^TMP("GMRCIN",$JOB)
+67 QUIT
+68 ;
SF(GMRCAR,GMRCCRNR,GMRCMSGI) ;add significant findings ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
+1 ; Input:
+2 ; GMRCAR = array name containing message
+3 ; e.g. ^TMP("GMRCIF",$J)
+4 ;
+5 ;p193
KILL ^TMP("GMRCIS",$JOB)
+6 NEW FDA,GMRCERR,GMRCOSF,GMRCISF
+7 MERGE ^TMP("GMRCIS",$JOB)=@GMRCAR
+8 ;no SF flag sent ;-( ;p193
IF '$DATA(^TMP("GMRCIS",$JOB,"OBX",6,1))
KILL ^TMP("GMRCIS",$JOB)
QUIT
+9 SET GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIS",$JOB,"ORC"))
+10 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+11 ;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("GMRCIS",$JOB)))
+12 ;p193 typo
KILL ^TMP("GMRCIS",$JOB)
QUIT
End DoDot:1
QUIT
+13 ;
+14 ;MKN GMRC*3*154
SET GMRCCRNR=$GET(GMRCCRNR,0)
SET GMRCMSGI=$GET(GMRCMSGI)
+15 SET GMRCOSF=$PIECE(^GMR(123,GMRCDA,0),U,19)
+16 SET GMRCISF=$PIECE(^TMP("GMRCIS",$JOB,"OBX",6,1),"|",5)
+17 SET FDA(1,123,GMRCDA_",",15)=GMRCISF
+18 SET FDA(1,123,GMRCDA_",",9)=4
+19 ; v-- quit if a duplicate activity
+20 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
IF $$DUPACT^GMRCIAC2(GMRCDA,4,^TMP("GMRCIS",$JOB,"ORC"),,GMRCCRNR,GMRCMSGI)
KILL ^TMP("GMRCIS",$JOB)
QUIT
+21 ;
+22 ;file last action and SF
DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+23 ;activity track
DO FILEACT^GMRCIAC2(GMRCDA,4,,$NAME(^TMP("GMRCIS",$JOB)))
+24 ;send notifications
Begin DoDot:1
+25 ;filler only gets hist. SF
IF $PIECE(^GMR(123,GMRCDA,12),U,5)="F"
QUIT
+26 NEW GMRCORTX
+27 SET GMRCORTX=$SELECT(GMRCISF="N":"No ",GMRCISF="Y":"",1:"Unknown ")
+28 SET GMRCORTX=GMRCORTX_"Sig Findings for "_$$ORTX^GMRCAU(+GMRCDA)
+29 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
End DoDot:1
+30 ;send appl ACK and unlock record
Begin DoDot:1
+31 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
DO APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI)
End DoDot:1
+32 KILL ^TMP("GMRCIS",$JOB)
+33 QUIT
+34 ;
RESUB(GMRCAR,GMRCCRNR,GMRCMSGI) ;resubmit a cancelled, remote consult ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
+1 ; Input:
+2 ; GMRCAR - array name containing message
+3 ; e.g. ^TMP("GMRCIF",$J)
+4 ;
+5 KILL ^TMP("GMRCIN",$JOB)
+6 MERGE ^TMP("GMRCIN",$JOB)=@GMRCAR
+7 NEW GMRCDA,GMRCFDA,FDA
+8 SET GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIN",$JOB,"ORC"))
+9 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+10 ; 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)))
+11 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+12 ;
+13 ;status and last action
SET GMRCFDA(8)=5
SET GMRCFDA(9)=11
+14 ;MKN GMRC*3*154
SET GMRCCRNR=$GET(GMRCCRNR,0)
SET GMRCMSGI=$GET(GMRCMSGI)
+15 ;
+16 ; P201 WTC 11.2.23
NEW OBR19
+17 ; has INPATIENT or OUTPATIENT changed?
IF $DATA(^TMP("GMRCIN",$JOB,"OBR"))
Begin DoDot:1
+18 NEW GMRCION
+19 SET GMRCION=$PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",18)
+20 IF GMRCION'=$PIECE(^GMR(123,GMRCDA,0),U,18)
SET GMRCFDA(14)=GMRCION
+21 ; P201 WTC 11/2/2023
SET OBR19=$PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",19)
+22 QUIT
End DoDot:1
+23 ; check for change in urgency
Begin DoDot:1
+24 NEW GMRCURG
+25 SET GMRCURG=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"ORC"),"|",7),U,6)
+26 IF '$LENGTH(GMRCURG)
QUIT
+27 SET GMRCURG=$$URG^GMRCHL7A(GMRCURG)
+28 SET GMRCURG=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_GMRCURG)
+29 IF GMRCURG'>1
QUIT
+30 ;no change
IF GMRCURG=$PIECE(^GMR(123,GMRCDA,0),U,9)
QUIT
+31 SET GMRCFDA(5)=GMRCURG
+32 QUIT
End DoDot:1
+33 ;check for change earliest date WAT/66
Begin DoDot:1
+34 NEW GMRCERDT
+35 SET GMRCERDT=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"ORC"),"|",7),U,4)
+36 IF '$LENGTH(GMRCERDT)
QUIT
+37 SET GMRCERDT=$$FMDATE^GMRCHL7(GMRCERDT)
+38 ;no change
IF GMRCERDT=$PIECE(^GMR(123,GMRCDA,0),U,24)
QUIT
+39 SET GMRCFDA(17)=GMRCERDT
+40 QUIT
End DoDot:1
+41 ; change in Prov. DX?
IF $DATA(^TMP("GMRCIN",$JOB,"OBX",2))
Begin DoDot:1
+42 NEW PROVDX,GMRCDXDT,GMRCCSYS,CODINTXT
+43 SET PROVDX=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U,2)
+44 SET GMRCDXDT=$PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",14)
SET GMRCDXDT=$$HL7TFM^XLFDT($GET(GMRCDXDT))
+45 SET GMRCCSYS=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U,3)
+46 SET GMRCCSYS=$SELECT($GET(GMRCCSYS)="I9C":"ICD",1:"10D")
+47 IF '$LENGTH(PROVDX)
QUIT
+48 IF PROVDX'=$GET(^GMR(123,GMRCDA,30))
Begin DoDot:2
+49 SET GMRCFDA(30)=PROVDX
+50 SET GMRCFDA(30.1)=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U)
SET CODINTXT="("_GMRCFDA(30.1)_")"
+51 IF GMRCFDA(30)[CODINTXT
Begin DoDot:3
+52 SET GMRCFDA(30)=$EXTRACT(GMRCFDA(30),0,($LENGTH(GMRCFDA(30))-$LENGTH(CODINTXT)))
+53 SET GMRCFDA(30)=$$TRIM^XLFSTR(GMRCFDA(30),"R")
End DoDot:3
End DoDot:2
+54 IF $GET(GMRCDXDT)'=""&($GET(GMRCDXDT)'=$PIECE($GET(^GMR(123,GMRCDA,30.1)),U,2))
Begin DoDot:2
+55 if $DATA(^DD(123,30.2,0))
SET GMRCFDA(30.2)=$GET(GMRCDXDT)
End DoDot:2
+56 IF $GET(GMRCCSYS)'=$PIECE($GET(^GMR(123,GMRCDA,30.1)),U,3)
Begin DoDot:2
+57 if $DATA(^DD(123,30.3,0))
SET GMRCFDA(30.3)=$GET(GMRCCSYS)
End DoDot:2
+58 QUIT
End DoDot:1
+59 ; v-- QUIT if a duplicate transmission
+60 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI ;p193
IF $$DUPACT^GMRCIAC2(GMRCDA,11,^TMP("GMRCIN",$JOB,"ORC"),,GMRCCRNR,GMRCMSGI)
KILL ^TMP("GMRCIN",$JOB)
QUIT
+61 ;
+62 MERGE FDA(1,123,GMRCDA_",")=GMRCFDA
+63 ;file edits
DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+64 KILL GMRCFDA,FDA
+65 ;
+66 ; reason for request change?
IF $DATA(^TMP("GMRCIN",$JOB,"OBX",1))
Begin DoDot:1
+67 ;
+68 ; Re-sequence reason for request if needed. wtc 201 11.2.2023
IF $GET(OBR19)'=""
Begin DoDot:2
+69 ;
NEW IEN
SET IEN=$ORDER(^GMR(123.7,"C",$$UP^XLFSTR(OBR19),0))
IF IEN
DO RESEQNCE^GMRCIRSN(IEN)
End DoDot:2
+70 ;
+71 DO TRIMWP^GMRCIUTL($NAME(^TMP("GMRCIN",$JOB,"OBX",1)),5)
+72 NEW DIFF
SET DIFF=0
+73 Begin DoDot:2
+74 ; diff # of lines in new and existing
IF $ORDER(^TMP("GMRCIN",$JOB,"OBX",1," "),-1)'=$ORDER(^GMR(123,GMRCDA,20," "),-1)
SET DIFF=1
QUIT
+75 NEW LN
SET LN=0
FOR
SET LN=$ORDER(^GMR(123,GMRCDA,20,LN))
if 'LN!(DIFF)
QUIT
Begin DoDot:3
+76 IF $GET(^GMR(123,GMRCDA,20,LN,0))=$GET(^TMP("GMRCIN",$JOB,"OBX",1,LN))
QUIT
+77 ;if the lines aren't the same, set DIFF and Q
SET DIFF=1
End DoDot:3
End DoDot:2
IF 'DIFF
QUIT
+78 DO WP^DIE(123,GMRCDA_",",20,"K",$NAME(^TMP("GMRCIN",$JOB,"OBX",1)))
+79 QUIT
End DoDot:1
+80 ;file activity tracking
Begin DoDot:1
+81 DO FILEACT^GMRCIAC2(GMRCDA,11,,$NAME(^TMP("GMRCIN",$JOB)))
End DoDot:1
+82 NEW GMRCNTIF
+83 ;determine if part of a FWD to IFC
Begin DoDot:1
+84 IF $PIECE(^GMR(123,GMRCDA,40,1,0),U,2)'=24
SET GMRCNTIF=1
QUIT
+85 NEW ACT
SET ACT=1
+86 SET GMRCNTIF=0
+87 FOR
SET ACT=$ORDER(^GMR(123,GMRCDA,40,ACT))
if 'ACT!($GET(GMRCNTIF))
QUIT
Begin DoDot:2
+88 ;wat/66 Remedy 278355
IF ($PIECE(^GMR(123,GMRCDA,40,ACT,0),U,2)=25)
IF $ORDER(^GMR(123,GMRCDA,40,ACT))
SET GMRCNTIF=1
End DoDot:2
End DoDot:1
+89 ;
+90 ;print SF-513 & send notifications
Begin DoDot:1
+91 ;part of a FWD to IFC
IF '$GET(GMRCNTIF)
QUIT
+92 DO PRNT^GMRCUTL1("",GMRCDA)
+93 NEW GMRCORTX
+94 SET GMRCORTX="New remotely re-submitted consult "
+95 SET GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCDA)
+96 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,27,,1)
End DoDot:1
+97 ;
+98 ;send appl ACK and unlock record
Begin DoDot:1
+99 ;MKN GMRC*3*154 added GMRCCRNR and GMRCMSGI
DO APPACK^GMRCIAC2(GMRCDA,"AA","",GMRCCRNR,GMRCMSGI)
End DoDot:1
+100 ;
+101 KILL ^TMP("GMRCIN",$JOB)
+102 QUIT
+103 ;
