- 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 Jan 18, 2025@03:43:38 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