- 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 Mar 13, 2025@21:42:34 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 ;
