RAO7RCH ;HISC/GJC,FPT-Process Discontinued Message ;9/4/97 09:11
;;5.0;Radiology/Nuclear Medicine;**15**;Mar 16, 1998
;
;------------------------- Variable List -------------------------------
; RADATA=HL7 data minus seg. hdr RAHDR=Segment header
; RAHLFS="|" RAMSG=HL7 message passed in
; RAORC1=order control RAORC10=entered by (200)
; RAORC16=order control reason RAORC2=placer order #_"^OR"
; RAORC3=filler order #_"^RA" RAPID3=patient ID
; RAPID5=patient name (2) RASEG=message seg. including header
; ----------------------------------------------------------------------
EN1(RAMSG) ;
D BRKOUT^RAO7UTL1
; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3, & RADIV(.119)
S (RAERR,RALINEX)=0
F S RALINEX=$O(RAMSG(RALINEX)) Q:RALINEX'>0 D Q:RAERR
. S RASEG=$G(RAMSG(RALINEX)) Q:$P(RASEG,RAHLFS)="MSH" ; quit if MSH segment
. S RAHDR=$P(RASEG,RAHLFS),RADATA=$P(RASEG,RAHLFS,2,999)
. D @$S(RAHDR="PID":"PID",RAHDR="ORC":"ORC",1:"ERR")
. Q
Q
PID ; breakdown the 'PID' segment
S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2
Q
ORC ; breakdown the 'ORC' segment
S RAERR=$$EN3^RAO7VLD(75.1,+RAORC3) S:RAERR RAERR=22 Q:RAERR
S RA0=$G(^RAO(75.1,+RAORC3,0))
S RASTATUS=+$P(RA0,U,5)
I "358"'[$E(RASTATUS) S RAERR=25 Q
S RAORC10=$P(RADATA,RAHLFS,10)
S RAERR=$$EN3^RAO7VLD(200,+RAORC10) S:RAERR RAERR=4 Q:RAERR
S RAORC16=$P($P(RADATA,RAHLFS,16),"^",4) ;Rad Reason file ien
S RAORC161=$P($P(RADATA,RAHLFS,16),"^",5) ; Cancel Description
D Q:RAERR
.S RANEW(75.1,+RAORC3_",",23)="@"
.I RAORC16']"",(RAORC161']"") Q
.I RAORC16]"",'$D(^RA(75.2,+RAORC16,0)),RAORC161']"" S RAERR=23 Q
.S RANEW(75.1,+RAORC3_",",10)=RAORC16
.S RANEW(75.1,+RAORC3_",",27)=RAORC161
S RANEW(75.1,+RAORC3_",",5)=1
S RANEW(75.1,+RAORC3_",",18)=RALDT
Q
ERR ; error control - file 'soft' errors with CPRS
N RAVAR S RAVAR("XQY0")=""
D ERR^RAO7UTL("HL7 message missing 'PID' & 'ORC' segments",.RAMSG,.RAVAR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAO7RCH 2024 printed Apr 09, 2024@21:40:37 Page 2
RAO7RCH ;HISC/GJC,FPT-Process Discontinued Message ;9/4/97 09:11
+1 ;;5.0;Radiology/Nuclear Medicine;**15**;Mar 16, 1998
+2 ;
+3 ;------------------------- Variable List -------------------------------
+4 ; RADATA=HL7 data minus seg. hdr RAHDR=Segment header
+5 ; RAHLFS="|" RAMSG=HL7 message passed in
+6 ; RAORC1=order control RAORC10=entered by (200)
+7 ; RAORC16=order control reason RAORC2=placer order #_"^OR"
+8 ; RAORC3=filler order #_"^RA" RAPID3=patient ID
+9 ; RAPID5=patient name (2) RASEG=message seg. including header
+10 ; ----------------------------------------------------------------------
EN1(RAMSG) ;
+1 DO BRKOUT^RAO7UTL1
+2 ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3, & RADIV(.119)
+3 SET (RAERR,RALINEX)=0
+4 FOR
SET RALINEX=$ORDER(RAMSG(RALINEX))
if RALINEX'>0
QUIT
Begin DoDot:1
+5 ; quit if MSH segment
SET RASEG=$GET(RAMSG(RALINEX))
if $PIECE(RASEG,RAHLFS)="MSH"
QUIT
+6 SET RAHDR=$PIECE(RASEG,RAHLFS)
SET RADATA=$PIECE(RASEG,RAHLFS,2,999)
+7 DO @$SELECT(RAHDR="PID":"PID",RAHDR="ORC":"ORC",1:"ERR")
+8 QUIT
End DoDot:1
if RAERR
QUIT
+9 QUIT
PID ; breakdown the 'PID' segment
+1 SET RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5)
if RAERR
SET RAERR=2
+2 QUIT
ORC ; breakdown the 'ORC' segment
+1 SET RAERR=$$EN3^RAO7VLD(75.1,+RAORC3)
if RAERR
SET RAERR=22
if RAERR
QUIT
+2 SET RA0=$GET(^RAO(75.1,+RAORC3,0))
+3 SET RASTATUS=+$PIECE(RA0,U,5)
+4 IF "358"'[$EXTRACT(RASTATUS)
SET RAERR=25
QUIT
+5 SET RAORC10=$PIECE(RADATA,RAHLFS,10)
+6 SET RAERR=$$EN3^RAO7VLD(200,+RAORC10)
if RAERR
SET RAERR=4
if RAERR
QUIT
+7 ;Rad Reason file ien
SET RAORC16=$PIECE($PIECE(RADATA,RAHLFS,16),"^",4)
+8 ; Cancel Description
SET RAORC161=$PIECE($PIECE(RADATA,RAHLFS,16),"^",5)
+9 Begin DoDot:1
+10 SET RANEW(75.1,+RAORC3_",",23)="@"
+11 IF RAORC16']""
IF (RAORC161']"")
QUIT
+12 IF RAORC16]""
IF '$DATA(^RA(75.2,+RAORC16,0))
IF RAORC161']""
SET RAERR=23
QUIT
+13 SET RANEW(75.1,+RAORC3_",",10)=RAORC16
+14 SET RANEW(75.1,+RAORC3_",",27)=RAORC161
End DoDot:1
if RAERR
QUIT
+15 SET RANEW(75.1,+RAORC3_",",5)=1
+16 SET RANEW(75.1,+RAORC3_",",18)=RALDT
+17 QUIT
ERR ; error control - file 'soft' errors with CPRS
+1 NEW RAVAR
SET RAVAR("XQY0")=""
+2 DO ERR^RAO7UTL("HL7 message missing 'PID' & 'ORC' segments",.RAMSG,.RAVAR)
+3 QUIT
