ACDAUTO3.m

ACDAUTO3 ;IHS/ADC/EDE/KML - Broke up ACDAUTO1;

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

 ;;

MODV ; EP - MODIFY DEMOGRAPHIC PORTION OF VISIT JUST GENERATED

 ;RE DO THIS TO GET DEMOGRAPHICS FROM THE ACD CLIENT CATEGORY FILE.

 ;

 K ACDFIELD

 ;

 ;Update visit with new DFN and new TRIBE and SEX M F U & AGE RANGE

 ;Set up program pointer node

 ;Set up duplication flag i.e., field 100 upward pointer

 ;

 ;Get tribe name and tribe code

 S ACDTRBNM=$P(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,7),ACDTRBCD=$P(^(0),U,2)

 ;

 ;

 ;Get state name and state code

 S ACDSTANM=$P(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,6),ACDSTACD=$P(^(0),U,5)

 ;Get gender

 S ACDSEX=$P(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,3)

 ;

 ;Get age range/age

 S ACDAGER=$P(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,4),ACDAGE=$P(^(0),U,9)

 ;

 ;

 ;Get veteran status

 S ACDVET=$P(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,8)

 ;

 ;

 S DIE=9002172.1

 S DA=ACDPT1(ACDDFNP)

 S ACDPG=$G(^ACDVIS(ACDVISP,"BWP"))

 S DR="4////"_ACDDFNP_";9////"_ACDAGER_";99.99////"_ACDPG_";100////"_ACDVISP_";101////"_ACDTRBCD_";102////"_ACDSTACD_";103////"_ACDSEX_";104////"_ACDVET_";105////"_ACDTRBNM_";106////"_ACDSTANM_";107////"_ACDAGE

 D DIE^ACDFMC

 ;

 Q

ACDAUTO3  ;IHS/ADC/EDE/KML - Broke up ACDAUTO1;

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

 +2       ;;

MODV      ; EP - MODIFY DEMOGRAPHIC PORTION OF VISIT JUST GENERATED

 +1       ;RE DO THIS TO GET DEMOGRAPHICS FROM THE ACD CLIENT CATEGORY FILE.

 +2       ;

 +3        KILL ACDFIELD

 +4       ;

 +5       ;Update visit with new DFN and new TRIBE and SEX M F U & AGE RANGE

 +6       ;Set up program pointer node

 +7       ;Set up duplication flag i.e., field 100 upward pointer

 +8       ;

 +9       ;Get tribe name and tribe code

 +10       SET ACDTRBNM=$PIECE(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,7)

           SET ACDTRBCD=$PIECE(^(0),U,2)

 +11      ;

 +12      ;

 +13      ;Get state name and state code

 +14       SET ACDSTANM=$PIECE(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,6)

           SET ACDSTACD=$PIECE(^(0),U,5)

 +15      ;Get gender

 +16       SET ACDSEX=$PIECE(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,3)

 +17      ;

 +18      ;Get age range/age

 +19       SET ACDAGER=$PIECE(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,4)

           SET ACDAGE=$PIECE(^(0),U,9)

 +20      ;

 +21      ;

 +22      ;Get veteran status

 +23       SET ACDVET=$PIECE(^ACDPAT(ACDCATP,1,ACDDFNP,0),U,8)

 +24      ;

 +25      ;

 +26       SET DIE=9002172.1

 +27       SET DA=ACDPT1(ACDDFNP)

 +28       SET ACDPG=$GET(^ACDVIS(ACDVISP,"BWP"))

 +29       SET DR="4////"_ACDDFNP_";9////"_ACDAGER_";99.99////"_ACDPG_";100////"_ACDVISP_";101////"_ACDTRBCD_";102////"_ACDSTACD_";103////"_ACDSEX_";104////"_ACDVET_";105////"_ACDTRBNM_";106////"_ACDSTANM_";107////"_ACDAGE

 +30       DO DIE^ACDFMC

 +31      ;

 +32       QUIT