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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAX 688 printed Sep 23, 2025@20:18:53 Page 2
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
