ACKQUT1.m

ACKQUT1 ;HCIOFO/BH - Quasar utilities routine ;11 Jun 2013  4:19 PM

 ;;3.0;QUASAR;**6,21**;Feb 11, 2000;Build 40

 ;

ACKCPT(CODE)    ;  Validate CPT code using today's date

 ;

 N ACKPARAM,DTE,X,Y

 D NOW^%DTC S DTE=$P(%,".",1)

 S ACKPARAM=$P($$CPT^ICPTCOD(CODE,DTE),"^",7)

 I 'ACKPARAM D

 . W !!

 . W "The selected code is not valid for today's date.",!!

 Q ACKPARAM

 ;

ACKICD(CODE) ;  Validate ICD code using today's date

 ;

 N ACKPARAM,DTE,X,Y

 D NOW^%DTC S DTE=$P(%,".",1)

 S ACKPARAM=$P($$ICDDATA^ICDXCODE("DIAG",CODE,DTE,"I"),"^",10)

 I $D(^TMP("ACKQ_CO_DIRECTIVE",$J)) S ACKPARAM=1

 I 'ACKPARAM D

 . W !!

 . W "The selected code is not valid for today's date.",!!

 ;

 Q ACKPARAM

 ;

 ;

CPT(CODE,ACKVD,ACKCSC) ; screen for active CPT codes

 N ACKPARAM

 I $P(^ACK(509850.4,CODE,0),U,2)'[$E(ACKCSC) Q 0

 I $P(^ACK(509850.4,CODE,0),U,4)'=1 Q 0

 S ACKPARAM=$P($$CPT^ICPTCOD(CODE,ACKVD),"^",7)

 Q ACKPARAM

 ;

 ;

ICD(CODE,ACKVD,ACKCSC) ; screen for active ICD codes

 N ACKPARAM

 I '$D(^ACK(509850.1,CODE,0)) Q 0

 I $P(^ACK(509850.1,CODE,0),U,4)'[$E(ACKCSC) Q 0

 I $P(^ACK(509850.1,CODE,0),U,6)'=1 Q 0

 I $P(^ACK(509850.1,CODE,0),U,7)'=$$ICDSYS^ACKQAICD(ACKVD) Q 0 ; Match ICD version in file to ICD version for date

 ;S ACKPARAM=$P($$ICDDX^ICDCODE(CODE,ACKVD),"^",10)

 ;

 S ACKPARAM=$P($$ICDDATA^ICDXCODE("DIAG",CODE,ACKVD),"^",10)

 Q ACKPARAM

 ;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ACKQUT1   1392     printed  Apr 09, 2024@21:35:27                                                                                                                                                                                                     Page 2

ACKQUT1   ;HCIOFO/BH - Quasar utilities routine ;11 Jun 2013  4:19 PM

 +1       ;;3.0;QUASAR;**6,21**;Feb 11, 2000;Build 40

 +2       ;

ACKCPT(CODE) ;  Validate CPT code using today's date

 +1       ;

 +2        NEW ACKPARAM,DTE,X,Y

 +3        DO NOW^%DTC

           SET DTE=$PIECE(%,".",1)

 +4        SET ACKPARAM=$PIECE($$CPT^ICPTCOD(CODE,DTE),"^",7)

 +5        IF 'ACKPARAM

               Begin DoDot:1

 +6                WRITE !!

 +7                WRITE "The selected code is not valid for today's date.",!!

               End DoDot:1

 +8        QUIT ACKPARAM

 +9       ;

ACKICD(CODE) ;  Validate ICD code using today's date

 +1       ;

 +2        NEW ACKPARAM,DTE,X,Y

 +3        DO NOW^%DTC

           SET DTE=$PIECE(%,".",1)

 +4        SET ACKPARAM=$PIECE($$ICDDATA^ICDXCODE("DIAG",CODE,DTE,"I"),"^",10)

 +5        IF $DATA(^TMP("ACKQ_CO_DIRECTIVE",$JOB))

               SET ACKPARAM=1

 +6        IF 'ACKPARAM

               Begin DoDot:1

 +7                WRITE !!

 +8                WRITE "The selected code is not valid for today's date.",!!

               End DoDot:1

 +9       ;

 +10       QUIT ACKPARAM

 +11      ;

 +12      ;

CPT(CODE,ACKVD,ACKCSC) ; screen for active CPT codes

 +1        NEW ACKPARAM

 +2        IF $PIECE(^ACK(509850.4,CODE,0),U,2)'[$EXTRACT(ACKCSC)

               QUIT 0

 +3        IF $PIECE(^ACK(509850.4,CODE,0),U,4)'=1

               QUIT 0

 +4        SET ACKPARAM=$PIECE($$CPT^ICPTCOD(CODE,ACKVD),"^",7)

 +5        QUIT ACKPARAM

 +6       ;

 +7       ;

ICD(CODE,ACKVD,ACKCSC) ; screen for active ICD codes

 +1        NEW ACKPARAM

 +2        IF '$DATA(^ACK(509850.1,CODE,0))

               QUIT 0

 +3        IF $PIECE(^ACK(509850.1,CODE,0),U,4)'[$EXTRACT(ACKCSC)

               QUIT 0

 +4        IF $PIECE(^ACK(509850.1,CODE,0),U,6)'=1

               QUIT 0

 +5       ; Match ICD version in file to ICD version for date

           IF $PIECE(^ACK(509850.1,CODE,0),U,7)'=$$ICDSYS^ACKQAICD(ACKVD)

               QUIT 0

 +6       ;S ACKPARAM=$P($$ICDDX^ICDCODE(CODE,ACKVD),"^",10)

 +7       ;

 +8        SET ACKPARAM=$PIECE($$ICDDATA^ICDXCODE("DIAG",CODE,ACKVD),"^",10)

 +9        QUIT ACKPARAM

 +10      ;

 +11      ;