GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ; Mar 02, 2023@07:32:49
;;3.0;CONSULT/REQUEST TRACKING;**22,28,31,154,184,185**;DEC 27, 1997;Build 16
;#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
;
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
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
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
;
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
;
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
;
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(^GMR(123,IEN,40,GMRCN,1,1)) D ;
. 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" ;
. ;
. 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 14052 printed Nov 22, 2024@16:56:13 Page 2
GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ; Mar 02, 2023@07:32:49
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31,154,184,185**;DEC 27, 1997;Build 16
+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 NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCPD
+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 ;
+18 ; If remote site is converted, enhance the PID segment. p184
+19 ;
+20 ;
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))
+21 ;
+22 SET SEG=SEG+1
+23 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+24 ;
+25 ;build ORC seg based on GMRCACT
+26 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"XO","IP",GMRCACT)
+27 SET SEG=SEG+1
+28 ;
+29 ; include Inpatient or Outpatient
+30 SET ^TMP("HLS",$JOB,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
+31 ;
+32 ; If remote site is converted, enhance the OBR segment. p184
+33 ;
+34 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
SET ^TMP("HLS",$JOB,SEG)=$$ADD2OBR^GMRCIUTL(^TMP("HLS",$JOB,SEG),GMRCDA)
+35 ;
+36 SET SEG=SEG+1
+37 ;
+38 ;load up reason for request
Begin DoDot:1
+39 KILL ^TMP("GMRCRFR",$JOB)
+40 DO OBXWP^GMRCISEG(GMRCDA,"XO",GMRCACT,$NAME(^TMP("GMRCRFR",$JOB)))
+41 IF '$DATA(^TMP("GMRCRFR",$JOB))
QUIT
+42 NEW I
SET I=0
+43 FOR
SET I=$ORDER(^TMP("GMRCRFR",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+44 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCRFR",$JOB,I)
+45 SET SEG=SEG+1
End DoDot:2
+46 KILL ^TMP("GMRCRFR",$JOB)
+47 QUIT
End DoDot:1
+48 ;prov DX changed, send it
Begin DoDot:1
+49 ;bl;154 preventing blank line for OBX
SET GMRCPD=$$OBXPD^GMRCISG1(GMRCDA)
+50 ; build prov DX in OBX
IF GMRCPD'=""
SET ^TMP("HLS",$JOB,SEG)=GMRCPD
+51 SET SEG=SEG+1
End DoDot:1
+52 ;
+53 ;send ed-res comment and file as is
Begin DoDot:1
+54 NEW I
+55 KILL ^TMP("GMRCMT",$JOB)
+56 DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+57 if '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+58 SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+59 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+60 SET SEG=SEG+1
End DoDot:2
+61 KILL ^TMP("GMRCMT",$JOB)
+62 QUIT
End DoDot:1
+63 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+64 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+65 ;log error ;MKN GMRC*3*154 '$$EXIST201
if '$$EXIST201(GMRCDA,GMRCACT)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+66 ;MKN GMRC*3*154 Station coming back from $$ROUTE
SET HLP("SUBSCRIBER")="^^^^"_$PIECE(HLL("LINKS",1),U,3)
+67 ;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)
+68 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+69 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+70 QUIT
+71 ;
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 ; P184
NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS,GMRCCRNR,OBR,PROSTHCS
+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 ;
+17 ; If remote site is converted, enhance the PID segment. p184
+18 ;
+19 ;
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))
+20 ;
+21 SET SEG=SEG+1
+22 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+23 ;
+24 ;build ORC seg based on GMRCACT
+25 SET GMRCOS=$SELECT($PIECE(^GMR(123,GMRCDA,0),U,12)="2":"CM",1:"IP")
+26 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"RE","CM",GMRCACT)
+27 SET SEG=SEG+1
+28 ;
+29 ; If remote site is converted, add OBR segment. p184
+30 ;
+31 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
Begin DoDot:1
+32 ;
SET OBR=$$OBR^GMRCISG1(GMRCDA)
+33 ;
SET OBR=$$ADD2OBR^GMRCIUTL(OBR,GMRCDA)
SET ^TMP("HLS",$JOB,SEG)=OBR
+34 SET SEG=SEG+1
End DoDot:1
+35 ;
+36 ; Determine if order is for Prosthetics - p184 WTC 6/1/22
+37 ;
+38 ; P184
SET PROSTHCS=$SELECT($GET(OBR)="":0,$PIECE($PIECE(OBR,"|",5),U,2)["PROSTHETICS IFC":1,1:0)
+39 ;
+40 ;load up comment to send
IF $ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))
Begin DoDot:1
+41 KILL ^TMP("GMRCMT",$JOB)
+42 ;MKN 184
SET GMRCCRNR=$$ISCERNER^GMRCIEVT(GMRCDA)
+43 ; P184 WTC 6/1/22
if GMRCCRNR&'PROSTHCS
DO CRNROBX(GMRCDA,$NAME(^TMP("GMRCMT",$JOB)))
+44 ; P184 WTC 6/1/22
if 'GMRCCRNR!PROSTHCS
DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+45 if '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+46 NEW I
SET I=0
FOR
SET I=$ORDER(^TMP("GMRCMT",$JOB,I))
if 'I
QUIT
Begin DoDot:2
+47 SET ^TMP("HLS",$JOB,SEG)=^TMP("GMRCMT",$JOB,I)
+48 SET SEG=SEG+1
End DoDot:2
+49 KILL ^TMP("GMRCMT",$JOB)
+50 QUIT
End DoDot:1
+51 IF $LENGTH($PIECE(^GMR(123,GMRCDA,0),U,19))
SET ^TMP("HLS",$JOB,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
SET SEG=SEG+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 ;MKN GMRC*3*154 '$$EXIST201
if '$$EXIST201(GMRCDA,GMRCACT)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+55 ;MKN GMRC*3*154 Station coming back from $$ROUTE
SET HLP("SUBSCRIBER")="^^^^"_$PIECE(HLL("LINKS",1),U,3)
+56 ;
+57 ;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)
+58 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+59 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+60 QUIT
+61 ;
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 ; P184
NEW HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS,GMRCCRNR,OBR,PROSTHCS
+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 ;
+17 ; If remote site is converted, enhance the PID segment. p184
+18 ;
+19 ;
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))
+20 ;
+21 SET SEG=SEG+1
+22 QUIT
End DoDot:1
IF $DATA(GMRCIQT)
DO NOMPI^GMRCIEVT(GMRCDA,GMRCACT)
QUIT
+23 ;
+24 ;build ORC seg based on GMRCACT
+25 SET ^TMP("HLS",$JOB,SEG)=$$ORC^GMRCISEG(GMRCDA,"XX","IP",GMRCACT)
+26 SET SEG=SEG+1
+27 ;
+28 ;
SET OBR=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
+29 ;
+30 ; If remote site is converted, enhance the OBR segment. p184
+31 ;
+32 ;
IF $$CNVTD^GMRCIEVT(GMRCDA)=1
SET OBR=$$ADD2OBR^GMRCIUTL(OBR,GMRCDA)
+33 ;
SET ^TMP("HLS",$JOB,SEG)=OBR
+34 ;
+35 ;
SET SEG=SEG+1
+36 ;
+37 ; Determine if order is for Prosthetics - p184 WTC 6/1/22
+38 ;
+39 ; P184
SET PROSTHCS=$SELECT($GET(OBR)="":0,$PIECE($PIECE(OBR,"|",5),U,2)["PROSTHETICS IFC":1,1:0)
+40 ;
+41 ;load up comment to send
IF $ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))
Begin DoDot:1
+42 KILL ^TMP("GMRCMT",$JOB)
+43 ;MKN 184
SET GMRCCRNR=$$ISCERNER^GMRCIEVT(GMRCDA)
+44 ; P184 WTC 6/1/22
if GMRCCRNR&'PROSTHCS
DO CRNROBX(GMRCDA,$NAME(^TMP("GMRCMT",$JOB)))
+45 ; P184 WTC 6/1/22
if 'GMRCCRNR!PROSTHCS
DO OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NAME(^TMP("GMRCMT",$JOB)))
+46 if '$ORDER(^TMP("GMRCMT",$JOB,0))
QUIT
+47 NEW I
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 IF $LENGTH($PIECE(^GMR(123,GMRCDA,0),U,19))
SET ^TMP("HLS",$JOB,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
SET SEG=SEG+1
+53 ;always include local time zone
SET ^TMP("HLS",$JOB,SEG)=$$OBXTZ^GMRCISEG
+54 SET HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA)
IF '$LENGTH(HLL("LINKS",1))
Begin DoDot:1
+55 ;log error ;MKN GMRC*3*154 '$$EXIST201
if '$$EXIST201(GMRCDA,GMRCACT)
DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903)
End DoDot:1
QUIT
+56 ;MKN GMRC*3*154 Station coming back from $$ROUTE
SET HLP("SUBSCRIBER")="^^^^"_$PIECE(HLL("LINKS",1),U,3)
+57 ;
+58 ;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)
+59 ; if err from HL7, log it
NEW ERR
SET ERR=$SELECT($PIECE(GMRC773,U,2):904,1:"")
+60 DO LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
+61 QUIT
+62 ;
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
+12 ;
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)))
IF $DATA(^GMR(123,IEN,40,GMRCN,1,1))
Begin DoDot:1
+20 SET GMRCIENS=GMRCN_","_IEN_","
KILL GMRCO
DO GETS^DIQ(123.02,GMRCIENS,"2;4;.21;.32;.33","IE","GMRCO")
+21 SET GMRCDT=$GET(GMRCO(123.02,GMRCIENS,2,"I"))
SET GMRCDT=$$UP^XLFSTR($$FMTE^XLFDT(GMRCO(123.02,GMRCIENS,2,"I"),"5PZ"))
+22 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"| ||||||P"
+23 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Activity Type: "_GMRCACTD($PIECE(GMRCX,U,2))_"||||||P"
+24 ;
+25 ; WTC 2/4/22
KILL @GMRCTMP
DO OBXWP^GMRCISEG(IEN,"IP",GMRCN,GMRCTMP)
+26 ; 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
+27 ;
+28 ;
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"
+29 ;
IF GMRCO(123.02,GMRCIENS,.32,"I")=1
Begin DoDot:2
+30 ;
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)
+31 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered At Location: "_GMRCSTNM_"||||||P"
End DoDot:2
+32 SET GMRCENBY=$GET(GMRCO(123.02,GMRCIENS,4,"E"))
IF GMRCENBY=""
SET GMRCENBY=$PIECE($GET(GMRCO(123.02,GMRCIENS,.21,"E")),U)
+33 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|Entered By: "_GMRCENBY_"||||||P"
+34 ;
SET GMRCT=GMRCT+1
SET @GMRCNA@(GMRCT)="OBX|3|TX|^COMMENTS^|"_GMRCT_"|"_GMRCDT_"||||||P"
End DoDot:1
+35 KILL @GMRCTMP
+36 QUIT
+37 ;
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
