- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7RON.m
r613 r623 1 RAO7RON ;HISC/GJC- Request message from OE/RR. (frontdoor) ;2/2/98 12:34 2 ;;5.0;Radiology/Nuclear Medicine;**41,75,86**;Mar 16, 1998;Build 7 3 ; 4 ;Supported IA #10040 reference to ^SC 5 ;Supported IA #2187 reference to EN^ORERR 6 ;Supported IA #10103 reference to ^XLFDT 7 ;Supported IA #10141 reference to ^XPDUTL 8 ;Supported IA #10106 reference to $$FMDATE^HLFNC 9 ; 10 ;------------------------- Variable List ------------------------------- 11 ; RADATA=HL7 data minus seg. hdr RAHDR=Segment header 12 ; RAHLFS="|" RAMSG=HL7 message passed in 13 ; RAOBR12=danger code RAOBR18=modifier 14 ; RAOBR19=hosp. loc. pntr (44) RAOBR30=trans. mode 15 ; RAOBR4=univ. trans. mode RAOBX2=format of observ. value 16 ; RAOBX3=observ. ID RAOBX5=observ. value 17 ; RAORC1=order control RAORC10=entered by (200) 18 ; RAORC11=approving rad/nm phys (for some procedures only) 19 ; RAORC12=ordering provider (200) RAORC15=order effective D/T 20 ; RAORC16=order control reason RAORC2=placer order #_"^OR" 21 ; RAORC3=filler order #_"^RA" RAORC7=start dt/freq. of service 22 ; RAPID3=patient ID RAPID5=patient name (2) 23 ; RAPV119=visit # RAPV12=patient class 24 ; RAPV13=patient location (44) RASEG=message seg. including header 25 ; ---------------------------------------------------------------------- 26 EN1(RAMSG) ; Pass in the message from RAO7RO. Decipher information. 27 D BRKOUT^RAO7UTL1 28 ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3 & RADIV(.119) 29 S (RAERR,RAWP,RALINEX)=0,RACLIN="^" K ^TMP("RAWP",$J) 30 F S RALINEX=$O(RAMSG(RALINEX)) Q:RALINEX'>0 D Q:RAERR 31 . S RASEG=$G(RAMSG(RALINEX)) Q:$P(RASEG,RAHLFS)="MSH" ; quit if MSH segment 32 . S RAHDR=$P(RASEG,RAHLFS),RADATA=$P(RASEG,RAHLFS,2,999) 33 . 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") 34 . Q 35 S RANEW(75.1,"+1,",18)=RALDT 36 Q 37 PID ; breakdown the 'PID' segment 38 S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2 39 I 'RAERR S RANEW(75.1,"+1,",.01)=RAPID3 40 Q 41 PV1 ; breakdown the 'PV1' segment 42 S RAPV12=$P(RADATA,RAHLFS,2) 43 S RAERR=$$EN1^RAO7VLD(75.1,4,"E",RAPV12,"RASULT","") S:RAERR RAERR=27 Q:RAERR 44 S RANEW(75.1,"+1,",4)=RAPV12 45 S RAPV13=$P(RADATA,RAHLFS,3) 46 S RAERR=$$EN3^RAO7VLD(44,+RAPV13) S:RAERR RAERR=3 Q:RAERR 47 S RANEW(75.1,"+1,",22)=+RAPV13 48 ;check the GUI version of CPRS at this facility: 49 ;$$PATCH^XPDUTL("OR*3.0*243")=1 CPRS V27, else CPRS V26. 50 I '$$PATCH^XPDUTL("OR*3.0*243") D Q:RAERR ;P86 51 .I RAPV12="I",$P(^SC($P(RAPV13,U,1),0),U,3)'="W" S RAERR=9 Q 52 .I RAPV12="O",$P(^SC($P(RAPV13,U,1),0),U,3)="W" S RAERR=9 53 .Q 54 S RAPV119=$P(RADATA,RAHLFS,19) 55 Q 56 ORC ; breakdown the 'ORC' segment 57 ; RAORC7D is: timestamp HL7 format 58 ; RAORC7P is: priority/urgency 59 S:+RAORC2'>0 RAERR=16 Q:RAERR 60 S RANEW(75.1,"+1,",7)=+RAORC2 61 S RANEW(75.1,"+1,",5)=5 62 S RAORC7=$P(RADATA,RAHLFS,7) 63 S RAORC7D=$P(RAORC7,RAECH(1),4) 64 S RAORC7D=$$FMDATE^HLFNC(RAORC7D) 65 S RAERR=$$EN1^RAO7VLD(75.1,21,"E",RAORC7D,"RASULT","") S:RAERR RAERR=28 Q:RAERR 66 S RANEW(75.1,"+1,",21)=RAORC7D 67 S X=$P(RAORC7,RAECH(1),6) 68 S RAORC7P=$S(X="S":1,X="A":2,X="R":9,1:"") I +RAORC7P'>0 S RAERR=5 Q 69 S RANEW(75.1,"+1,",6)=RAORC7P 70 S RAORC10=$P(RADATA,RAHLFS,10) 71 S RAERR=$$EN3^RAO7VLD(200,RAORC10) S:RAERR RAERR=4 Q:RAERR 72 S RANEW(75.1,"+1,",15)=RAORC10 73 S RAORC11=$P(RADATA,RAHLFS,11) ;approving rad/nm phys for some proc's 74 I $G(RAORC11) S RAERR=$$EN3^RAO7VLD(200,RAORC11) S:RAERR RAERR=36 Q:RAERR 75 I $G(RAORC11) S RANEW(75.1,"+1,",8)=RAORC11 76 S RAORC12=$P(RADATA,RAHLFS,12) 77 S RAERR=$$EN3^RAO7VLD(200,RAORC12) S:RAERR RAERR=6 Q:RAERR 78 S RANEW(75.1,"+1,",14)=RAORC12 79 S RAORC15=$P(RADATA,RAHLFS,15) 80 S RAORC15=$$FMDATE^HLFNC(RAORC15) 81 ;The order entered dt/time validity ck results are ignored because we 82 ;have never been able to determine why FileMan erroneously rejects 83 ;some date/times in a Silent FM call. We now assume this date is OK. 84 S RAERR=$$EN1^RAO7VLD(75.1,16,"E",RAORC15,"RASULT","") S:RAERR RAERR=35 85 ;Q:RAERR 86 I RAERR D S RAERR=0 87 . N I,RAX,RAVARS,RAERRDT 88 . S RAX=$G(^TMP("DIERR",$J,1,"TEXT",1)) 89 . S RAERRDT=$$NOW^XLFDT() 90 . F I="RAX","RAORC15","RAERRDT","RAERR" S RAVARS(I)="" 91 . S:$D(X) RAVARS("X")="" S:$D(%DT) RAVARS("%DT")="" 92 . S:$D(%DT(0)) RAVARS("%DT(0)")="" 93 . ;S RAVARS("RAX")="",RAVARS("RAORC15")="",RAVARS("RAERRDT")="",RAVARS("RAERR")="" 94 . D EN^ORERR("RAD MYSTERY ERROR",.RAMSG,.RAVARS) 95 . Q 96 S RANOW=$$NOW^XLFDT() I RANOW<RAORC15 S RAERR=7 Q 97 S RANEW(75.1,"+1,",16)=RAORC15 98 Q 99 ERR ; error control - file 'soft' errors with CPRS 100 N RAVAR S RAVAR("XQY0")="" 101 D ERR^RAO7UTL("HL7 message with unknown segment header",.RAMSG,.RAVAR) 102 Q 1 RAO7RON ;HISC/GJC- Request message from OE/RR. (frontdoor) ;2/2/98 12:34 2 ;;5.0;Radiology/Nuclear Medicine;**41,75**;Mar 16, 1998;Build 4 3 ; 4 ;------------------------- Variable List ------------------------------- 5 ; RADATA=HL7 data minus seg. hdr RAHDR=Segment header 6 ; RAHLFS="|" RAMSG=HL7 message passed in 7 ; RAOBR12=danger code RAOBR18=modifier 8 ; RAOBR19=hosp. loc. pntr (44) RAOBR30=trans. mode 9 ; RAOBR4=univ. trans. mode RAOBX2=format of observ. value 10 ; RAOBX3=observ. ID RAOBX5=observ. value 11 ; RAORC1=order control RAORC10=entered by (200) 12 ; RAORC11=approving rad/nm phys (for some procedures only) 13 ; RAORC12=ordering provider (200) RAORC15=order effective D/T 14 ; RAORC16=order control reason RAORC2=placer order #_"^OR" 15 ; RAORC3=filler order #_"^RA" RAORC7=start dt/freq. of service 16 ; RAPID3=patient ID RAPID5=patient name (2) 17 ; RAPV119=visit # RAPV12=patient class 18 ; RAPV13=patient location (44) RASEG=message seg. including header 19 ; ---------------------------------------------------------------------- 20 EN1(RAMSG) ; Pass in the message from RAO7RO. Decipher information. 21 D BRKOUT^RAO7UTL1 22 ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3 & RADIV(.119) 23 S (RAERR,RAWP,RALINEX)=0,RACLIN="^" K ^TMP("RAWP",$J) 24 F S RALINEX=$O(RAMSG(RALINEX)) Q:RALINEX'>0 D Q:RAERR 25 . S RASEG=$G(RAMSG(RALINEX)) Q:$P(RASEG,RAHLFS)="MSH" ; quit if MSH segment 26 . S RAHDR=$P(RASEG,RAHLFS),RADATA=$P(RASEG,RAHLFS,2,999) 27 . 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") 28 . Q 29 S RANEW(75.1,"+1,",18)=RALDT 30 Q 31 PID ; breakdown the 'PID' segment 32 S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2 33 I 'RAERR S RANEW(75.1,"+1,",.01)=RAPID3 34 Q 35 PV1 ; breakdown the 'PV1' segment 36 S RAPV12=$P(RADATA,RAHLFS,2) 37 S RAERR=$$EN1^RAO7VLD(75.1,4,"E",RAPV12,"RASULT","") S:RAERR RAERR=27 Q:RAERR 38 S RANEW(75.1,"+1,",4)=RAPV12 39 S RAPV13=$P(RADATA,RAHLFS,3) 40 S RAERR=$$EN3^RAO7VLD(44,+RAPV13) S:RAERR RAERR=3 Q:RAERR 41 S RANEW(75.1,"+1,",22)=+RAPV13 42 I RAPV12="I",$P(^SC($P(RAPV13,U,1),0),U,3)'="W" S RAERR=9 Q:RAERR 43 I RAPV12="O",$P(^SC($P(RAPV13,U,1),0),U,3)="W" S RAERR=9 Q:RAERR 44 S RAPV119=$P(RADATA,RAHLFS,19) 45 Q 46 ORC ; breakdown the 'ORC' segment 47 ; RAORC7D is: timestamp HL7 format 48 ; RAORC7P is: priority/urgency 49 S:+RAORC2'>0 RAERR=16 Q:RAERR 50 S RANEW(75.1,"+1,",7)=+RAORC2 51 S RANEW(75.1,"+1,",5)=5 52 S RAORC7=$P(RADATA,RAHLFS,7) 53 S RAORC7D=$P(RAORC7,RAECH(1),4) 54 S RAORC7D=$$FMDATE^HLFNC(RAORC7D) 55 S RAERR=$$EN1^RAO7VLD(75.1,21,"E",RAORC7D,"RASULT","") S:RAERR RAERR=28 Q:RAERR 56 S RANEW(75.1,"+1,",21)=RAORC7D 57 S X=$P(RAORC7,RAECH(1),6) 58 S RAORC7P=$S(X="S":1,X="A":2,X="R":9,1:"") I +RAORC7P'>0 S RAERR=5 Q 59 S RANEW(75.1,"+1,",6)=RAORC7P 60 S RAORC10=$P(RADATA,RAHLFS,10) 61 S RAERR=$$EN3^RAO7VLD(200,RAORC10) S:RAERR RAERR=4 Q:RAERR 62 S RANEW(75.1,"+1,",15)=RAORC10 63 S RAORC11=$P(RADATA,RAHLFS,11) ;approving rad/nm phys for some proc's 64 I $G(RAORC11) S RAERR=$$EN3^RAO7VLD(200,RAORC11) S:RAERR RAERR=36 Q:RAERR 65 I $G(RAORC11) S RANEW(75.1,"+1,",8)=RAORC11 66 S RAORC12=$P(RADATA,RAHLFS,12) 67 S RAERR=$$EN3^RAO7VLD(200,RAORC12) S:RAERR RAERR=6 Q:RAERR 68 S RANEW(75.1,"+1,",14)=RAORC12 69 S RAORC15=$P(RADATA,RAHLFS,15) 70 S RAORC15=$$FMDATE^HLFNC(RAORC15) 71 ;The order entered dt/time validity ck results are ignored because we 72 ;have never been able to determine why FileMan erroneously rejects 73 ;some date/times in a Silent FM call. We now assume this date is OK. 74 S RAERR=$$EN1^RAO7VLD(75.1,16,"E",RAORC15,"RASULT","") S:RAERR RAERR=35 75 ;Q:RAERR 76 I RAERR D S RAERR=0 77 . N I,RAX,RAVARS,RAERRDT 78 . S RAX=$G(^TMP("DIERR",$J,1,"TEXT",1)) 79 . S RAERRDT=$$NOW^XLFDT() 80 . F I="RAX","RAORC15","RAERRDT","RAERR" S RAVARS(I)="" 81 . S:$D(X) RAVARS("X")="" S:$D(%DT) RAVARS("%DT")="" 82 . S:$D(%DT(0)) RAVARS("%DT(0)")="" 83 . ;S RAVARS("RAX")="",RAVARS("RAORC15")="",RAVARS("RAERRDT")="",RAVARS("RAERR")="" 84 . D EN^ORERR("RAD MYSTERY ERROR",.RAMSG,.RAVARS) 85 . Q 86 S RANOW=$$NOW^XLFDT() I RANOW<RAORC15 S RAERR=7 Q 87 S RANEW(75.1,"+1,",16)=RAORC15 88 Q 89 ERR ; error control - file 'soft' errors with CPRS 90 N RAVAR S RAVAR("XQY0")="" 91 D ERR^RAO7UTL("HL7 message with unknown segment header",.RAMSG,.RAVAR) 92 Q
Note:
See TracChangeset
for help on using the changeset viewer.
