GMRCIEV1.m

GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ; Aug 08, 2024@10:31:29

 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31,154,184,185,189**;DEC 27, 1997;Build 54

 ;#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,GMRCACT) ; Added GMRCACT parameter P 189 wtc 6/24/24

 . 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 ---GMRCIEV1   14108     printed  Mar 13, 2025@20:50:41                                                                                                                                                                                                   Page 2

GMRCIEV1  ;SLC/JFR - IFC EVENTS CONT'D ; Aug 08, 2024@10:31:29

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31,154,184,185,189**;DEC 27, 1997;Build 54

 +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