Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCIEVT

GMRCIEVT.m

Go to the documentation of this file.
  1. GMRCIEVT ;SLC/JFR - process events and build HL7 message; 6/20/2021 09:23 ; Aug 12, 2024@09:30:42
  1. ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31,121,154,184,189**;DEC 27, 1997;Build 54
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ; #7133 GETPAT MPIFRES, #7134 GETICN MPIFXMLI, #2161 HFLNC2, #2164 HLMA, #2271 HLUTIL3, #2701 MPIF001, #3015 VAFCPID, #4648 VAFCTFU2, #10112 VASITE
  1. ; #2053 DIE, #2056 DIQ, #2171 XUAF4, #2263 XPAR
  1. ; Reference to $$ADD^DGPROSAD in ICR #7421
  1. ; Reference to $$CRNRSITE^VAFCCRNR in ICR #7346
  1. ;
  1. Q ;don't start at the top
  1. TRIGR(IEN,ACTN) ;determine what action was taken on IFC and call event point
  1. ;Input:
  1. ; IEN = consult number from file 123
  1. ; ACT = ien in 40 multiple corresponding to activity
  1. ;
  1. ;CLT, GMRC*3.0*184, Do not send a msg back on receipt of a comment from
  1. ; cerner. That causes a duplicate entry at cerner.
  1. N GMRCDQ,GMRCDQ1 S GMRCDQ=0
  1. S GMRCDQ1=$$NOSND^GMRCIUTL() I GMRCDQ1=1 Q
  1. N ACTYPE
  1. S ACTYPE=$P(^GMR(123,IEN,40,ACTN,0),U,2)
  1. I 'ACTYPE Q
  1. I ACTYPE=26 Q ;don't send admin corrections yet...
  1. ;
  1. ; check bkgrd job and run if overdue
  1. I '$D(ZTQUEUED),$$GONOGO^GMRCIBKG D
  1. . N ZTQUEUED S ZTQUEUED=1 D EN^GMRCIBKG ;remove ZTQUEUED?
  1. ;
  1. I $O(^GMR(123.6,"AC",IEN,ACTN),-1) D Q ;earlier pending activities
  1. . I ACTYPE=22 Q ; not a trigger or not done here
  1. . I ACTYPE=6 N GMRCQT D I $D(GMRCQT) Q
  1. .. ;complete all transactions if IFC DC'd before request ever sent
  1. .. I $O(^GMR(123.6,"AC",IEN,ACTN),-1)'=1 Q ;new request already sent
  1. .. S GMRCQT=1
  1. .. N DA,DIE,DR,GMRCACTS
  1. .. S GMRCACTS=0
  1. .. F S GMRCACTS=$O(^GMR(123.6,"AC",IEN,GMRCACTS)) Q:'GMRCACTS D
  1. ... S DIE="^GMR(123.6,",DA=$O(^GMR(123.6,"AC",IEN,GMRCACTS,1,0))
  1. ... S DR=".06///@" D ^DIE
  1. . D LOGMSG^GMRCIUTL(IEN,ACTN,"",902) ;msg log entry but no msg sent
  1. I ACTYPE=2!(ACTYPE=1) D NW(IEN,ACTN) Q ;send new order - Added ACTN as parameter. P189 WTC 6/24/2024
  1. I ACTYPE=9!(ACTYPE=14) D RSLT(IEN,ACTN) Q ;inc report or add'l notes
  1. I ACTYPE=10,$P(^GMR(123,IEN,40,ACTN,0),U,9) D RSLT(IEN,ACTN) Q ;comp
  1. I ACTYPE=12 D RSLT(IEN,ACTN) Q ;dis-associate result
  1. I ACTYPE=11 D RESUB^GMRCIEV1(IEN,ACTN) Q ;ed/resubmit
  1. I ACTYPE=13 D RSLT(IEN,ACTN) Q ; addendum added
  1. I ACTYPE=4 D SF^GMRCIEV1(IEN,ACTN) Q ; sig finding update
  1. I ACTYPE=22 Q ;printed to is not a trigger
  1. I ACTYPE=17 D FWD^GMRCIEV1(IEN,ACTN) Q ; forward
  1. I ACTYPE=25 D FWD2IFC^GMRCIEV1(IEN,ACTN) Q ; FWD into an IFC service
  1. D GENUPD(IEN,ACTN) ;all other updates
  1. Q
  1. NW(GMRCDA,ACTN) ;build new order message for IFC
  1. ; Input:
  1. ; GMRCDA = ien from file 123
  1. ;
  1. N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCPD,PROXYADD,GMRCDFN,STA,SITE ;
  1. ;
  1. S PROXYADD=$$CHKCORR(GMRCDA) Q:'PROXYADD ;MKN GMRC*3.0*154 Check PT correlation and do proxy add if required, changed to function p189 wtc 12/5/23
  1. S SEG=1
  1. K ^TMP("HLS",$J)
  1. D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
  1. I $G(HL) D Q ; if HL array can't be built, log it with an error
  1. . D LOGMSG^GMRCIUTL(GMRCDA,ACTN,,904) ;MKN GMRC*3.0*154 GMRCACT to ACTN
  1. D I $D(GMRCIQT) D NOMPI(GMRCDA,1) Q ;build PID seg if not a local ICN
  1. . S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
  1. . I '$G(GMRCDFN) S GMRCIQT=1 Q
  1. . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
  1. . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
  1. . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
  1. . ;
  1. . ; If remote site is converted, enhance the PID segment. p184
  1. . ;
  1. . I $$CNVTD(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDFN,$P($G(^GMR(123,GMRCDA,"CERNER")),U,3)) ;
  1. . ;
  1. . S SEG=SEG+1
  1. . Q
  1. S ^TMP("HLS",$J,SEG)=$$NWORC^GMRCISG1(GMRCDA) ; get ORC for new ord
  1. S SEG=SEG+1
  1. S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA) ;get OBR segment
  1. ;
  1. ; If remote site is converted, enhance the OBR segment. p184
  1. ;
  1. I $$CNVTD(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2OBR^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDA) ;
  1. ;
  1. S SEG=SEG+1
  1. D ;build reason for request into OBX segment(s)
  1. . K ^TMP("GMRCRFR",$J)
  1. . D OBXWP^GMRCISEG(GMRCDA,"NW",1,$NA(^TMP("GMRCRFR",$J)))
  1. . I '$D(^TMP("GMRCRFR",$J)) Q
  1. . N I S I=0
  1. . F S I=$O(^TMP("GMRCRFR",$J,I)) Q:'I D
  1. .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCRFR",$J,I)
  1. .. S SEG=SEG+1
  1. . K ^TMP("GMRCRFR",$J)
  1. . Q
  1. S GMRCPD=$$OBXPD^GMRCISG1(GMRCDA) ;bl;154 preventing blank line for OBX
  1. I GMRCPD'="" S ^TMP("HLS",$J,SEG)=GMRCPD ; build prov DX in OBX
  1. S SEG=SEG+1
  1. S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always send local time zone
  1. ;
  1. ;AV/MKN Add NTE segment to HL7 to send UCID file #123, field #80 *121*
  1. N SEP
  1. S SEP=HL("FS")
  1. N UCID S UCID=$$GET1^DIQ(123,GMRCDA,80) S:UCID]"" SEG=SEG+1,^TMP("HLS",$J,SEG)="NTE"_SEP_"P"_SEP_"UCID:"_UCID
  1. ;AV/MKN End of NTE for UCID *121*
  1. ;
  1. S SITE=$P(^GMR(123,GMRCDA,0),U,23) I 'SITE D LOGMSG^GMRCIUTL(IEN,ACTN,"",903) Q ;no ROUTING FACILITY
  1. S STA=$$STA^XUAF4(SITE) I '$L(STA) D LOGMSG^GMRCIUTL(IEN,ACTN,"",903) Q ;can't find station num for that site
  1. ;
  1. ; If patient just proxy added, generate error 205 if not completed yet. p189 wtc 6/18/2024
  1. ;
  1. I $P(PROXYADD,U,2)="ADDED",+$$CHKPROXY^GMRCIUT1(GMRCDA,GMRCDFN,STA)=0 D LOGMSG^GMRCIUTL(IEN,ACTN,"",205) Q ;
  1. ;
  1. ; Otherwise, set route according to whether destination site is converted (use $$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)) or non-converted (use D LINK^HLUTIL3(STA,.GMRCLINK,"I"))
  1. ;
  1. S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
  1. . D:'$$EXIST201^GMRCIEV1(GMRCDA,GMRCACT) LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;MKN GMRC*3*154 '$$EXIST201
  1. S HLP("SUBSCRIBER")="^^^^"_$P(HLL("LINKS",1),U,3) ;MKN GMRC*3*154 Station coming back from $$ROUTE
  1. 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
  1. N ERR S ERR=$S($P(GMRC773,U,2):904,1:"")
  1. ;
  1. D LOGMSG^GMRCIUTL(GMRCDA,1,+GMRC773,ERR)
  1. Q
  1. ;
  1. GENUPD(GMRCDA,GMRCACT) ;build msg and send upon REC, SC or ADD CMT event
  1. N HL,HLL,SEG,GMRC773,GMRCCRNR,GMRCIQT,OBR,PROSTHCS ; P184
  1. N EDIPI,ICN,PTACCTNO,FS,CS,REPTTN S PTACCTNO=$P($G(^GMR(123,GMRCDA,"CERNER")),U,3) ; p184
  1. S SEG=1
  1. K ^TMP("HLS",$J)
  1. D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
  1. I $G(HL) D Q ; if HL array can't be built, log it with an error
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
  1. D I $D(GMRCIQT) D NOMPI(GMRCDA,GMRCACT) Q ;build PID seg if nat'l ICN
  1. . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
  1. . I '$G(GMRCDFN) S GMRCIQT=1 Q
  1. . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
  1. . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
  1. . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
  1. . ;
  1. . ; If remote site is converted, enhance the PID segment. p184
  1. . ;
  1. . I $$CNVTD(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDFN,PTACCTNO) ;
  1. . S SEG=SEG+1 ;
  1. . Q
  1. D ;build ORC seg based on GMRCACT
  1. . N ACTVT,OC,OS
  1. . S ACTVT=$P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2) ; get activity
  1. . ;set order control for ORC seg:
  1. . ; v-- IP=cmt RE=adm comp OD=DC OC=cancel SC=sch or receive
  1. . S OC=$S(ACTVT=20:"IP",ACTVT=10:"RE",ACTVT=6:"OD",ACTVT=19:"OC",1:"SC")
  1. . ;set order status for ORC seg:
  1. . ; v-- SC=sch RE=adm comp DC=DC CA=cancel IP=cmt or receive
  1. . S OS=$S(ACTVT=8:"SC",ACTVT=10:"CM",ACTVT=6:"DC",ACTVT=19:"CA",1:"IP")
  1. . S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
  1. . S SEG=SEG+1
  1. . Q
  1. ;
  1. ; Generate OBR segment if IFC is from converted site. p184
  1. ;
  1. I $$CNVTD(GMRCDA)=1 D ;
  1. . ;
  1. . S OBR=$$OBR^GMRCISG1(GMRCDA) ;
  1. . S OBR=$$ADD2OBR^GMRCIUTL(OBR,GMRCDA) ;
  1. . S ^TMP("HLS",$J,SEG)=OBR ;
  1. . S SEG=SEG+1 ;
  1. ;
  1. ; Determine if order is for Prosthetics - p184 WTC 6/1/22
  1. ;
  1. S PROSTHCS=$S($G(OBR)="":0,$P($P(OBR,"|",5),U,2)["PROSTHETICS IFC":1,1:0) ; P184
  1. ;
  1. I $L($P(^GMR(123,GMRCDA,0),U,19)) D ;send sig findings
  1. . S ^TMP("HLS",$J,SEG)=$$OBXSF^GMRCISEG(GMRCDA)
  1. . S SEG=SEG+1
  1. I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up a comment if there
  1. . N I
  1. . K ^TMP("GMRCMT",$J)
  1. . S GMRCCRNR=$$ISCERNER(GMRCDA) ;MKN 184
  1. . I $P(^TMP("HLS",$J,SEG-1),"|",2)'["O" D
  1. .. D:GMRCCRNR&'PROSTHCS CRNROBX^GMRCIEV1(GMRCDA,$NA(^TMP("GMRCMT",$J))) ; p184 - wtc 6/1/22
  1. .. D:'GMRCCRNR!PROSTHCS OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J))) ; p184 - wtc 6/1/22
  1. . I $P(^TMP("HLS",$J,SEG-1),"|",2)["O" D
  1. .. I GMRCCRNR,'PROSTHCS D CRNRNTE^GMRCIEV1(GMRCDA,$NA(^TMP("GMRCMT",$J))) ; p184 - wtc 6/1/22
  1. .. I 'GMRCCRNR!PROSTHCS N GMRCMT D NTE^GMRCISEG(GMRCDA,GMRCACT,.GMRCMT) I $D(GMRCMT) M ^TMP("GMRCMT",$J)=GMRCMT ; p184 - wtc 6/1/22
  1. . Q:'$O(^TMP("GMRCMT",$J,0))
  1. . S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
  1. .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
  1. .. S SEG=SEG+1
  1. . K ^TMP("GMRCMT",$J)
  1. . Q
  1. S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
  1. S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
  1. . D:'$$EXIST201^GMRCIEV1(GMRCDA,GMRCACT) LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;MKN GMRC*3*154 '$$EXIST201
  1. S HLP("SUBSCRIBER")="^^^^"_$P(HLL("LINKS",1),U,3) ;MKN GMRC*3*154 Station coming back from $$ROUTE
  1. ;
  1. 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
  1. N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
  1. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
  1. Q
  1. ;
  1. RSLT(GMRCDA,GMRCACT) ;attach or dis-associate results and update
  1. N HL,HLL,SEG,GMRC773,GMRCIQT
  1. S SEG=1
  1. K ^TMP("HLS",$J)
  1. D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
  1. I $G(HL) D Q ; if HL array can't be built, log it with an error
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
  1. D I $D(GMRCIQT) D NOMPI(GMRCDA,GMRCACT) Q ;build PID seg if nat'l ICN
  1. . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
  1. . I '$G(GMRCDFN) S GMRCIQT=1 Q
  1. . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
  1. . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
  1. . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
  1. . ;
  1. . ; If remote site is converted, enhance the PID segment. p184
  1. . ;
  1. . I $$CNVTD(GMRCDA)=1 S ^TMP("HLS",$J,SEG)=$$ADD2PID^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDFN,$P($G(^GMR(123,GMRCDA,"CERNER")),U,3)) ;
  1. . ;
  1. . S SEG=SEG+1
  1. . Q
  1. D ;build ORC seg based on GMRCACT
  1. . N ACTVT,OC,OS
  1. . S ACTVT=$P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2) ; get activity
  1. . S OC="RE"
  1. . S OS=$S(ACTVT=9:"A",ACTVT=12:"IP",1:"CM") ; A=part res CM=comp IP=dis
  1. . S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,OC,OS,GMRCACT)
  1. . S SEG=SEG+1
  1. ;
  1. ; If remote site is converted, add OBR segment. p184
  1. ;
  1. I $$CNVTD(GMRCDA)=1 D ;
  1. . S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA) ;
  1. . S ^TMP("HLS",$J,SEG)=$$ADD2OBR^GMRCIUTL(^TMP("HLS",$J,SEG),GMRCDA) ;
  1. . S SEG=SEG+1
  1. ;
  1. I $P(^GMR(123,GMRCDA,40,GMRCACT,0),U,2)'=99 D
  1. . S ^TMP("HLS",$J,SEG)=$$OBXRSLT^GMRCISEG(GMRCDA,GMRCACT)
  1. . S SEG=SEG+1
  1. S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
  1. S HLL("LINKS",1)=$$ROUTE(GMRCDA) I '$L(HLL("LINKS",1)) D Q ;log error
  1. . D:'$$EXIST201^GMRCIEV1(IEN,GMRCACT) LOGMSG^GMRCIUTL(IEN,ACTN,"",903) ;MKN GMRC*3*154 '$$EXIST201
  1. S HLP("SUBSCRIBER")="^^^^"_$P(HLL("LINKS",1),U,3) ;MKN GMRC*3*154 Station coming back from $$ROUTE
  1. D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773,,.HLP) ;MKN GMRC*3*154 added 6th parameter that passes subscriber to HLP array in GENERATE^HLMA
  1. N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
  1. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
  1. Q
  1. ;
  1. NOMPI(GMRCIEN,GMRCACTV) ;process MPI exception
  1. N GMRCDFN
  1. S GMRCDFN=$P(^GMR(123,GMRCIEN,0),U,2)
  1. D PTMPIER^GMRCIERR(GMRCDFN) ; send msg to local group for ICN problem
  1. D LOGMSG^GMRCIUTL(GMRCIEN,GMRCACTV,,202) ;put inc. entry in MSG log
  1. Q
  1. ;
  1. ROUTE(GMRCDA) ; determine correct routing for IFC msg
  1. ; Input:
  1. ; GMRCDA = ien from file 123
  1. ;
  1. ; Output:
  1. ; the logical link to send the message to in format
  1. ; "GMRC IFC SUBSC^VHAHIN^STATION"
  1. ;
  1. N SITE,STA ;
  1. S SITE=$P(^GMR(123,GMRCDA,0),U,23) I 'SITE Q "" ;no ROUTING FACILITY
  1. S STA=$$STA^XUAF4(SITE) I '$L(STA) Q "" ;can't find station num for that site
  1. ;
  1. ; Converted site
  1. ;
  1. I $$CRNRSITE^VAFCCRNR(STA)=1 Q "GMRC IFC SUBSC^"_$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)_U_STA ;
  1. ;
  1. ; Non-converted site
  1. ;
  1. N GMRCLINK,SUB,DATA ;
  1. I $$CRNRSITE^VAFCCRNR(STA)'=1 D LINK^HLUTIL3(STA,.GMRCLINK,"I") S SUB=$O(GMRCLINK(0)) I SUB S DATA=GMRCLINK(SUB) Q "GMRC IFC SUBSC^"_DATA_U_STA ;
  1. ;
  1. Q "" ;
  1. ;
  1. CNVTD(GMRCDA) ; had facility been converted
  1. ; Input:
  1. ; GMRCDA = ien from file 123
  1. ;
  1. ; Output:
  1. ; 1 = converted site
  1. ; 0 = not converted or unknown based on missing data
  1. N SITE,STA
  1. N DGKEY,DGOUT,CNT,IDS,CONSULTDFN,GMRCDFN
  1. S CONSULTDFN=""
  1. S SITE=$P($G(^GMR(123,GMRCDA,0)),U,23) I 'SITE Q 0 ;no ROUTING FACILITY
  1. S STA=$$STA^XUAF4(SITE)
  1. I '$L(STA) Q 0 ;can't find station num for that site
  1. ;
  1. S GMRCDFN=$P(^GMR(123,GMRCDA,0),U,2) ;get patient
  1. I 'GMRCDFN Q 0
  1. ;
  1. ;pull patient Correlation list
  1. S DGKEY=GMRCDFN_U_"PI"_U_"USVHA"_U_$P($$SITE^VASITE,"^",3)
  1. D TFL^VAFCTFU2(.DGOUT,DGKEY)
  1. ;
  1. S CNT=0 F S CNT=$O(DGOUT(CNT)) Q:'CNT S IDS=$G(DGOUT(CNT)) I $P(IDS,"^",4)=STA,$P(IDS,"^",5)="C" S CONSULTDFN=IDS Q
  1. ;
  1. Q $S(CONSULTDFN]"":1,1:0)
  1. ;
  1. ;MKN GMRC*3.0*154 Start mods - Check PT correlation and do proxy add if required
  1. CHKCORR(GMRCDA) ;
  1. ;
  1. ; Returns "1^ADDED" if proxy add succeeded, 1 if patient known to Cerner or site is non-converted and 0 if not. p189 wtc 12/5/23, 4/4/24
  1. ;
  1. N CERNERID,CNT,CONSULTDFN,DGKEY,DGOUT,GMRCDFN,IDS,SITE,STA,RTNCODE ;
  1. S GMRCDFN=$P(^GMR(123,GMRCDA,0),U,2) I 'GMRCDFN Q 0 ;
  1. ;
  1. S SITE=$P(^GMR(123,GMRCDA,0),U,23) I 'SITE Q 0 ;no ROUTING FACILITY
  1. S STA=$$STA^XUAF4(SITE) I '$L(STA) Q 0 ;can't find station num for that site
  1. ;
  1. S (CERNERID,CONSULTDFN)=""
  1. ;pull patient Correlation list
  1. S DGKEY=GMRCDFN_U_"PI"_U_"USVHA"_U_$P($$SITE^VASITE,"^",3)
  1. D TFL^VAFCTFU2(.DGOUT,DGKEY)
  1. ;
  1. S CNT=0,RTNCODE=0 F S CNT=$O(DGOUT(CNT)) Q:'CNT S IDS=$G(DGOUT(CNT)) D ;
  1. .I $P(IDS,"^",4)="200CRNR",$P(IDS,"^",2)="PI" S CERNERID=IDS ;
  1. .I $P(IDS,"^",4)=STA,$P(IDS,"^",2)="PI",$P(IDS,"^",5)="A"!($P(IDS,"^",5)="C") S CONSULTDFN=IDS ;
  1. ;
  1. ; Patient known to filler and filler is non-converted VistA.
  1. ;
  1. I CONSULTDFN'="",$$CRNRSITE^VAFCCRNR(STA)'=1 Q 1 ;
  1. ;
  1. ; Filler is Cerner. Patient known to Cerner and its converted VistA.
  1. ;
  1. I CERNERID'="",CONSULTDFN'="",$$CRNRSITE^VAFCCRNR(STA)=1 Q 1 ;
  1. ;
  1. ; Filler is Cerner. Patient known to Cerner but not its converted VistA.
  1. ;
  1. I CERNERID'="",CONSULTDFN="",$$CRNRSITE^VAFCCRNR(STA)=1 D Q 1 ; return 1 because response is sent to Cerner not the converted VistA
  1. . S RTNCODE=$$ADD^DGPROSAD($P(CERNERID,U,1)_"~USDOD~NI~200DOD",STA) ; ICR 7421
  1. . I RTNCODE<0 D FAILPRXY^GMRCIUT1("",$P(CERNERID,U,1),GMRCDA,"","","",STA,$P(RTNCODE,U,2)) Q ; P189 WTC 6/24/24
  1. ;
  1. ; if not known to filler, trigger Proxy Add Patient
  1. ;
  1. I CONSULTDFN=""!(CERNERID="") S RTNCODE=$$PROXYADD(GMRCDA,GMRCDFN,STA) ;
  1. Q RTNCODE ;
  1. ;
  1. PROXYADD(GMRCDA,GMRCDFN,STA) ;
  1. ;
  1. ; Adds patient to Cerner or non-converted VistA. Returns "1^ADDED" if successful and 0 if not. p189 wtc 12/5/23
  1. ;
  1. N CONSULTDFN,MPIDATA,PATARR
  1. S CONSULTDFN=0
  1. D GETPAT^MPIFRES(GMRCDFN,.PATARR)
  1. S PATARR(1,"preferredFacilityNumber")=STA
  1. S PATARR(1,"AddType")="ADDPREFTF"
  1. D GETICN^MPIFXMLI(.MPIDATA,.PATARR) I +MPIDATA("ICN")>0 S CONSULTDFN=+MPIDATA("ICN")
  1. ;
  1. ; If proxy add failed, generate 203 error if IFC to Cerner or 201 error otherwise.
  1. ;
  1. I +CONSULTDFN=0 D Q 0 ;
  1. . I $$CRNRSITE^VAFCCRNR(STA)=1 D LOGMSG^GMRCIUTL(GMRCDA,1,"",203) Q ;
  1. . I $$CRNRSITE^VAFCCRNR(STA)'=1 D LOGMSG^GMRCIUTL(GMRCDA,1,"",201) Q ;
  1. Q "1^ADDED" ;
  1. ;
  1. ISCERNER(IEN) ;Is consult going to Cerner?
  1. ;Input:
  1. ; IEN = file #123
  1. ;Output:
  1. ; 1 = Cerner IFC
  1. ; 0 = Error - see piece 2 for message
  1. ;
  1. N GMRCCNV,GMRCDFN,GMRCKEY,GMRCN,GMRCSITE,GMRCTFL,GMRCX,STA ; p184 WTC 5/1/22
  1. S GMRCSITE=$P(^GMR(123,IEN,0),U,23) I 'GMRCSITE Q "0^No ROUTING FACILITY found" Q
  1. S STA=$$STA^XUAF4(GMRCSITE) I '$L(STA) Q "0^Station not found" ;can't find station num for that site - p184 WTC 5/1/22
  1. S GMRCDFN=$$GET1^DIQ(123,IEN_",",.02,"I") I 'GMRCDFN Q "0^No PATIENT file IEN found in consult #"_IEN
  1. S GMRCKEY=GMRCDFN_U_"PI"_U_"USVHA"_U_$P($$SITE^VASITE,"^",3)
  1. D TFL^VAFCTFU2(.GMRCTFL,GMRCKEY)
  1. S (GMRCCNV,GMRCN)=0 F S GMRCN=$O(GMRCTFL(GMRCN)) Q:'GMRCN S GMRCX=GMRCTFL(GMRCN) D
  1. . I $P(GMRCX,U,4)=STA,$P(GMRCX,U,5)="C" S GMRCCNV=1 Q ; p184 WTC 5/1/22
  1. ;It is going to Cerner=converted site, so send all messages
  1. Q GMRCCNV
  1. ;
  1. LOC(GMRCLOC,GMRCIENS) ;DETERMINE LOCATION
  1. N LOCNAME
  1. I '$D(^GMR(123,$P(GMRCIENS,",",2),40,$P(GMRCIENS,",",1),3)) D SITE Q GMRCLOC
  1. S LOCNAME=^GMR(123,$P(GMRCIENS,",",2),40,$P(GMRCIENS,",",1),3)
  1. S LOCNAME=$P(LOCNAME,U,3)
  1. S LOCNAME=$P(^DIC(4,LOCNAME,0),U,1)
  1. Q LOCNAME
  1. SITE ;SET LOCAL SITE
  1. S GMRCLOC=$P($$SITE^VASITE,U,2)
  1. Q