SROAX.m

SROAX ;BIR/ADM - EXCLUSION UTILITY ;02/01/07

 ;;3.0; Surgery ;**160**;24 Jun 93;Build 7

 Q

XL(SRCASE) ; compare CPT codes with exclusion list, return cpt code ien not excluded

 N SRCODE,SRCPT,SRDATE,SROTH,SRQ,SRXCLD,Y

 S (SRQ,SRXCLD)=0,SRCODE="",SRDATE=$P($G(^SRF(SRCASE,0)),"^",9)

 I $G(^SRO(136,SRCASE,0)) S SRCPT=$P($G(^SRO(136,SRCASE,0)),"^",2) I SRCPT'="" D COMP I SRQ G END

 S SROTH=0 F  S SROTH=$O(^SRO(136,SRCASE,3,SROTH)) Q:'SROTH  D  Q:SRQ

 .S SRXCLD=0,SRCPT=$P($G(^SRO(136,SRCASE,3,SROTH,0)),"^") I SRCPT'="" D COMP

END Q SRCODE

COMP I $G(^SRO(137,SRCPT,0)) S SRXCLD=1 Q

 I 'SRXCLD S SRQ=1,Y=$$CPT^ICPTCOD(SRCPT,SRDATE),SRCODE=$P(Y,"^") ; SRCODE=ien in file 81

 Q

SROAX     ;BIR/ADM - EXCLUSION UTILITY ;02/01/07

 +1       ;;3.0; Surgery ;**160**;24 Jun 93;Build 7

 +2        QUIT 

XL(SRCASE) ; compare CPT codes with exclusion list, return cpt code ien not excluded

 +1        NEW SRCODE,SRCPT,SRDATE,SROTH,SRQ,SRXCLD,Y

 +2        SET (SRQ,SRXCLD)=0

           SET SRCODE=""

           SET SRDATE=$PIECE($GET(^SRF(SRCASE,0)),"^",9)

 +3        IF $GET(^SRO(136,SRCASE,0))

               SET SRCPT=$PIECE($GET(^SRO(136,SRCASE,0)),"^",2)

               IF SRCPT'=""

                   DO COMP

                   IF SRQ

                       GOTO END

 +4        SET SROTH=0

           FOR 

               SET SROTH=$ORDER(^SRO(136,SRCASE,3,SROTH))

               IF 'SROTH

                   QUIT 

               Begin DoDot:1

 +5                SET SRXCLD=0

                   SET SRCPT=$PIECE($GET(^SRO(136,SRCASE,3,SROTH,0)),"^")

                   IF SRCPT'=""

                       DO COMP

               End DoDot:1

               IF SRQ

                   QUIT 

END        QUIT SRCODE

COMP       IF $GET(^SRO(137,SRCPT,0))

               SET SRXCLD=1

               QUIT 

 +1       ; SRCODE=ien in file 81

           IF 'SRXCLD

               SET SRQ=1

               SET Y=$$CPT^ICPTCOD(SRCPT,SRDATE)

               SET SRCODE=$PIECE(Y,"^")

 +2        QUIT