source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7OKR.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: 2.2 KB
Line 
1RAO7OKR ;HISC/GJC-Receive OE/RR accept/reject msg (backdoor) ;1/5/95 08:54
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4 ;------------------------- Variable List -------------------------------
5 ; RAECH="^~\&" RAECH(1)="^"
6 ; RAECH(2)="~" RAECH(3)="\"
7 ; RAECH(4)="&" RAHLFS="|"
8 ; RAHLFS(0)=50 "|"'s RAERR='0' if msg ok, else '1'
9 ; RASEG=each node of the message RADATA=node minus the seg. header
10 ; RAPID3=Pat. Id (IEN in ^DPT) RAPID5=Pat. name (.01 fld of ^DPT)
11 ; RAORC1=order control RAORC2=placer order # OE/RR (100)
12 ; RAORC3=filler order # RAD (75.1) RAORC16=order control reason
13 ; ----------------------------------------------------------------------
14EN1(RAMSG) ; Pass in the message from OE/RR. Decipher information.
15 N RADATA,RAECH,RAORC1,RAORC2,RAORC3,RAORC16,RAPID3,RAPID5
16 N RAHLFS,RASEG,X S (RAERR,X)=0
17 D EN1^RAO7UTL ; setup field seperator data (see var list)
18 F S X=$O(RAMSG(X)) Q:X'>0 D
19 . S RASEG=$G(RAMSG(X)) Q:$P(RASEG,RAHLFS)="MSH" ; quit if MSH segment
20 . S RADATA=$P(RASEG,RAHLFS,2,999)
21 . D @$S($P(RASEG,RAHLFS)="PID":"PID",1:"ORC")
22 . Q
23 ; validate data
24 S RAERR=$$EN3^RAO7VLD(75.1,RAORC3) S:RAERR RAERR=22 Q:RAERR
25 ; *** quit on non-match of either the patient ien or patient name ***
26 S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2 Q:RAERR
27 ; ***** set flag to '1' if the data was not filed properly *****
28 S RAERR=$$FILE(RAORC2,RAORC3) S:RAERR RAERR=26
29 Q
30FILE(RAX,RAY) ; File data into 75.1 using FM21 DBS
31 ; 'RAX' is placer order # (OE/RR), 'RAY' is filler order # (Rad)
32 ; returns '0' for proper filing, '1' when an error is encountered
33 N RADBS,RAFDA
34 ; setup FDA_ROOT for DBS call i.e, RAFDA(file # , ien_"," , fld #)=value
35 S RAFDA(75.1,RAY_",",7)=RAX
36 D FILE^DIE("K","RAFDA","RADBS(""ERROR"")")
37 Q $S($D(RADBS("ERROR","DIERR"))#2:1,1:RAERR)
38PID ; breakdown the 'PID' segment
39 S RAPID3=$P(RADATA,RAHLFS,3),RAPID5=$P(RADATA,RAHLFS,5)
40 Q
41ORC ; breakdown the 'ORC' segment
42 ; RAORC1 will either be 'NA' number assigned, or 'DE' data errors
43 S RAORC1=$P(RADATA,RAHLFS),RAORC2=+$P(RADATA,RAHLFS,2)
44 S RAORC3=+$P(RADATA,RAHLFS,3),RAORC16=$P(RADATA,RAHLFS,16)
45 Q
Note: See TracBrowser for help on using the repository browser.