| 1 | RAO7OKR ;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 | ; ----------------------------------------------------------------------
|
|---|
| 14 | EN1(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
|
|---|
| 30 | FILE(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)
|
|---|
| 38 | PID ; breakdown the 'PID' segment
|
|---|
| 39 | S RAPID3=$P(RADATA,RAHLFS,3),RAPID5=$P(RADATA,RAHLFS,5)
|
|---|
| 40 | Q
|
|---|
| 41 | ORC ; 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
|
|---|
