RAO7PC4 ;HISC/SWM-utilities ; Apr 28, 2020@14:47:40
;;5.0;Radiology/Nuclear Medicine;**28,32,31,45,77,157,169**;Mar 16, 1998;Build 2
;08/10/2006 BAY/KAM Remedy Call 134839 Subscript Error
;
;IA Type File Routine Tag
;------------------------------------------------
;1362 (C) ORB3 EN
;
Q
EN1 ; api for CPRS notification alert #67
Q:'$D(XQADATA)
D SET1 ; set up ^TMP nodes
D DISP1 ; convert and display ^TMP nodes
D KIL1 ; kill ^TMP nodes
Q
SET1 N RADFN,RADTI,RACNI,RAPROC1,RAPROC2,RAPHY1,RAPHY2,RAPMOD1,RAPMOD2,RAACNT
N RAPATNAM,RASSN,RASTR,I,J,RACMU,RAOIFN
; 08/10/2006 BAY/KAM Remedy Call 134839/RA*5*77 - Added next line
Q:$G(XQADATA)=""
S RADFN=$P(XQADATA,"/") ; ien patient
S RAACNT=0 ; counter
S RADTI=$P(XQADATA,"/",2) ; inverse date of exam
S RACNI=$P(XQADATA,"/",3) ; ien case
;p157/KLM Set the before procedure from order if missing from alert data
S RAPROC1=$P(XQADATA,"/",4) I RAPROC1="" D ; ien 71, before
.S RAOIFN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
.S:RAOIFN]"" RAPROC1=$P(^RAO(75.1,RAOIFN,0),U,2)
.Q
S RAPROC2=$P(XQADATA,"/",5) ; ien 71, after
S RAPHY1=$P(XQADATA,"/",6) ; ien 200 requesting physician, before
S RAPHY2=$P(XQADATA,"/",7) ; ien 200 requesting physician, after
S RAPMOD1=$P(XQADATA,"/",8) ;string of proc mod iens, before
S RAPMOD2=$P(XQADATA,"/",9) ;string of proc mod iens, after
K ^TMP($J,"RAE4")
Q:'$D(^DPT(RADFN,0))
S RAPATNAM=$P(^DPT(RADFN,0),"^") S RASSN=$$SSN^RAUTL() S:RASSN="" RASSN="Unkn"
S RACMU=$S(+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0))>0:" (CM w/exam)",1:"")
S ^TMP($J,"RAE4",1)="Imaging Exam for "_RAPATNAM_" ("_RASSN_") changed:"
I 'RAPROC2,RAPROC1 D
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" "
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))="For procedure "_$E($P(^RAMIS(71,RAPROC1,0),"^"),1,53)_RACMU
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" "
I RAPROC2 D
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" Procedure changed"
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_$S(RAPROC1]"":$E($P(^RAMIS(71,RAPROC1,0),"^"),1,53),1:"UNKNOWN") ;p157/KLM - add $S for 'unknown' procedure
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_$E($P(^RAMIS(71,RAPROC2,0),"^"),1,53)_RACMU
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=""
I RAPHY2 D
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" Requesting Physician changed"
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_$$GET1^DIQ(200,RAPHY1,.01)
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_$$GET1^DIQ(200,RAPHY2,.01)
I RAPMOD2!(('RAPMOD2)&(RAPMOD1)) D
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" Procedure Modifier changed"
.S RASTR=""
.F I=1:1:($L(RAPMOD1)/2) S J=$P(RAPMOD1,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240
.S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma and blank
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_RASTR
.S RASTR=""
.F I=1:1:($L(RAPMOD2)/2) S J=$P(RAPMOD2,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240
.S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma
.S ^TMP($J,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_RASTR
Q
DISP1 N RARRAY
MERGE RARRAY=^TMP($J,"RAE4")
D EN^DDIOL(.RARRAY)
Q
KIL1 K ^TMP($J,"RAE4")
Q
;
SETALERT ;
Q:'$D(RASTRING)
N RAPHY1,RAPHY2,RAPNAM,RAPSSN
S RADFN=$P(RASTRING,"/") ; ien patient
S RAPNAM=$$GET1^DIQ(70,+RADFN,.01) S:RAPNAM="" RAPNAM="UNKNOWN"
S RAPSSN=$$GET1^DIQ(70,+RADFN,.09) S:RAPSSN="" RAPSSN="UNKNOWN"
S RAPHY1=$P(RASTRING,"/",6) ; ien 200 requesting physician, before
S RAPHY2=$P(RASTRING,"/",7) ; ien 200 requesting physician, after
;
S XQA(RAPHY1)="",XQAID=$J_","_$H S:$G(RAPHY2)]"" XQA(RAPHY2)=""
S XQAMSG=$E(RAPNAM,1,9)_" ("_$E(RAPNAM,1)_$E(RAPSSN,6,9)_"): Imaging Exam Changed: "_$S($P(RASTRING,"/",5):"Proc., ",1:"")_$S($P(RASTRING,"/",7):"Rqstr, ",1:"")_$S($P(RASTRING,"/",9):"Proc Mod",1:"")
S:$E(XQAMSG,($L(XQAMSG)-1))="," XQAMSG=$E(XQAMSG,1,($L(XQAMSG)-2))
S XQADATA=RASTRING
S XQAROU="ZZ^RAO7PC4(XQADATA)"
D SETUP^XQALERT
Q
;
ZZ(RASTRING) ; Additional text for display when processing alert.
;
N RADFN,RADTI,RACMU,RACNI,RAPROC1,RAPROC2,RAPHY1,RAPHY2,RAPMOD1,RAPMOD2
N RAPNAM,RAPSSN,I,RAPRFR,RAPRTO,RAPHYFR,RAPHYTO,RASTR
S RADFN=$P(RASTRING,"/") ; ien patient
S RADTI=$P(RASTRING,"/",2) ; inverse date of exam
S RACNI=$P(RASTRING,"/",3) ; ien case
S RAPROC1=$P(RASTRING,"/",4) ; ien 71, before
S RAPROC2=$P(RASTRING,"/",5) ; ien 71, after
S RAPHY1=$P(RASTRING,"/",6) ; ien 200 requesting physician, before
S RAPHY2=$P(RASTRING,"/",7) ; ien 200 requesting physician, after
S RAPMOD1=$P(RASTRING,"/",8) ;string of proc mod iens, before
S RAPMOD2=$P(RASTRING,"/",9) ;string of proc mod iens, after
;
S RAPNAM=$$GET1^DIQ(70,+RADFN,.01) S:RAPNAM="" RAPNAM="UNKNOWN"
S RAPSSN=$$GET1^DIQ(70,+RADFN,.09) S:RAPSSN="" RAPSSN="UNKNOWN"
D EN^DDIOL("Imaging Exam For "_$E(RAPNAM,1,30)_" ("_RAPSSN_") Changed:",,"!!?4")
;
S RACMU=$S(+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0))>0:" (CM w/exam)",1:"")
I 'RAPROC2,RAPROC1 D
.S RAPRFR=$E($$GET1^DIQ(71,+RAPROC1,.01),1,50) S:RAPRFR="" RAPRFR="UNKNOWN"
.S RAPRFR=RAPRFR_RACMU D EN^DDIOL("For procedure "_RAPRFR_RACMU,,"!?4")
.D EN^DDIOL(" ",,"!")
.Q
I RAPROC2 D
.S RAPRFR=$E($$GET1^DIQ(71,+RAPROC1,.01),1,53) S:RAPRFR="" RAPRFR="UNKNOWN"
.S RAPRTO=$E($$GET1^DIQ(71,+RAPROC2,.01),1,53) S:RAPRTO="" RAPRTO="UNKNOWN"
.D EN^DDIOL("Procedure changed",,"!?4")
.D EN^DDIOL("From: "_RAPRFR,,"!?8")
.D EN^DDIOL("To: "_RAPRTO_RACMU,,"!?8")
.Q
I RAPHY2 D
.S RAPHYFR=$$GET1^DIQ(200,RAPHY1,.01) S:RAPHYFR="" RAPHYFR="UNKNOWN"
.S RAPHYTO=$$GET1^DIQ(200,RAPHY2,.01) S:RAPHYTO="" RAPHYTO="UNKNOWN"
.D EN^DDIOL("Requesting Physician changed",,"!?4")
.D EN^DDIOL("From: "_RAPHYFR,,"!?8")
.D EN^DDIOL("To: "_RAPHYTO,,"!?8")
.Q
I RAPMOD2!('(RAPMOD2)&(RAPMOD1)) D
.D EN^DDIOL("Procedure Modifier changed",,"!?4")
.S RASTR=""
.F I=1:1:($L(RAPMOD1)/2) S J=$P(RAPMOD1,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240
.S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma
.D EN^DDIOL("From: "_RASTR,,"!?8")
.S RASTR=""
.F I=1:1:($L(RAPMOD2)/2) S J=$P(RAPMOD2,",",I) Q:J="" S RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", " Q:$L(RASTR)>240
.S RASTR=$E(RASTR,1,$L(RASTR)-2) ;rid trailing comma
.D EN^DDIOL("To: "_RASTR,,"!?8")
.Q
Q
;
SETNOTIF(RAIEN751) ; called by RAO7XX if patch OR*3.0*112 is installed
;so that the CPRS notification system can be used to set the alert
Q:'$D(RASTRING)
;RASTRING is : dfn^invdt^caseien^befproc^aftproc^befphy^aftphy
; ^befpmodA,pmodF,etc^aftpmodF,pmodH,etc
;RAIEN751 - IEN file 75.1 RA5P169
;Notification: #67 - IMAGING REQUEST CHANGED
N RAREQPHY,RAOIFN,RAORIFN
S:+$P(RASTRING,"/",6) RAREQPHY(+$P(RASTRING,"/",6))=""
S:+$P(RASTRING,"/",7) RAREQPHY(+$P(RASTRING,"/",7))=""
S RAMSG="Imaging Exam Changed: "_$S($P(RASTRING,"/",5):"Proc., ",1:"")_$S($P(RASTRING,"/",7):"Rqstr, ",1:"")_$S($L($P(RASTRING,"/",8,9))>1:"Proc Mod",1:"")
S:$E(RAMSG,$L(RAMSG)-1)="," RAMSG=$E(RAMSG,1,($L(RAMSG)-2))
S RAOIFN(0)=$G(^RAO(75.1,RAIEN751,0)),RAORIFN=$P(RAOIFN(0),"^",7) ;CPRS order IFN
D EN^ORB3(67,+RASTRING,RAORIFN,.RAREQPHY,RAMSG,RASTRING)
;ORN mustbe 67,dfn,IFN #100,reqphys,messagetitle,string for api
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAO7PC4 7395 printed Dec 13, 2024@02:37:49 Page 2
RAO7PC4 ;HISC/SWM-utilities ; Apr 28, 2020@14:47:40
+1 ;;5.0;Radiology/Nuclear Medicine;**28,32,31,45,77,157,169**;Mar 16, 1998;Build 2
+2 ;08/10/2006 BAY/KAM Remedy Call 134839 Subscript Error
+3 ;
+4 ;IA Type File Routine Tag
+5 ;------------------------------------------------
+6 ;1362 (C) ORB3 EN
+7 ;
+8 QUIT
EN1 ; api for CPRS notification alert #67
+1 if '$DATA(XQADATA)
QUIT
+2 ; set up ^TMP nodes
DO SET1
+3 ; convert and display ^TMP nodes
DO DISP1
+4 ; kill ^TMP nodes
DO KIL1
+5 QUIT
SET1 NEW RADFN,RADTI,RACNI,RAPROC1,RAPROC2,RAPHY1,RAPHY2,RAPMOD1,RAPMOD2,RAACNT
+1 NEW RAPATNAM,RASSN,RASTR,I,J,RACMU,RAOIFN
+2 ; 08/10/2006 BAY/KAM Remedy Call 134839/RA*5*77 - Added next line
+3 if $GET(XQADATA)=""
QUIT
+4 ; ien patient
SET RADFN=$PIECE(XQADATA,"/")
+5 ; counter
SET RAACNT=0
+6 ; inverse date of exam
SET RADTI=$PIECE(XQADATA,"/",2)
+7 ; ien case
SET RACNI=$PIECE(XQADATA,"/",3)
+8 ;p157/KLM Set the before procedure from order if missing from alert data
+9 ; ien 71, before
SET RAPROC1=$PIECE(XQADATA,"/",4)
IF RAPROC1=""
Begin DoDot:1
+10 SET RAOIFN=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
+11 if RAOIFN]""
SET RAPROC1=$PIECE(^RAO(75.1,RAOIFN,0),U,2)
+12 QUIT
End DoDot:1
+13 ; ien 71, after
SET RAPROC2=$PIECE(XQADATA,"/",5)
+14 ; ien 200 requesting physician, before
SET RAPHY1=$PIECE(XQADATA,"/",6)
+15 ; ien 200 requesting physician, after
SET RAPHY2=$PIECE(XQADATA,"/",7)
+16 ;string of proc mod iens, before
SET RAPMOD1=$PIECE(XQADATA,"/",8)
+17 ;string of proc mod iens, after
SET RAPMOD2=$PIECE(XQADATA,"/",9)
+18 KILL ^TMP($JOB,"RAE4")
+19 if '$DATA(^DPT(RADFN,0))
QUIT
+20 SET RAPATNAM=$PIECE(^DPT(RADFN,0),"^")
SET RASSN=$$SSN^RAUTL()
if RASSN=""
SET RASSN="Unkn"
+21 SET RACMU=$SELECT(+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0))>0:" (CM w/exam)",1:"")
+22 SET ^TMP($JOB,"RAE4",1)="Imaging Exam for "_RAPATNAM_" ("_RASSN_") changed:"
+23 IF 'RAPROC2
IF RAPROC1
Begin DoDot:1
+24 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" "
+25 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))="For procedure "_$EXTRACT($PIECE(^RAMIS(71,RAPROC1,0),"^"),1,53)_RACMU
+26 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" "
End DoDot:1
+27 IF RAPROC2
Begin DoDot:1
+28 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" Procedure changed"
+29 ;p157/KLM - add $S for 'unknown' procedure
SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_$SELECT(RAPROC1]"":$EXTRACT($PIECE(^RAMIS(71,RAPROC1,0),"^"),1,53),1:"UNKNOWN")
+30 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_$EXTRACT($PIECE(^RAMIS(71,RAPROC2,0),"^"),1,53)_RACMU
+31 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=""
End DoDot:1
+32 IF RAPHY2
Begin DoDot:1
+33 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" Requesting Physician changed"
+34 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_$$GET1^DIQ(200,RAPHY1,.01)
+35 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_$$GET1^DIQ(200,RAPHY2,.01)
End DoDot:1
+36 IF RAPMOD2!(('RAPMOD2)&(RAPMOD1))
Begin DoDot:1
+37 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" Procedure Modifier changed"
+38 SET RASTR=""
+39 FOR I=1:1:($LENGTH(RAPMOD1)/2)
SET J=$PIECE(RAPMOD1,",",I)
if J=""
QUIT
SET RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", "
if $LENGTH(RASTR)>240
QUIT
+40 ;rid trailing comma and blank
SET RASTR=$EXTRACT(RASTR,1,$LENGTH(RASTR)-2)
+41 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" From: "_RASTR
+42 SET RASTR=""
+43 FOR I=1:1:($LENGTH(RAPMOD2)/2)
SET J=$PIECE(RAPMOD2,",",I)
if J=""
QUIT
SET RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", "
if $LENGTH(RASTR)>240
QUIT
+44 ;rid trailing comma
SET RASTR=$EXTRACT(RASTR,1,$LENGTH(RASTR)-2)
+45 SET ^TMP($JOB,"RAE4",$$INCR^RAUTL4(RAACNT))=" To: "_RASTR
End DoDot:1
+46 QUIT
DISP1 NEW RARRAY
+1 MERGE RARRAY=^TMP($JOB,"RAE4")
+2 DO EN^DDIOL(.RARRAY)
+3 QUIT
KIL1 KILL ^TMP($JOB,"RAE4")
+1 QUIT
+2 ;
SETALERT ;
+1 if '$DATA(RASTRING)
QUIT
+2 NEW RAPHY1,RAPHY2,RAPNAM,RAPSSN
+3 ; ien patient
SET RADFN=$PIECE(RASTRING,"/")
+4 SET RAPNAM=$$GET1^DIQ(70,+RADFN,.01)
if RAPNAM=""
SET RAPNAM="UNKNOWN"
+5 SET RAPSSN=$$GET1^DIQ(70,+RADFN,.09)
if RAPSSN=""
SET RAPSSN="UNKNOWN"
+6 ; ien 200 requesting physician, before
SET RAPHY1=$PIECE(RASTRING,"/",6)
+7 ; ien 200 requesting physician, after
SET RAPHY2=$PIECE(RASTRING,"/",7)
+8 ;
+9 SET XQA(RAPHY1)=""
SET XQAID=$JOB_","_$HOROLOG
if $GET(RAPHY2)]""
SET XQA(RAPHY2)=""
+10 SET XQAMSG=$EXTRACT(RAPNAM,1,9)_" ("_$EXTRACT(RAPNAM,1)_$EXTRACT(RAPSSN,6,9)_"): Imaging Exam Changed: "_$SELECT($PIECE(RASTRING,"/",5):"Proc., ",1:"")_$SELECT($PIECE(RASTRING,"/",7):"Rqstr, ",1:"")_$SELECT($PIECE(RASTRING,"/",9):"Proc Mod",1:"
")
+11 if $EXTRACT(XQAMSG,($LENGTH(XQAMSG)-1))=","
SET XQAMSG=$EXTRACT(XQAMSG,1,($LENGTH(XQAMSG)-2))
+12 SET XQADATA=RASTRING
+13 SET XQAROU="ZZ^RAO7PC4(XQADATA)"
+14 DO SETUP^XQALERT
+15 QUIT
+16 ;
ZZ(RASTRING) ; Additional text for display when processing alert.
+1 ;
+2 NEW RADFN,RADTI,RACMU,RACNI,RAPROC1,RAPROC2,RAPHY1,RAPHY2,RAPMOD1,RAPMOD2
+3 NEW RAPNAM,RAPSSN,I,RAPRFR,RAPRTO,RAPHYFR,RAPHYTO,RASTR
+4 ; ien patient
SET RADFN=$PIECE(RASTRING,"/")
+5 ; inverse date of exam
SET RADTI=$PIECE(RASTRING,"/",2)
+6 ; ien case
SET RACNI=$PIECE(RASTRING,"/",3)
+7 ; ien 71, before
SET RAPROC1=$PIECE(RASTRING,"/",4)
+8 ; ien 71, after
SET RAPROC2=$PIECE(RASTRING,"/",5)
+9 ; ien 200 requesting physician, before
SET RAPHY1=$PIECE(RASTRING,"/",6)
+10 ; ien 200 requesting physician, after
SET RAPHY2=$PIECE(RASTRING,"/",7)
+11 ;string of proc mod iens, before
SET RAPMOD1=$PIECE(RASTRING,"/",8)
+12 ;string of proc mod iens, after
SET RAPMOD2=$PIECE(RASTRING,"/",9)
+13 ;
+14 SET RAPNAM=$$GET1^DIQ(70,+RADFN,.01)
if RAPNAM=""
SET RAPNAM="UNKNOWN"
+15 SET RAPSSN=$$GET1^DIQ(70,+RADFN,.09)
if RAPSSN=""
SET RAPSSN="UNKNOWN"
+16 DO EN^DDIOL("Imaging Exam For "_$EXTRACT(RAPNAM,1,30)_" ("_RAPSSN_") Changed:",,"!!?4")
+17 ;
+18 SET RACMU=$SELECT(+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0))>0:" (CM w/exam)",1:"")
+19 IF 'RAPROC2
IF RAPROC1
Begin DoDot:1
+20 SET RAPRFR=$EXTRACT($$GET1^DIQ(71,+RAPROC1,.01),1,50)
if RAPRFR=""
SET RAPRFR="UNKNOWN"
+21 SET RAPRFR=RAPRFR_RACMU
DO EN^DDIOL("For procedure "_RAPRFR_RACMU,,"!?4")
+22 DO EN^DDIOL(" ",,"!")
+23 QUIT
End DoDot:1
+24 IF RAPROC2
Begin DoDot:1
+25 SET RAPRFR=$EXTRACT($$GET1^DIQ(71,+RAPROC1,.01),1,53)
if RAPRFR=""
SET RAPRFR="UNKNOWN"
+26 SET RAPRTO=$EXTRACT($$GET1^DIQ(71,+RAPROC2,.01),1,53)
if RAPRTO=""
SET RAPRTO="UNKNOWN"
+27 DO EN^DDIOL("Procedure changed",,"!?4")
+28 DO EN^DDIOL("From: "_RAPRFR,,"!?8")
+29 DO EN^DDIOL("To: "_RAPRTO_RACMU,,"!?8")
+30 QUIT
End DoDot:1
+31 IF RAPHY2
Begin DoDot:1
+32 SET RAPHYFR=$$GET1^DIQ(200,RAPHY1,.01)
if RAPHYFR=""
SET RAPHYFR="UNKNOWN"
+33 SET RAPHYTO=$$GET1^DIQ(200,RAPHY2,.01)
if RAPHYTO=""
SET RAPHYTO="UNKNOWN"
+34 DO EN^DDIOL("Requesting Physician changed",,"!?4")
+35 DO EN^DDIOL("From: "_RAPHYFR,,"!?8")
+36 DO EN^DDIOL("To: "_RAPHYTO,,"!?8")
+37 QUIT
End DoDot:1
+38 IF RAPMOD2!('(RAPMOD2)&(RAPMOD1))
Begin DoDot:1
+39 DO EN^DDIOL("Procedure Modifier changed",,"!?4")
+40 SET RASTR=""
+41 FOR I=1:1:($LENGTH(RAPMOD1)/2)
SET J=$PIECE(RAPMOD1,",",I)
if J=""
QUIT
SET RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", "
if $LENGTH(RASTR)>240
QUIT
+42 ;rid trailing comma
SET RASTR=$EXTRACT(RASTR,1,$LENGTH(RASTR)-2)
+43 DO EN^DDIOL("From: "_RASTR,,"!?8")
+44 SET RASTR=""
+45 FOR I=1:1:($LENGTH(RAPMOD2)/2)
SET J=$PIECE(RAPMOD2,",",I)
if J=""
QUIT
SET RASTR=RASTR_$$GET1^DIQ(71.2,J,.01)_", "
if $LENGTH(RASTR)>240
QUIT
+46 ;rid trailing comma
SET RASTR=$EXTRACT(RASTR,1,$LENGTH(RASTR)-2)
+47 DO EN^DDIOL("To: "_RASTR,,"!?8")
+48 QUIT
End DoDot:1
+49 QUIT
+50 ;
SETNOTIF(RAIEN751) ; called by RAO7XX if patch OR*3.0*112 is installed
+1 ;so that the CPRS notification system can be used to set the alert
+2 if '$DATA(RASTRING)
QUIT
+3 ;RASTRING is : dfn^invdt^caseien^befproc^aftproc^befphy^aftphy
+4 ; ^befpmodA,pmodF,etc^aftpmodF,pmodH,etc
+5 ;RAIEN751 - IEN file 75.1 RA5P169
+6 ;Notification: #67 - IMAGING REQUEST CHANGED
+7 NEW RAREQPHY,RAOIFN,RAORIFN
+8 if +$PIECE(RASTRING,"/",6)
SET RAREQPHY(+$PIECE(RASTRING,"/",6))=""
+9 if +$PIECE(RASTRING,"/",7)
SET RAREQPHY(+$PIECE(RASTRING,"/",7))=""
+10 SET RAMSG="Imaging Exam Changed: "_$SELECT($PIECE(RASTRING,"/",5):"Proc., ",1:"")_$SELECT($PIECE(RASTRING,"/",7):"Rqstr, ",1:"")_$SELECT($LENGTH($PIECE(RASTRING,"/",8,9))>1:"Proc Mod",1:"")
+11 if $EXTRACT(RAMSG,$LENGTH(RAMSG)-1)=","
SET RAMSG=$EXTRACT(RAMSG,1,($LENGTH(RAMSG)-2))
+12 ;CPRS order IFN
SET RAOIFN(0)=$GET(^RAO(75.1,RAIEN751,0))
SET RAORIFN=$PIECE(RAOIFN(0),"^",7)
+13 DO EN^ORB3(67,+RASTRING,RAORIFN,.RAREQPHY,RAMSG,RASTRING)
+14 ;ORN mustbe 67,dfn,IFN #100,reqphys,messagetitle,string for api
+15 QUIT
+16 ;
