source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7RON1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1RAO7RON1 ;HISC/GJC,FPT-Request message from OE/RR. (frontdoor) ; 7/26/05 2:08pm
2 ;;5.0;Radiology/Nuclear Medicine;**69,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=Img. Loc. pntr (79.1) RAOBR30=trans. mode
9 ; RAOBR31=Reason for Study RAOBX2=format of observ. value
10 ; RAOBR4=univ. trans. mode RAOBX5=observ. value
11 ; RAOBX3=observ. ID RAORC10=entered by (200
12 ; RAORC1=order control RAORC15=order effective D/T
13 ; RAORC12=ordering provider (200) RAORC2=placer order #_"^OR"
14 ; RAORC16=order control reason RAORC7=start dt/freq. of service
15 ; RAORC3=filler order #_"^RA" RAPID5=patient name (2)
16 ; RAPID3=patient ID RAPV12=patient class
17 ; RAPV119=visit # RASEG=message seg. including header
18 ; RAPV13=patient location (44)
19 ; ----------------------------------------------------------------------
20 ;
21OBR ; breakdown the 'OBR' segment
22 S RAOBR4=$P(RADATA,RAHLFS,4)
23 F I=1:1:$L(RAOBR4,RAECH(1)) S RAOBR4(I)=$P(RAOBR4,RAECH(1),I)
24 I RAOBR4(1)'="" S RACPTIEN=+$O(^ICPT("B",RAOBR4(1),0)) S:'RACPTIEN RAERR=8 Q:RAERR ;RA*5*69
25 S RAERR=$$EN2^RAO7VLD(71,+RAOBR4(4),RAOBR4(5)) S:RAERR RAERR=8 Q:RAERR
26 I $$UP^XLFSTR($P($G(^RAMIS(71,+RAOBR4(4),0)),"^",6))="P" D Q:RAERR
27 . S RAERR=$$EN6^RAO7VLD(+RAOBR4(4)) S:RAERR RAERR=32
28 . Q
29 I RAOBR4(1)'="" S:'$D(^RAMIS(71,"D",RACPTIEN,+RAOBR4(4))) RAERR=8 Q:RAERR ;RA*5*69
30 S RAOBR4(4,"I-TYPE")=+$P($G(^RAMIS(71,+RAOBR4(4),0)),"^",12)
31 S RANEW(75.1,"+1,",2)=RAOBR4(4)
32 S RAIT=$P(^RAMIS(71,+RAOBR4(4),0),U,12)
33 S RAERR=$$EN3^RAO7VLD(79.2,RAIT) Q:RAERR
34 S RANEW(75.1,"+1,",3)=RAIT
35 S RAOBR12=$P(RADATA,RAHLFS,12)
36 S RAOBR12=$S($E(RAOBR12)="":"n","yYiI"[$E(RAOBR12):"y",1:"n")
37 S RAERR=$$EN1^RAO7VLD(75.1,24,"E",RAOBR12,"RASULT","") S:RAERR RAERR=10 Q:RAERR
38 S RANEW(75.1,"+1,",24)=RAOBR12
39 S RAOBR18=$P(RADATA,RAHLFS,18)
40 N RASERIES,RAIMAG
41 F I=1:1:$L(RAOBR18,RAECH(2)) S:$L($P(RAOBR18,RAECH(2),I))>0 RAOBR18(I)=$P(RAOBR18,RAECH(2),I)
42 S I=0 F S I=$O(RAOBR18(I)) Q:I'>0 D Q:RAERR
43 . S RAMODIEN=+$O(^RAMIS(71.2,"B",RAOBR18(I),0))
44 . S:'RAMODIEN RAERR=11 Q:RAERR
45 . S RAIMAG=$P($G(^RAMIS(71,+RAOBR4(4),0)),U,12) ; type of imaging
46 . S:'$D(^RAMIS(71.2,"AB",RAIMAG,RAMODIEN)) RAERR=33 Q:RAERR
47 . S RASERIES=$S($P($G(^RAMIS(71,+RAOBR4(4),0)),"^",6)="S":1,1:0)
48 . S:RASERIES&($P($G(^RAMIS(71.2,RAMODIEN,0)),U,2)]"") RAERR=34 Q:RAERR
49 . S RAPLCHLD=RAPLCHLD+1
50 . S RANEW(75.1125,"+"_RAPLCHLD_",+1,",.01)=RAMODIEN
51 . Q
52 S RAOBR19=$P(RADATA,RAHLFS,19),RAOBR19(1)=$P(RAOBR19,U,1)
53 S RAOBR19(2)=$P(RAOBR19,U,2),RAOBR19(3)=+RAOBR19(1)
54 I RAOBR19(3) D Q:RAERR
55 . S RAOBR19(3,"I-TYPE")=+$P($G(^RA(79.1,+RAOBR19(3),0)),"^",6)
56 . I RAOBR4(4,"I-TYPE")'=RAOBR19(3,"I-TYPE") S RAERR=31
57 . Q
58 S RANEW(75.1,"+1,",20)=$S(RAOBR19(3)>0:RAOBR19(3),1:"")
59 S X=$P(RADATA,RAHLFS,30)
60 S RAOBR30=$S(X="CART":"s",X="PORT":"p",X="WALK":"a",X="WHLC":"w",1:"")
61 I RAOBR30']"" S RAERR=13
62 S:'RAERR RAERR=$$EN1^RAO7VLD(75.1,19,"E",RAOBR30,"RASULT","")
63 S:RAERR RAERR=13 Q:RAERR
64 S RANEW(75.1,"+1,",19)=RAOBR30
65 ;--- Reason for Study P75 ---
66 ;CPRS will not pass 'Reason for Study' data until OR*3.0*243
67 ;(GUI CPRS V27) is released. Define a default Reason for Study
68 I '$$PATCH^XPDUTL("OR*3.0*243") S RAOBR31="See Clinical History:"
69 E D Q:RAERR ;CPRS V27 is installed
70 .S RAOBR31=$P($P(RADATA,RAHLFS,31),RAECH(1),2)
71 .S:RAOBR31="" RAERR=38 Q:RAERR
72 .S RAERR=$$EN1^RAO7VLD(75.1,1.1,"E",RAOBR31,"RASULT","")
73 .S:RAERR RAERR=39
74 .Q
75 S:'RAERR RANEW(75.1,"+1,",1.1)=RAOBR31
76 K RAOBR31
77 Q
78OBX ; breakdown the 'OBX' segment
79 S RAOBX2=$P(RADATA,RAHLFS,2)
80 S RAERR=$S(RAOBX2="TX":0,RAOBX2="CE":0,RAOBX2="TS":0,1:1) Q:RAERR=17
81 S RAOBX3=$P(RADATA,RAHLFS,3)
82 S RAOBX5=$P(RADATA,RAHLFS,5)
83 F I=1:1:$L(RAOBX3,RAECH(1)) S RAOBX3(I)=$P(RAOBX3,RAECH(1),I)
84 S X=RAOBX3(2) D UPPER^RAUTL4 S RAOBX3(2)=Y
85 ;
86 ;P75 check to see if CLINICAL HISTORY data is passed. If data is passed, and not yet
87 ;determined if valid continue to check for validity until:
88 ;1-valid data is found
89 ;2-no data left to validate
90 I RAOBX3(1)=2000.02 D
91 .;check if a null value is sent for CLINICAL HISTORY which is
92 .;possible if the CPRS user does not enter a CLINICAL HISTORY
93 .I RAOBX5="",$P(RACLIN,U)'=1 Q
94 .;now if data was sent (RAOBX5'="") set the data received from CPRS flag
95 .S $P(RACLIN,U)=1
96 .;now that we know the CPRS user intended to send CLINICAL HISTORY data
97 .;radiology has to validate the format of that data. $$EN4^RAO7VLD(str)
98 .;returns 1 if the data passed in was valid, else 0. Once we establish
99 .;that valid data has been sent, all subsequent data is accepted, valid
100 .;or not.
101 .S:$$EN4^RAO7VLD(RAOBX5) $P(RACLIN,U,2)=1
102 .;now, if the current character string or any other character string
103 .;of data representing the CLINICAL HISTORY has been accepted as valid
104 .;($P(RACLIN,U,2)=1) save the character string
105 .I $P(RACLIN,U,2)=1 S RAWP=RAWP+1,^TMP("RAWP",$J,RAWP)=RAOBX5
106 ;
107 I RAOBX3(1)=2000.33 D Q:RAERR
108 .S RAERR=$$EN1^RAO7VLD(75.1,13,"E",RAOBX5,"RASULT","") S:RAERR RAERR=14 Q:RAERR
109 .S RAPREG=$E(RAOBX5),RAPREG=$S(RAPREG="N"!(RAPREG="n"):"n",RAPREG="Y"!(RAPREG="y"):"y",1:"u")
110 .S RANEW(75.1,"+1,",13)=RAPREG
111 I RAOBX3(1)=34!(RAOBX2="CE") D Q:RAERR
112 .S RAERR=$$EN2^RAO7VLD(34,$P(RAOBX5,RAECH(1)),$P(RAOBX5,RAECH(1),2)) Q:RAERR
113 .S RANEW(75.1,"+1,",9)=+RAOBX5
114 I RAOBX3(2)["RESEARCH" D S:RAERR RAERR=18 Q:RAERR
115 .S RAERR=$$EN1^RAO7VLD(75.1,9.5,"E",RAOBX5,"RASULT","") S:RAERR RAERR=19 Q:RAERR
116 .S RANEW(75.1,"+1,",9.5)=RAOBX5
117 I RAOBX3(2)["PRE-OP" D Q:RAERR
118 .S RAOBX5=$$FMDATE^HLFNC(RAOBX5)
119 .S RAERR=$$EN1^RAO7VLD(75.1,12,"E",RAOBX5,"RASULT","") S:RAERR RAERR=20 Q:RAERR
120 .S RANEW(75.1,"+1,",12)=RAOBX5
121 I $D(RANEW(75.1,"+1,",9))&($D(RANEW(75.1,"+1,",9.5))) S RAERR=29
122 Q
Note: See TracBrowser for help on using the repository browser.