RAO7RCH.m

RAO7RCH ;HISC/GJC,FPT-Process Discontinued Message ;9/4/97  09:11

 ;;5.0;Radiology/Nuclear Medicine;**15**;Mar 16, 1998

 ;

 ;------------------------- Variable List -------------------------------

 ; RADATA=HL7 data minus seg. hdr    RAHDR=Segment header

 ; RAHLFS="|"                        RAMSG=HL7 message passed in

 ; RAORC1=order control              RAORC10=entered by (200)

 ; RAORC16=order control reason      RAORC2=placer order #_"^OR"

 ; RAORC3=filler order #_"^RA"       RAPID3=patient ID

 ; RAPID5=patient name (2)           RASEG=message seg. including header

 ; ----------------------------------------------------------------------

EN1(RAMSG) ;

 D BRKOUT^RAO7UTL1

 ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3, & RADIV(.119)

 S (RAERR,RALINEX)=0

 F  S RALINEX=$O(RAMSG(RALINEX)) Q:RALINEX'>0  D  Q:RAERR

 . S RASEG=$G(RAMSG(RALINEX)) Q:$P(RASEG,RAHLFS)="MSH"  ; quit if MSH segment

 . S RAHDR=$P(RASEG,RAHLFS),RADATA=$P(RASEG,RAHLFS,2,999)

 . D @$S(RAHDR="PID":"PID",RAHDR="ORC":"ORC",1:"ERR")

 . Q

 Q

PID ; breakdown the 'PID' segment

 S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2

 Q

ORC ; breakdown the 'ORC' segment

 S RAERR=$$EN3^RAO7VLD(75.1,+RAORC3) S:RAERR RAERR=22 Q:RAERR

 S RA0=$G(^RAO(75.1,+RAORC3,0))

 S RASTATUS=+$P(RA0,U,5)

 I "358"'[$E(RASTATUS) S RAERR=25 Q

 S RAORC10=$P(RADATA,RAHLFS,10)

 S RAERR=$$EN3^RAO7VLD(200,+RAORC10) S:RAERR RAERR=4 Q:RAERR

 S RAORC16=$P($P(RADATA,RAHLFS,16),"^",4) ;Rad Reason file ien

 S RAORC161=$P($P(RADATA,RAHLFS,16),"^",5) ; Cancel Description

 D  Q:RAERR

 .S RANEW(75.1,+RAORC3_",",23)="@"

 .I RAORC16']"",(RAORC161']"") Q

 .I RAORC16]"",'$D(^RA(75.2,+RAORC16,0)),RAORC161']"" S RAERR=23 Q

 .S RANEW(75.1,+RAORC3_",",10)=RAORC16

 .S RANEW(75.1,+RAORC3_",",27)=RAORC161

 S RANEW(75.1,+RAORC3_",",5)=1

 S RANEW(75.1,+RAORC3_",",18)=RALDT

 Q

ERR ; error control - file 'soft' errors with CPRS

 N RAVAR S RAVAR("XQY0")=""

 D ERR^RAO7UTL("HL7 message missing 'PID' & 'ORC' segments",.RAMSG,.RAVAR)

 Q

RAO7RCH   ;HISC/GJC,FPT-Process Discontinued Message ;9/4/97  09:11

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

 +2       ;

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

 +4       ; RADATA=HL7 data minus seg. hdr    RAHDR=Segment header

 +5       ; RAHLFS="|"                        RAMSG=HL7 message passed in

 +6       ; RAORC1=order control              RAORC10=entered by (200)

 +7       ; RAORC16=order control reason      RAORC2=placer order #_"^OR"

 +8       ; RAORC3=filler order #_"^RA"       RAPID3=patient ID

 +9       ; RAPID5=patient name (2)           RASEG=message seg. including header

 +10      ; ----------------------------------------------------------------------

EN1(RAMSG) ;

 +1        DO BRKOUT^RAO7UTL1

 +2       ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3, & RADIV(.119)

 +3        SET (RAERR,RALINEX)=0

 +4        FOR 

               SET RALINEX=$ORDER(RAMSG(RALINEX))

               IF RALINEX'>0

                   QUIT 

               Begin DoDot:1

 +5       ; quit if MSH segment

                   SET RASEG=$GET(RAMSG(RALINEX))

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

                       QUIT 

 +6                SET RAHDR=$PIECE(RASEG,RAHLFS)

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

 +7                DO @$SELECT(RAHDR="PID":"PID",RAHDR="ORC":"ORC",1:"ERR")

 +8                QUIT 

               End DoDot:1

               IF RAERR

                   QUIT 

 +9        QUIT 

PID       ; breakdown the 'PID' segment

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

           IF RAERR

               SET RAERR=2

 +2        QUIT 

ORC       ; breakdown the 'ORC' segment

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

           IF RAERR

               SET RAERR=22

           IF RAERR

               QUIT 

 +2        SET RA0=$GET(^RAO(75.1,+RAORC3,0))

 +3        SET RASTATUS=+$PIECE(RA0,U,5)

 +4        IF "358"'[$EXTRACT(RASTATUS)

               SET RAERR=25

               QUIT 

 +5        SET RAORC10=$PIECE(RADATA,RAHLFS,10)

 +6        SET RAERR=$$EN3^RAO7VLD(200,+RAORC10)

           IF RAERR

               SET RAERR=4

           IF RAERR

               QUIT 

 +7       ;Rad Reason file ien

           SET RAORC16=$PIECE($PIECE(RADATA,RAHLFS,16),"^",4)

 +8       ; Cancel Description

           SET RAORC161=$PIECE($PIECE(RADATA,RAHLFS,16),"^",5)

 +9        Begin DoDot:1

 +10           SET RANEW(75.1,+RAORC3_",",23)="@"

 +11           IF RAORC16']""

                   IF (RAORC161']"")

                       QUIT 

 +12           IF RAORC16]""

                   IF '$DATA(^RA(75.2,+RAORC16,0))

                       IF RAORC161']""

                           SET RAERR=23

                           QUIT 

 +13           SET RANEW(75.1,+RAORC3_",",10)=RAORC16

 +14           SET RANEW(75.1,+RAORC3_",",27)=RAORC161

           End DoDot:1

           IF RAERR

               QUIT 

 +15       SET RANEW(75.1,+RAORC3_",",5)=1

 +16       SET RANEW(75.1,+RAORC3_",",18)=RALDT

 +17       QUIT 

ERR       ; error control - file 'soft' errors with CPRS

 +1        NEW RAVAR

           SET RAVAR("XQY0")=""

 +2        DO ERR^RAO7UTL("HL7 message missing 'PID' & 'ORC' segments",.RAMSG,.RAVAR)

 +3        QUIT