- RAO7RON ;HISC/GJC- Request message from OE/RR. (frontdoor) ;2/2/98 12:34
- ;;5.0;Radiology/Nuclear Medicine;**41,75,86**;Mar 16, 1998;Build 7
- ;
- ;Supported IA #10040 reference to ^SC
- ;Supported IA #2187 reference to EN^ORERR
- ;Supported IA #10103 reference to ^XLFDT
- ;Supported IA #10141 reference to ^XPDUTL
- ;Supported IA #10106 reference to $$FMDATE^HLFNC
- ;
- ;------------------------- Variable List -------------------------------
- ; RADATA=HL7 data minus seg. hdr RAHDR=Segment header
- ; RAHLFS="|" RAMSG=HL7 message passed in
- ; RAOBR12=danger code RAOBR18=modifier
- ; RAOBR19=hosp. loc. pntr (44) RAOBR30=trans. mode
- ; RAOBR4=univ. trans. mode RAOBX2=format of observ. value
- ; RAOBX3=observ. ID RAOBX5=observ. value
- ; RAORC1=order control RAORC10=entered by (200)
- ; RAORC11=approving rad/nm phys (for some procedures only)
- ; RAORC12=ordering provider (200) RAORC15=order effective D/T
- ; RAORC16=order control reason RAORC2=placer order #_"^OR"
- ; RAORC3=filler order #_"^RA" RAORC7=start dt/freq. of service
- ; RAPID3=patient ID RAPID5=patient name (2)
- ; RAPV119=visit # RAPV12=patient class
- ; RAPV13=patient location (44) RASEG=message seg. including header
- ; ----------------------------------------------------------------------
- EN1(RAMSG) ; Pass in the message from RAO7RO. Decipher information.
- D BRKOUT^RAO7UTL1
- ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3 & RADIV(.119)
- S (RAERR,RAWP,RALINEX)=0,RACLIN="^" K ^TMP("RAWP",$J)
- 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="PV1":"PV1",RAHDR="ORC":"ORC",RAHDR="OBR":"OBR^RAO7RON1",RAHDR="OBX":"OBX^RAO7RON1",RAHDR="DG1":"GETCPRS^RABWORD1",RAHDR="ZCL":"GETCPRS^RABWORD1",1:"ERR")
- . Q
- S RANEW(75.1,"+1,",18)=RALDT
- Q
- PID ; breakdown the 'PID' segment
- S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2
- I 'RAERR S RANEW(75.1,"+1,",.01)=RAPID3
- Q
- PV1 ; breakdown the 'PV1' segment
- S RAPV12=$P(RADATA,RAHLFS,2)
- S RAERR=$$EN1^RAO7VLD(75.1,4,"E",RAPV12,"RASULT","") S:RAERR RAERR=27 Q:RAERR
- S RANEW(75.1,"+1,",4)=RAPV12
- S RAPV13=$P(RADATA,RAHLFS,3)
- S RAERR=$$EN3^RAO7VLD(44,+RAPV13) S:RAERR RAERR=3 Q:RAERR
- S RANEW(75.1,"+1,",22)=+RAPV13
- ;check the GUI version of CPRS at this facility:
- ;$$PATCH^XPDUTL("OR*3.0*243")=1 CPRS V27, else CPRS V26.
- I '$$PATCH^XPDUTL("OR*3.0*243") D Q:RAERR ;P86
- .I RAPV12="I",$P(^SC($P(RAPV13,U,1),0),U,3)'="W" S RAERR=9 Q
- .I RAPV12="O",$P(^SC($P(RAPV13,U,1),0),U,3)="W" S RAERR=9
- .Q
- S RAPV119=$P(RADATA,RAHLFS,19)
- Q
- ORC ; breakdown the 'ORC' segment
- ; RAORC7D is: timestamp HL7 format
- ; RAORC7P is: priority/urgency
- S:+RAORC2'>0 RAERR=16 Q:RAERR
- S RANEW(75.1,"+1,",7)=+RAORC2
- S RANEW(75.1,"+1,",5)=5
- S RAORC7=$P(RADATA,RAHLFS,7)
- S RAORC7D=$P(RAORC7,RAECH(1),4)
- S RAORC7D=$$FMDATE^HLFNC(RAORC7D)
- S RAERR=$$EN1^RAO7VLD(75.1,21,"E",RAORC7D,"RASULT","") S:RAERR RAERR=28 Q:RAERR
- S RANEW(75.1,"+1,",21)=RAORC7D
- S X=$P(RAORC7,RAECH(1),6)
- S RAORC7P=$S(X="S":1,X="A":2,X="R":9,1:"") I +RAORC7P'>0 S RAERR=5 Q
- S RANEW(75.1,"+1,",6)=RAORC7P
- S RAORC10=$P(RADATA,RAHLFS,10)
- S RAERR=$$EN3^RAO7VLD(200,RAORC10) S:RAERR RAERR=4 Q:RAERR
- S RANEW(75.1,"+1,",15)=RAORC10
- S RAORC11=$P(RADATA,RAHLFS,11) ;approving rad/nm phys for some proc's
- I $G(RAORC11) S RAERR=$$EN3^RAO7VLD(200,RAORC11) S:RAERR RAERR=36 Q:RAERR
- I $G(RAORC11) S RANEW(75.1,"+1,",8)=RAORC11
- S RAORC12=$P(RADATA,RAHLFS,12)
- S RAERR=$$EN3^RAO7VLD(200,RAORC12) S:RAERR RAERR=6 Q:RAERR
- S RANEW(75.1,"+1,",14)=RAORC12
- S RAORC15=$P(RADATA,RAHLFS,15)
- S RAORC15=$$FMDATE^HLFNC(RAORC15)
- ;The order entered dt/time validity ck results are ignored because we
- ;have never been able to determine why FileMan erroneously rejects
- ;some date/times in a Silent FM call. We now assume this date is OK.
- S RAERR=$$EN1^RAO7VLD(75.1,16,"E",RAORC15,"RASULT","") S:RAERR RAERR=35
- ;Q:RAERR
- I RAERR D S RAERR=0
- . N I,RAX,RAVARS,RAERRDT
- . S RAX=$G(^TMP("DIERR",$J,1,"TEXT",1))
- . S RAERRDT=$$NOW^XLFDT()
- . F I="RAX","RAORC15","RAERRDT","RAERR" S RAVARS(I)=""
- . S:$D(X) RAVARS("X")="" S:$D(%DT) RAVARS("%DT")=""
- . S:$D(%DT(0)) RAVARS("%DT(0)")=""
- . ;S RAVARS("RAX")="",RAVARS("RAORC15")="",RAVARS("RAERRDT")="",RAVARS("RAERR")=""
- . D EN^ORERR("RAD MYSTERY ERROR",.RAMSG,.RAVARS)
- . Q
- S RANOW=$$NOW^XLFDT() I RANOW<RAORC15 S RAERR=7 Q
- S RANEW(75.1,"+1,",16)=RAORC15
- Q
- ERR ; error control - file 'soft' errors with CPRS
- N RAVAR S RAVAR("XQY0")=""
- D ERR^RAO7UTL("HL7 message with unknown segment header",.RAMSG,.RAVAR)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAO7RON 4829 printed Feb 19, 2025@00:04:10 Page 2
- RAO7RON ;HISC/GJC- Request message from OE/RR. (frontdoor) ;2/2/98 12:34
- +1 ;;5.0;Radiology/Nuclear Medicine;**41,75,86**;Mar 16, 1998;Build 7
- +2 ;
- +3 ;Supported IA #10040 reference to ^SC
- +4 ;Supported IA #2187 reference to EN^ORERR
- +5 ;Supported IA #10103 reference to ^XLFDT
- +6 ;Supported IA #10141 reference to ^XPDUTL
- +7 ;Supported IA #10106 reference to $$FMDATE^HLFNC
- +8 ;
- +9 ;------------------------- Variable List -------------------------------
- +10 ; RADATA=HL7 data minus seg. hdr RAHDR=Segment header
- +11 ; RAHLFS="|" RAMSG=HL7 message passed in
- +12 ; RAOBR12=danger code RAOBR18=modifier
- +13 ; RAOBR19=hosp. loc. pntr (44) RAOBR30=trans. mode
- +14 ; RAOBR4=univ. trans. mode RAOBX2=format of observ. value
- +15 ; RAOBX3=observ. ID RAOBX5=observ. value
- +16 ; RAORC1=order control RAORC10=entered by (200)
- +17 ; RAORC11=approving rad/nm phys (for some procedures only)
- +18 ; RAORC12=ordering provider (200) RAORC15=order effective D/T
- +19 ; RAORC16=order control reason RAORC2=placer order #_"^OR"
- +20 ; RAORC3=filler order #_"^RA" RAORC7=start dt/freq. of service
- +21 ; RAPID3=patient ID RAPID5=patient name (2)
- +22 ; RAPV119=visit # RAPV12=patient class
- +23 ; RAPV13=patient location (44) RASEG=message seg. including header
- +24 ; ----------------------------------------------------------------------
- EN1(RAMSG) ; Pass in the message from RAO7RO. Decipher information.
- +1 DO BRKOUT^RAO7UTL1
- +2 ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3 & RADIV(.119)
- +3 SET (RAERR,RAWP,RALINEX)=0
- SET RACLIN="^"
- KILL ^TMP("RAWP",$JOB)
- +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="PV1":"PV1",RAHDR="ORC":"ORC",RAHDR="OBR":"OBR^RAO7RON1",RAHDR="OBX":"OBX^RAO7RON1",RAHDR="DG1":"GETCPRS^RABWORD1",RAHDR="ZCL":"GETCPRS^RABWORD1",1:"ERR")
- +8 QUIT
- End DoDot:1
- if RAERR
- QUIT
- +9 SET RANEW(75.1,"+1,",18)=RALDT
- +10 QUIT
- PID ; breakdown the 'PID' segment
- +1 SET RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5)
- if RAERR
- SET RAERR=2
- +2 IF 'RAERR
- SET RANEW(75.1,"+1,",.01)=RAPID3
- +3 QUIT
- PV1 ; breakdown the 'PV1' segment
- +1 SET RAPV12=$PIECE(RADATA,RAHLFS,2)
- +2 SET RAERR=$$EN1^RAO7VLD(75.1,4,"E",RAPV12,"RASULT","")
- if RAERR
- SET RAERR=27
- if RAERR
- QUIT
- +3 SET RANEW(75.1,"+1,",4)=RAPV12
- +4 SET RAPV13=$PIECE(RADATA,RAHLFS,3)
- +5 SET RAERR=$$EN3^RAO7VLD(44,+RAPV13)
- if RAERR
- SET RAERR=3
- if RAERR
- QUIT
- +6 SET RANEW(75.1,"+1,",22)=+RAPV13
- +7 ;check the GUI version of CPRS at this facility:
- +8 ;$$PATCH^XPDUTL("OR*3.0*243")=1 CPRS V27, else CPRS V26.
- +9 ;P86
- IF '$$PATCH^XPDUTL("OR*3.0*243")
- Begin DoDot:1
- +10 IF RAPV12="I"
- IF $PIECE(^SC($PIECE(RAPV13,U,1),0),U,3)'="W"
- SET RAERR=9
- QUIT
- +11 IF RAPV12="O"
- IF $PIECE(^SC($PIECE(RAPV13,U,1),0),U,3)="W"
- SET RAERR=9
- +12 QUIT
- End DoDot:1
- if RAERR
- QUIT
- +13 SET RAPV119=$PIECE(RADATA,RAHLFS,19)
- +14 QUIT
- ORC ; breakdown the 'ORC' segment
- +1 ; RAORC7D is: timestamp HL7 format
- +2 ; RAORC7P is: priority/urgency
- +3 if +RAORC2'>0
- SET RAERR=16
- if RAERR
- QUIT
- +4 SET RANEW(75.1,"+1,",7)=+RAORC2
- +5 SET RANEW(75.1,"+1,",5)=5
- +6 SET RAORC7=$PIECE(RADATA,RAHLFS,7)
- +7 SET RAORC7D=$PIECE(RAORC7,RAECH(1),4)
- +8 SET RAORC7D=$$FMDATE^HLFNC(RAORC7D)
- +9 SET RAERR=$$EN1^RAO7VLD(75.1,21,"E",RAORC7D,"RASULT","")
- if RAERR
- SET RAERR=28
- if RAERR
- QUIT
- +10 SET RANEW(75.1,"+1,",21)=RAORC7D
- +11 SET X=$PIECE(RAORC7,RAECH(1),6)
- +12 SET RAORC7P=$SELECT(X="S":1,X="A":2,X="R":9,1:"")
- IF +RAORC7P'>0
- SET RAERR=5
- QUIT
- +13 SET RANEW(75.1,"+1,",6)=RAORC7P
- +14 SET RAORC10=$PIECE(RADATA,RAHLFS,10)
- +15 SET RAERR=$$EN3^RAO7VLD(200,RAORC10)
- if RAERR
- SET RAERR=4
- if RAERR
- QUIT
- +16 SET RANEW(75.1,"+1,",15)=RAORC10
- +17 ;approving rad/nm phys for some proc's
- SET RAORC11=$PIECE(RADATA,RAHLFS,11)
- +18 IF $GET(RAORC11)
- SET RAERR=$$EN3^RAO7VLD(200,RAORC11)
- if RAERR
- SET RAERR=36
- if RAERR
- QUIT
- +19 IF $GET(RAORC11)
- SET RANEW(75.1,"+1,",8)=RAORC11
- +20 SET RAORC12=$PIECE(RADATA,RAHLFS,12)
- +21 SET RAERR=$$EN3^RAO7VLD(200,RAORC12)
- if RAERR
- SET RAERR=6
- if RAERR
- QUIT
- +22 SET RANEW(75.1,"+1,",14)=RAORC12
- +23 SET RAORC15=$PIECE(RADATA,RAHLFS,15)
- +24 SET RAORC15=$$FMDATE^HLFNC(RAORC15)
- +25 ;The order entered dt/time validity ck results are ignored because we
- +26 ;have never been able to determine why FileMan erroneously rejects
- +27 ;some date/times in a Silent FM call. We now assume this date is OK.
- +28 SET RAERR=$$EN1^RAO7VLD(75.1,16,"E",RAORC15,"RASULT","")
- if RAERR
- SET RAERR=35
- +29 ;Q:RAERR
- +30 IF RAERR
- Begin DoDot:1
- +31 NEW I,RAX,RAVARS,RAERRDT
- +32 SET RAX=$GET(^TMP("DIERR",$JOB,1,"TEXT",1))
- +33 SET RAERRDT=$$NOW^XLFDT()
- +34 FOR I="RAX","RAORC15","RAERRDT","RAERR"
- SET RAVARS(I)=""
- +35 if $DATA(X)
- SET RAVARS("X")=""
- if $DATA(%DT)
- SET RAVARS("%DT")=""
- +36 if $DATA(%DT(0))
- SET RAVARS("%DT(0)")=""
- +37 ;S RAVARS("RAX")="",RAVARS("RAORC15")="",RAVARS("RAERRDT")="",RAVARS("RAERR")=""
- +38 DO EN^ORERR("RAD MYSTERY ERROR",.RAMSG,.RAVARS)
- +39 QUIT
- End DoDot:1
- SET RAERR=0
- +40 SET RANOW=$$NOW^XLFDT()
- IF RANOW<RAORC15
- SET RAERR=7
- QUIT
- +41 SET RANEW(75.1,"+1,",16)=RAORC15
- +42 QUIT
- ERR ; error control - file 'soft' errors with CPRS
- +1 NEW RAVAR
- SET RAVAR("XQY0")=""
- +2 DO ERR^RAO7UTL("HL7 message with unknown segment header",.RAMSG,.RAVAR)
- +3 QUIT