46 lines
2.2 KiB
Mathematica
46 lines
2.2 KiB
Mathematica
RAO7OKR ;HISC/GJC-Receive OE/RR accept/reject msg (backdoor) ;1/5/95 08:54
|
|
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|
;
|
|
;------------------------- Variable List -------------------------------
|
|
; RAECH="^~\&" RAECH(1)="^"
|
|
; RAECH(2)="~" RAECH(3)="\"
|
|
; RAECH(4)="&" RAHLFS="|"
|
|
; RAHLFS(0)=50 "|"'s RAERR='0' if msg ok, else '1'
|
|
; RASEG=each node of the message RADATA=node minus the seg. header
|
|
; RAPID3=Pat. Id (IEN in ^DPT) RAPID5=Pat. name (.01 fld of ^DPT)
|
|
; RAORC1=order control RAORC2=placer order # OE/RR (100)
|
|
; RAORC3=filler order # RAD (75.1) RAORC16=order control reason
|
|
; ----------------------------------------------------------------------
|
|
EN1(RAMSG) ; Pass in the message from OE/RR. Decipher information.
|
|
N RADATA,RAECH,RAORC1,RAORC2,RAORC3,RAORC16,RAPID3,RAPID5
|
|
N RAHLFS,RASEG,X S (RAERR,X)=0
|
|
D EN1^RAO7UTL ; setup field seperator data (see var list)
|
|
F S X=$O(RAMSG(X)) Q:X'>0 D
|
|
. S RASEG=$G(RAMSG(X)) Q:$P(RASEG,RAHLFS)="MSH" ; quit if MSH segment
|
|
. S RADATA=$P(RASEG,RAHLFS,2,999)
|
|
. D @$S($P(RASEG,RAHLFS)="PID":"PID",1:"ORC")
|
|
. Q
|
|
; validate data
|
|
S RAERR=$$EN3^RAO7VLD(75.1,RAORC3) S:RAERR RAERR=22 Q:RAERR
|
|
; *** quit on non-match of either the patient ien or patient name ***
|
|
S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2 Q:RAERR
|
|
; ***** set flag to '1' if the data was not filed properly *****
|
|
S RAERR=$$FILE(RAORC2,RAORC3) S:RAERR RAERR=26
|
|
Q
|
|
FILE(RAX,RAY) ; File data into 75.1 using FM21 DBS
|
|
; 'RAX' is placer order # (OE/RR), 'RAY' is filler order # (Rad)
|
|
; returns '0' for proper filing, '1' when an error is encountered
|
|
N RADBS,RAFDA
|
|
; setup FDA_ROOT for DBS call i.e, RAFDA(file # , ien_"," , fld #)=value
|
|
S RAFDA(75.1,RAY_",",7)=RAX
|
|
D FILE^DIE("K","RAFDA","RADBS(""ERROR"")")
|
|
Q $S($D(RADBS("ERROR","DIERR"))#2:1,1:RAERR)
|
|
PID ; breakdown the 'PID' segment
|
|
S RAPID3=$P(RADATA,RAHLFS,3),RAPID5=$P(RADATA,RAHLFS,5)
|
|
Q
|
|
ORC ; breakdown the 'ORC' segment
|
|
; RAORC1 will either be 'NA' number assigned, or 'DE' data errors
|
|
S RAORC1=$P(RADATA,RAHLFS),RAORC2=+$P(RADATA,RAHLFS,2)
|
|
S RAORC3=+$P(RADATA,RAHLFS,3),RAORC16=$P(RADATA,RAHLFS,16)
|
|
Q
|