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 ---[H[J[2J[HACKQUT1 1392 printed Dec 13, 2024@02:32:48 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 ;
