RAO7ROCN ;HISC/GJC-'DE' (error) message from OE/RR process. ; Jul 01, 2020@09:30:29
;;5.0;Radiology/Nuclear Medicine;**169**;Mar 16, 1998;Build 2
;
; Input: RARY=CPRS HL7 order message
; RAORD = Order control (ORC-1)
; ----------------------------------------------------------------------
;
EN1(RARY) ; 'DE' (error) message from OE/RR. File the cancel
;reason in the CANCEL DESCRIPTION (75.1;27) field. Note: RAORD="DE"
;
;Radiology basically ignored the "DE" message. Not anymore...
;
;OREMSG(1)="MSH|^~\&|ORDER ENTRY|16066|RADIOLOGY|16066|20200218145711-0600||ORR"
;OREMSG(2)="PID|||7171880||ZZZ,DUDE"
; PID-3 is the DFN of the patient
;OREMSG(3)="ORC|DE||1011^RA|||||||1786||||||Missing or invalid patient location"
; ORC-3.1 is the IEN of the RIS order (RAOIFN)
; ORC-10 is the person who entered the order (DFN of user in NEW PERSON file)
; ORC-16 is cancel reason to be filed as the CANCEL DESCRIPTION (75.1;27)
; truncate ORC-16 to forty characters max.
N I,RACS,RADFN,RAESC,RAFS,RANME,RAOIFN,RASEG,RAWHO,RAX,RAXX,RAY
;
;RAFS = field separator & RACS = component separator
S RAY=+$O(RARY(0)) S RAX=$G(RARY(RAY))
I $E(RAX,1,3)="MSH" S RAFS=$E(RAX,4),RACS=$E($P(RAX,RAFS,2),1)
;
E QUIT
;
F S RAY=$O(RARY(RAY)) Q:RAY'>0 D
.S RAX=$G(RARY(RAY)),RASEG=$E(RAX,1,3)
.S RAXX=$P(RAX,RAFS,2,99) ;strip of segment id
.D @$S(RASEG="PID":"PID",RASEG="ORC":"ORC",1:"ERR")
.Q
UPDB ;update RIS report database conditionally...
;If there is a study for this RIS order w/o a CPRS
;order IEN it's a legacy study. Don't cancel the order
;path: RAORDU -> RAORDC -> RAO7ROCN
Q:$D(^RADPT("AO",RAOIFN,$G(RADFN,-1),$G(RADTI,-1),$G(RACNI,-1)))#2
D FILE
Q
;
FILE ;file data in REQUEST STATUS (fld: 5) and CANCEL
;DESCRIPTION (fld: 27)
L +^RAO(75.1,RAOIFN):$G(DILOCKTM,25)
I '$T QUIT
N RAERR,RAFDA,RAIEN,RAPROC S RAIEN=RAOIFN_","
S RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0))
S RAPROC=$E($P($G(^RAMIS(71,+$P(RAOIFN(0),U,2),0)),U),1,30) ;1st 30 of proc name
S RAFDA(75.1,RAIEN,5)=13 ;cancelled **new ** (keep consistent spelling)
S RAFDA(75.1,RAIEN,27)=RAREA
D FILE^DIE("","RAFDA","RAERR")
I $D(RAERR)#2 L -^RAO(75.1,RAOIFN) QUIT
;update (#75) REQUEST STATUS TIMES @75.12
K RAFDA,RAIEN S RAIEN="+1,"_RAOIFN_","
S RAFDA(75.12,RAIEN,.01)=$E($$NOW^XLFDT(),1,12)
S RAFDA(75.12,RAIEN,2)=13 ;canceled
S RAFDA(75.12,RAIEN,3)=+RAWHO
D UPDATE^DIE("","RAFDA")
L -^RAO(75.1,RAOIFN)
W !!,"Order for ",RAPROC," has been rejected by CPRS.",!,"Reason: ",RAREA
;b/c the order is canceled we need to make sure we're exiting
;RA ORDEREXAM 'Request an Exam'
; RAOUT: checked in ADDORD1^RAORD1
;RADERR: checked in RAORDQ
S (RAOUT,RADERR)=1
Q
;
PID ; PID segment
S RADFN=$P(RAXX,RAFS,3) ;DFN file 2
S RANME=$P(RAXX,RAFS,5) ;patient name: last, first middle
Q
;
ORC ;ORC segment
;IEN file 75.1 of RIS order canceled
S RAOIFN=+$P(RAXX,RAFS,3)
;IEN file 200 or empty
S RAWHO=$P(RAXX,RAFS,10)
;cancel description or empty found in
;SN/SNQ^ORMRA.
S RAREA=$E($P(RAXX,RAFS,16),1,40) ;safety first... :')
Q
;
TXT ;for testing only...
S OREMSG(1)="MSH|^~\&|ORDER ENTRY|16066|RADIOLOGY|16066|20200218145711-0600||ORR"
S OREMSG(2)="PID|||7171880||ZZZ,DUDE"
; PID-3 is the DFN of the patient
S OREMSG(3)="ORC|DE||1026^RA|||||||1787||||||Missing or invalid patient location"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAO7ROCN 3411 printed Apr 09, 2024@21:42:23 Page 2
RAO7ROCN ;HISC/GJC-'DE' (error) message from OE/RR process. ; Jul 01, 2020@09:30:29
+1 ;;5.0;Radiology/Nuclear Medicine;**169**;Mar 16, 1998;Build 2
+2 ;
+3 ; Input: RARY=CPRS HL7 order message
+4 ; RAORD = Order control (ORC-1)
+5 ; ----------------------------------------------------------------------
+6 ;
EN1(RARY) ; 'DE' (error) message from OE/RR. File the cancel
+1 ;reason in the CANCEL DESCRIPTION (75.1;27) field. Note: RAORD="DE"
+2 ;
+3 ;Radiology basically ignored the "DE" message. Not anymore...
+4 ;
+5 ;OREMSG(1)="MSH|^~\&|ORDER ENTRY|16066|RADIOLOGY|16066|20200218145711-0600||ORR"
+6 ;OREMSG(2)="PID|||7171880||ZZZ,DUDE"
+7 ; PID-3 is the DFN of the patient
+8 ;OREMSG(3)="ORC|DE||1011^RA|||||||1786||||||Missing or invalid patient location"
+9 ; ORC-3.1 is the IEN of the RIS order (RAOIFN)
+10 ; ORC-10 is the person who entered the order (DFN of user in NEW PERSON file)
+11 ; ORC-16 is cancel reason to be filed as the CANCEL DESCRIPTION (75.1;27)
+12 ; truncate ORC-16 to forty characters max.
+13 NEW I,RACS,RADFN,RAESC,RAFS,RANME,RAOIFN,RASEG,RAWHO,RAX,RAXX,RAY
+14 ;
+15 ;RAFS = field separator & RACS = component separator
+16 SET RAY=+$ORDER(RARY(0))
SET RAX=$GET(RARY(RAY))
+17 IF $EXTRACT(RAX,1,3)="MSH"
SET RAFS=$EXTRACT(RAX,4)
SET RACS=$EXTRACT($PIECE(RAX,RAFS,2),1)
+18 ;
+19 IF '$TEST
QUIT
+20 ;
+21 FOR
SET RAY=$ORDER(RARY(RAY))
if RAY'>0
QUIT
Begin DoDot:1
+22 SET RAX=$GET(RARY(RAY))
SET RASEG=$EXTRACT(RAX,1,3)
+23 ;strip of segment id
SET RAXX=$PIECE(RAX,RAFS,2,99)
+24 DO @$SELECT(RASEG="PID":"PID",RASEG="ORC":"ORC",1:"ERR")
+25 QUIT
End DoDot:1
UPDB ;update RIS report database conditionally...
+1 ;If there is a study for this RIS order w/o a CPRS
+2 ;order IEN it's a legacy study. Don't cancel the order
+3 ;path: RAORDU -> RAORDC -> RAO7ROCN
+4 if $DATA(^RADPT("AO",RAOIFN,$GET(RADFN,-1),$GET(RADTI,-1),$GET(RACNI,-1)))#2
QUIT
+5 DO FILE
+6 QUIT
+7 ;
FILE ;file data in REQUEST STATUS (fld: 5) and CANCEL
+1 ;DESCRIPTION (fld: 27)
+2 LOCK +^RAO(75.1,RAOIFN):$GET(DILOCKTM,25)
+3 IF '$TEST
QUIT
+4 NEW RAERR,RAFDA,RAIEN,RAPROC
SET RAIEN=RAOIFN_","
+5 SET RAOIFN(0)=$GET(^RAO(75.1,RAOIFN,0))
+6 ;1st 30 of proc name
SET RAPROC=$EXTRACT($PIECE($GET(^RAMIS(71,+$PIECE(RAOIFN(0),U,2),0)),U),1,30)
+7 ;cancelled **new ** (keep consistent spelling)
SET RAFDA(75.1,RAIEN,5)=13
+8 SET RAFDA(75.1,RAIEN,27)=RAREA
+9 DO FILE^DIE("","RAFDA","RAERR")
+10 IF $DATA(RAERR)#2
LOCK -^RAO(75.1,RAOIFN)
QUIT
+11 ;update (#75) REQUEST STATUS TIMES @75.12
+12 KILL RAFDA,RAIEN
SET RAIEN="+1,"_RAOIFN_","
+13 SET RAFDA(75.12,RAIEN,.01)=$EXTRACT($$NOW^XLFDT(),1,12)
+14 ;canceled
SET RAFDA(75.12,RAIEN,2)=13
+15 SET RAFDA(75.12,RAIEN,3)=+RAWHO
+16 DO UPDATE^DIE("","RAFDA")
+17 LOCK -^RAO(75.1,RAOIFN)
+18 WRITE !!,"Order for ",RAPROC," has been rejected by CPRS.",!,"Reason: ",RAREA
+19 ;b/c the order is canceled we need to make sure we're exiting
+20 ;RA ORDEREXAM 'Request an Exam'
+21 ; RAOUT: checked in ADDORD1^RAORD1
+22 ;RADERR: checked in RAORDQ
+23 SET (RAOUT,RADERR)=1
+24 QUIT
+25 ;
PID ; PID segment
+1 ;DFN file 2
SET RADFN=$PIECE(RAXX,RAFS,3)
+2 ;patient name: last, first middle
SET RANME=$PIECE(RAXX,RAFS,5)
+3 QUIT
+4 ;
ORC ;ORC segment
+1 ;IEN file 75.1 of RIS order canceled
+2 SET RAOIFN=+$PIECE(RAXX,RAFS,3)
+3 ;IEN file 200 or empty
+4 SET RAWHO=$PIECE(RAXX,RAFS,10)
+5 ;cancel description or empty found in
+6 ;SN/SNQ^ORMRA.
+7 ;safety first... :')
SET RAREA=$EXTRACT($PIECE(RAXX,RAFS,16),1,40)
+8 QUIT
+9 ;
TXT ;for testing only...
+1 SET OREMSG(1)="MSH|^~\&|ORDER ENTRY|16066|RADIOLOGY|16066|20200218145711-0600||ORR"
+2 SET OREMSG(2)="PID|||7171880||ZZZ,DUDE"
+3 ; PID-3 is the DFN of the patient
+4 SET OREMSG(3)="ORC|DE||1026^RA|||||||1787||||||Missing or invalid patient location"
+5 QUIT
+6 ;
