RAO7OKR.m

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

RAO7OKR   ;HISC/GJC-Receive OE/RR accept/reject msg (backdoor) ;1/5/95  08:54

 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 +2       ;

 +3       ;------------------------- Variable List -------------------------------

 +4       ; RAECH="^~\&"                       RAECH(1)="^"

 +5       ; RAECH(2)="~"                       RAECH(3)="\"

 +6       ; RAECH(4)="&"                       RAHLFS="|"

 +7       ; RAHLFS(0)=50 "|"'s                 RAERR='0' if msg ok, else '1'

 +8       ; RASEG=each node of the message     RADATA=node minus the seg. header

 +9       ; RAPID3=Pat. Id (IEN in ^DPT)       RAPID5=Pat. name (.01 fld of ^DPT)

 +10      ; RAORC1=order control               RAORC2=placer order # OE/RR (100)

 +11      ; RAORC3=filler order # RAD (75.1)   RAORC16=order control reason

 +12      ; ----------------------------------------------------------------------

EN1(RAMSG) ; Pass in the message from OE/RR.  Decipher information.

 +1        NEW RADATA,RAECH,RAORC1,RAORC2,RAORC3,RAORC16,RAPID3,RAPID5

 +2        NEW RAHLFS,RASEG,X

           SET (RAERR,X)=0

 +3       ; setup field seperator data (see var list)

           DO EN1^RAO7UTL

 +4        FOR 

               SET X=$ORDER(RAMSG(X))

               IF X'>0

                   QUIT 

               Begin DoDot:1

 +5       ; quit if MSH segment

                   SET RASEG=$GET(RAMSG(X))

                   IF $PIECE(RASEG,RAHLFS)="MSH"

                       QUIT 

 +6                SET RADATA=$PIECE(RASEG,RAHLFS,2,999)

 +7                DO @$SELECT($PIECE(RASEG,RAHLFS)="PID":"PID",1:"ORC")

 +8                QUIT 

               End DoDot:1

 +9       ; validate data

 +10       SET RAERR=$$EN3^RAO7VLD(75.1,RAORC3)

           IF RAERR

               SET RAERR=22

           IF RAERR

               QUIT 

 +11      ; *** quit on non-match of either the patient ien or patient name ***

 +12       SET RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5)

           IF RAERR

               SET RAERR=2

           IF RAERR

               QUIT 

 +13      ; ***** set flag to '1' if the data was not filed properly *****

 +14       SET RAERR=$$FILE(RAORC2,RAORC3)

           IF RAERR

               SET RAERR=26

 +15       QUIT 

FILE(RAX,RAY) ; File data into 75.1 using FM21 DBS

 +1       ; 'RAX' is placer order # (OE/RR), 'RAY' is filler order # (Rad)

 +2       ; returns '0' for proper filing, '1' when an error is encountered

 +3        NEW RADBS,RAFDA

 +4       ; setup FDA_ROOT for DBS call i.e, RAFDA(file # , ien_"," , fld #)=value

 +5        SET RAFDA(75.1,RAY_",",7)=RAX

 +6        DO FILE^DIE("K","RAFDA","RADBS(""ERROR"")")

 +7        QUIT $SELECT($DATA(RADBS("ERROR","DIERR"))#2:1,1:RAERR)

PID       ; breakdown the 'PID' segment

 +1        SET RAPID3=$PIECE(RADATA,RAHLFS,3)

           SET RAPID5=$PIECE(RADATA,RAHLFS,5)

 +2        QUIT 

ORC       ; breakdown the 'ORC' segment

 +1       ; RAORC1 will either be 'NA' number assigned, or 'DE' data errors

 +2        SET RAORC1=$PIECE(RADATA,RAHLFS)

           SET RAORC2=+$PIECE(RADATA,RAHLFS,2)

 +3        SET RAORC3=+$PIECE(RADATA,RAHLFS,3)

           SET RAORC16=$PIECE(RADATA,RAHLFS,16)

 +4        QUIT