SROICD.m

SROICD ;BIR/SJA - CODE SET VERSIONING UTILITY ; [ 01/30/03  05:50 PM ]

 ;;3.0; Surgery ;**116,127**;24 Jun 93

 ;

 ;Reference to $$ICDDX^ICDCODE supported by DBIA #3990

 ;

ICDC(SRCODE) ; output principal ICD

 N SRC,SRSDATE,SRDA

 I $D(SRCODE),SRCODE="" Q

 S SRDA=$S($G(SRTN):SRTN,$D(DA(2)):DA(2),$D(DA(1)):DA(1),$D(D0):D0,1:"")

 S SRC=$$ICDDX^ICDCODE(SRCODE,$P($G(^SRF(SRDA,0)),"^",9))

 Q $P(SRC,"^",2,4)

 ;

ACTIV(SRTN,SRCODE) ; screen for active ICD codes

 K ICDVDT

 N SROK,SRSDATE S SROK=1,SRSDATE=DT

 I $G(SRTN) S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7)

 S SROK=$P($$ICDDX^ICDCODE(SRCODE,SRSDATE),"^",10)

 S ICDVDT=SRSDATE

 Q SROK

SROICD    ;BIR/SJA - CODE SET VERSIONING UTILITY ; [ 01/30/03  05:50 PM ]

 +1       ;;3.0; Surgery ;**116,127**;24 Jun 93

 +2       ;

 +3       ;Reference to $$ICDDX^ICDCODE supported by DBIA #3990

 +4       ;

ICDC(SRCODE) ; output principal ICD

 +1        NEW SRC,SRSDATE,SRDA

 +2        IF $DATA(SRCODE)

               IF SRCODE=""

                   QUIT 

 +3        SET SRDA=$SELECT($GET(SRTN):SRTN,$DATA(DA(2)):DA(2),$DATA(DA(1)):DA(1),$DATA(D0):D0,1:"")

 +4        SET SRC=$$ICDDX^ICDCODE(SRCODE,$PIECE($GET(^SRF(SRDA,0)),"^",9))

 +5        QUIT $PIECE(SRC,"^",2,4)

 +6       ;

ACTIV(SRTN,SRCODE) ; screen for active ICD codes

 +1        KILL ICDVDT

 +2        NEW SROK,SRSDATE

           SET SROK=1

           SET SRSDATE=DT

 +3        IF $GET(SRTN)

               SET SRSDATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)

 +4        SET SROK=$PIECE($$ICDDX^ICDCODE(SRCODE,SRSDATE),"^",10)

 +5        SET ICDVDT=SRSDATE

 +6        QUIT SROK