ACDAGRG.m

ACDAGRG ;IHS/ADC/EDE/KML - GET AGE RANGE;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;; 01-26-98

 ;; 01-26-98

 ;

 ; Upon entry ACDDOV is the internal FileMan form of the visit date.

 ;

START ;

 NEW ACDDOB,ACDDOVX

 S:'$D(ACDDOV) ACDDOV=DT ;        for non visit related like ^ACDCSD

 S X=ACDDOV D H^%DTC S ACDDOVX=%H

 S X=$P(^DPT(ACDDFNP,0),"^",3) D H^%DTC S ACDDOB=%H

 S ACDAGE=ACDDOVX-ACDDOB\365.25

SETRG ; EP - COMPUTE AGE RANGE

 S ACDAGER=$S(ACDAGE<13:1,ACDAGE<19:2,ACDAGE<25:3,ACDAGE<35:4,ACDAGE<45:5,ACDAGE<55:6,ACDAGE<65:7,ACDAGE<75:8,1:9)

 Q

ACDAGRG   ;IHS/ADC/EDE/KML - GET AGE RANGE;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;; 01-26-98

 +3       ;; 01-26-98

 +4       ;

 +5       ; Upon entry ACDDOV is the internal FileMan form of the visit date.

 +6       ;

START     ;

 +1        NEW ACDDOB,ACDDOVX

 +2       ;        for non visit related like ^ACDCSD

           IF '$DATA(ACDDOV)

               SET ACDDOV=DT

 +3        SET X=ACDDOV

           DO H^%DTC

           SET ACDDOVX=%H

 +4        SET X=$PIECE(^DPT(ACDDFNP,0),"^",3)

           DO H^%DTC

           SET ACDDOB=%H

 +5        SET ACDAGE=ACDDOVX-ACDDOB\365.25

SETRG     ; EP - COMPUTE AGE RANGE

 +1        SET ACDAGER=$SELECT(ACDAGE<13:1,ACDAGE<19:2,ACDAGE<25:3,ACDAGE<35:4,ACDAGE<45:5,ACDAGE<55:6,ACDAGE<65:7,ACDAGE<75:8,1:9)

 +2        QUIT