| [613] | 1 | ACKQUT1 ;HCIOFO/BH-Quasar utilities routine ; 04/01/03
|
|---|
| 2 | ;;3.0;QUASAR;**6**;Feb 11, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ACKCPT(CODE) ; Validate CPT code using today's date
|
|---|
| 6 | ;
|
|---|
| 7 | N ACKPARAM,DTE,X,Y
|
|---|
| 8 | D NOW^%DTC S DTE=$P(%,".",1)
|
|---|
| 9 | S ACKPARAM=$P($$CPT^ICPTCOD(CODE,DTE),"^",7)
|
|---|
| 10 | I 'ACKPARAM D
|
|---|
| 11 | . W !!
|
|---|
| 12 | . W "The selected code is not valid for today's date.",!!
|
|---|
| 13 | Q ACKPARAM
|
|---|
| 14 | ;
|
|---|
| 15 | ACKICD(CODE) ; Validate ICD code using today's date
|
|---|
| 16 | ;
|
|---|
| 17 | N ACKPARAM,DTE,X,Y
|
|---|
| 18 | D NOW^%DTC S DTE=$P(%,".",1)
|
|---|
| 19 | S ACKPARAM=$P($$ICDDX^ICDCODE(CODE,DTE),"^",10)
|
|---|
| 20 | I 'ACKPARAM D
|
|---|
| 21 | . W !!
|
|---|
| 22 | . W "The selected code is not valid for today's date.",!!
|
|---|
| 23 | ;
|
|---|
| 24 | Q ACKPARAM
|
|---|
| 25 | ;
|
|---|
| 26 | ;
|
|---|
| 27 | CPT(CODE,ACKVD,ACKCSC) ; screen for active CPT codes
|
|---|
| 28 | N ACKPARAM
|
|---|
| 29 | I $P(^ACK(509850.4,CODE,0),U,2)'[$E(ACKCSC) Q 0
|
|---|
| 30 | I $P(^ACK(509850.4,CODE,0),U,4)'=1 Q 0
|
|---|
| 31 | S ACKPARAM=$P($$CPT^ICPTCOD(CODE,ACKVD),"^",7)
|
|---|
| 32 | Q ACKPARAM
|
|---|
| 33 | ;
|
|---|
| 34 | ;
|
|---|
| 35 | ICD(CODE,ACKVD,ACKCSC) ; screen for active ICD codes
|
|---|
| 36 | N ACKPARAM
|
|---|
| 37 | I $P(^ACK(509850.1,CODE,0),U,4)'[$E(ACKCSC) Q 0
|
|---|
| 38 | I $P(^ACK(509850.1,CODE,0),U,6)'=1 Q 0
|
|---|
| 39 | S ACKPARAM=$P($$ICDDX^ICDCODE(CODE,ACKVD),"^",10)
|
|---|
| 40 | Q ACKPARAM
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
