RAO7OKS.m

RAO7OKS ;HISC/GJC-Accept/reject OE/RR request ; 20 Apr 2011  7:27 PM

 ;;5.0;Radiology/Nuclear Medicine;**18,57,1003**;Nov 01, 2010;Build 3

 ;Last modified for P18 Oct 24 by SS

ACC(Y1,Y2,Y3,Y4,Y5) ; Rad accepts OE/RR request

 ; Y1-> order control                 Y2-> universal service ID

 ; Y3-> results rpt./stat. change DT  Y4-> result status 

 ; Y5-> scheduled date/time

 ;

 ; PFSS 1B Project Account Referance Number

 ; If the order status is "NEW", call to set up a new account number.

 ;IHS/BJI/DAY - Patch 1003 - Comment out call to VA's IBB package

 ;I RAORD="NW" D FB^RABWIBB(+RAORC3)  ; Requirement 1, 5

 ;End Patch

 ; If the order status is "DISCONTINUE", call to set up a discontinue event

 ;IHS/BJI/DAY - Patch 1003 - Comment out call to VA's IBB package

 ;I RAORD="DC" D DC^RABWIBB(+RAORC3) ; Requirement 8

 ;End Patch

 ;

 N MSG S MSG(1)=$$MSH^RAO7UTL("ORR")

 S MSG(2)=$$MSA^RAO7UTL(+RAORC2,"AA") ;P18 add MSA segment with accept AA

 S MSG(3)="PID"_$$STR^RAO7UTL(3)_$G(RAPID3)_$$STR^RAO7UTL(2)_$G(RAPID5) ;P18

 ; Add PV1 Segment for PFSS Project

 ; PFSS 1B project define new field: PV1-50 Alternate Visit ID

 S MSG(4)=$$PV1^RAO7UTL($G(^RAO(75.1,+RAORC3,0)))

 S MSG(5)="ORC"_RAHLFS_Y1_RAHLFS_$G(RAORC2)_RAHLFS_$G(RAORC3) ;P18

 I Y2]""!(Y3]"")!(Y4]"")!(Y5]"") D  ; include if order is scheduled

 . S MSG(6)="OBR"_$$STR^RAO7UTL(4)_Y2_$$STR^RAO7UTL(18)_Y3

 . S MSG(6)=MSG(6)_$$STR^RAO7UTL(2)_Y4_$$STR^RAO7UTL(12)_Y5

 . Q

 ;

 D SHIP ; send HL7 message on its way to CPRS

 Q

 ;

REJ(Y1,Y2) ; Rad rejects OE/RR request

 ; Y1-> order control                 Y2-> order control reason

 N MSG S MSG(1)=$$MSH^RAO7UTL("ORR")

 S MSG(2)=$$MSA^RAO7UTL(+RAORC2,"AR") ;P18 add MSA segment with reject AR

 S MSG(3)="PID"_$$STR^RAO7UTL(3)_$G(RAPID3)_$$STR^RAO7UTL(2)_$G(RAPID5) ;P18

 S MSG(4)="ORC"_RAHLFS_Y1_RAHLFS_$G(RAORC2)_RAHLFS_$G(RAORC3) ;P18

 S:Y2]"" MSG(4)=MSG(4)_$$STR^RAO7UTL(13)_RAECH(1)_Y2_RAECH(1)

SHIP ; ship message to MSG^RAO7UTL which fires of the HL7 message to CPRS

 D MSG^RAO7UTL("RA EVSEND OR",.MSG)

 Q

RAO7OKS   ;HISC/GJC-Accept/reject OE/RR request ; 20 Apr 2011  7:27 PM

 +1       ;;5.0;Radiology/Nuclear Medicine;**18,57,1003**;Nov 01, 2010;Build 3

 +2       ;Last modified for P18 Oct 24 by SS

ACC(Y1,Y2,Y3,Y4,Y5) ; Rad accepts OE/RR request

 +1       ; Y1-> order control                 Y2-> universal service ID

 +2       ; Y3-> results rpt./stat. change DT  Y4-> result status 

 +3       ; Y5-> scheduled date/time

 +4       ;

 +5       ; PFSS 1B Project Account Referance Number

 +6       ; If the order status is "NEW", call to set up a new account number.

 +7       ;IHS/BJI/DAY - Patch 1003 - Comment out call to VA's IBB package

 +8       ;I RAORD="NW" D FB^RABWIBB(+RAORC3)  ; Requirement 1, 5

 +9       ;End Patch

 +10      ; If the order status is "DISCONTINUE", call to set up a discontinue event

 +11      ;IHS/BJI/DAY - Patch 1003 - Comment out call to VA's IBB package

 +12      ;I RAORD="DC" D DC^RABWIBB(+RAORC3) ; Requirement 8

 +13      ;End Patch

 +14      ;

 +15       NEW MSG

           SET MSG(1)=$$MSH^RAO7UTL("ORR")

 +16      ;P18 add MSA segment with accept AA

           SET MSG(2)=$$MSA^RAO7UTL(+RAORC2,"AA")

 +17      ;P18

           SET MSG(3)="PID"_$$STR^RAO7UTL(3)_$GET(RAPID3)_$$STR^RAO7UTL(2)_$GET(RAPID5)

 +18      ; Add PV1 Segment for PFSS Project

 +19      ; PFSS 1B project define new field: PV1-50 Alternate Visit ID

 +20       SET MSG(4)=$$PV1^RAO7UTL($GET(^RAO(75.1,+RAORC3,0)))

 +21      ;P18

           SET MSG(5)="ORC"_RAHLFS_Y1_RAHLFS_$GET(RAORC2)_RAHLFS_$GET(RAORC3)

 +22      ; include if order is scheduled

           IF Y2]""!(Y3]"")!(Y4]"")!(Y5]"")

               Begin DoDot:1

 +23               SET MSG(6)="OBR"_$$STR^RAO7UTL(4)_Y2_$$STR^RAO7UTL(18)_Y3

 +24               SET MSG(6)=MSG(6)_$$STR^RAO7UTL(2)_Y4_$$STR^RAO7UTL(12)_Y5

 +25               QUIT 

               End DoDot:1

 +26      ;

 +27      ; send HL7 message on its way to CPRS

           DO SHIP

 +28       QUIT 

 +29      ;

REJ(Y1,Y2) ; Rad rejects OE/RR request

 +1       ; Y1-> order control                 Y2-> order control reason

 +2        NEW MSG

           SET MSG(1)=$$MSH^RAO7UTL("ORR")

 +3       ;P18 add MSA segment with reject AR

           SET MSG(2)=$$MSA^RAO7UTL(+RAORC2,"AR")

 +4       ;P18

           SET MSG(3)="PID"_$$STR^RAO7UTL(3)_$GET(RAPID3)_$$STR^RAO7UTL(2)_$GET(RAPID5)

 +5       ;P18

           SET MSG(4)="ORC"_RAHLFS_Y1_RAHLFS_$GET(RAORC2)_RAHLFS_$GET(RAORC3)

 +6        IF Y2]""

               SET MSG(4)=MSG(4)_$$STR^RAO7UTL(13)_RAECH(1)_Y2_RAECH(1)

SHIP      ; ship message to MSG^RAO7UTL which fires of the HL7 message to CPRS

 +1        DO MSG^RAO7UTL("RA EVSEND OR",.MSG)

 +2        QUIT