source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQUT1.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1ACKQUT1 ;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 ;
5ACKCPT(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 ;
15ACKICD(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 ;
27CPT(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 ;
35ICD(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 ;
Note: See TracBrowser for help on using the repository browser.