ACDWVIS.m

ACDWVIS ;IHS/ADC/EDE/KML - SET LOC VARS FROM ACDVIS GLOBAL;

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

 ;*******************************************************************

 ;//^ACDWCD1, ^ACDWCD2, ^ACDWCD3,^ACDWDRV1,^ACDWDRV2,^ACDWDRV3,^ACDWDRV4

 ;//^ACDWSTAF

 ;Needs ACDDA as internal DA to file entry

 ;*****************************************************************

 S ACDN0=^ACDVIS(ACDDA,0) S:$P(ACDN0,U,2)="" $P(ACDN0,U,2)="PHANTOM"

 S ACDPG=^ACDVIS(ACDDA,"BWP")

 I $D(^ACDF5PI(ACDPG,0)) S ACDPG=$P(^ACDF5PI(ACDPG,0),U),ACDPG=$P(^AUTTLOC(ACDPG,0),U),ACDAUF=$P(^(0),U,10),ACDPG=$P(^DIC(4,ACDPG,0),U)

 E  S ACDPG="NOT DEFINED"

 S Y=$P(ACDN0,U) S ACDCLIV=$$DD^ACDFUNC(Y)

 S ACDCOMC=$P(ACDN0,U,2)

 S ACDCOMCS="???" S:ACDCOMC ACDCOMCS=$P($G(^ACDCOMP(ACDCOMC,0)),U,2)

 S ACDCOMCL=$P($G(^ACDCOMP(ACDCOMC,0)),U)

 ;S ACDP(3)=$S($D(^ACDCOMP(ACDCOMC,0)):$P(^(0),U,6),1:""),ACDP(1)=9002170.1,ACDP(2)=5 S ACDCOMCL=$$SETS^ACDFUNC(.ACDP)

 S ACDCOMT=$P(ACDN0,U,7)

 S ACDP(3)=ACDCOMT,ACDP(1)=9002172.1,ACDP(2)=5 S ACDCOMTL=$$SETS^ACDFUNC(.ACDP)

 ;S ACDPROV=$P(ACDN0,U,3) S:'ACDPROV ACDPROV="NONE",ACDDFNP=0 S ACDPROV=$S($D(^DIC(16,ACDPROV,0)):$P(^(0),U),1:"NONE")

 S ACDPROV=$P(ACDN0,U,3) S:'ACDPROV ACDPROV="NONE",ACDDFNP=0 S ACDPROV=$S($D(^VA(200,ACDPROV,0)):$P(^(0),U),1:"NONE")

 S ACDPROVP=$P(ACDN0,U,3)

 S ACDCONT=$P(ACDN0,U,4)

 S ACDP(3)=ACDCONT,ACDP(1)=9002172.1,ACDP(2)=3 S ACDCONTL=$$SETS^ACDFUNC(.ACDP)

 S (ACDDFN,ACDDFNP)=$P(ACDN0,U,5) S:'ACDDFN ACDDFN="NONE",ACDDFNP=0 S ACDDFN=$S($D(^DPT(ACDDFN,0)):$P(^(0),U),1:"NONE")

 S ACDFOLL=$P(ACDN0,U,6) S:$G(ACDFOLL)="" ACDFOLL="UNKNOWN"

 S ACDTRIB=$P(ACDN0,U,10) S:ACDTRIB="" ACDTRIB="UNKNOWN"

 S ACDSTATE=$P(ACDN0,U,11) S:ACDSTATE="" ACDSTATE="UNKNOWN"

 ;Many records at HQ/AREA could have the same DFN but they came from

 ;different facilities. So, use ACDAUF_ACDDFNP so reports will sort

 ;properly and be accurate. Only use when visit has a patient pointer.

 I ACDDFNP'=0 S ACDDFNP=1_ACDAUF_ACDDFNP

 S ACDFOLMO=$P(ACDN0,U,6)

 S ACDP(3)=$P(ACDN0,U,13),ACDP1(1)=9002172.1,ACDP(2)=104 S ACDVET=$$SETS^ACDFUNC(.ACDP)

 S ACDAGE=$P(ACDN0,U,16)

 S ACDP(3)=$P(ACDN0,U,8),ACDP(2)=9,ACDP(1)=9002172.1 S ACDAGER=$$SETS^ACDFUNC(.ACDP)

 S ACDP(3)=$P(ACDN0,U,12),ACDP(1)=9002172.1,ACDP(2)=103,ACDSEX=$$SETS^ACDFUNC(.ACDP)

 S:'ACDDFNP ACDDFNP=.1 ;***********************

 ;

 ;If staff report, stop after getting locals from the visit file

 ;

 I $D(ACDWSTAF(1)) Q

MATCH ;EP

 ;//^ACDWDRV3

 ;***************************************************************

 ;This is the key to building report data or not. We go to ^ACDWASF

 ;and check to see if the record ASUFAC matches one of the arrays

 ;defined by the user's request. If so, ACDONE,ACDTWO,ACDTHREE will

 ;come back defined.

 ;If a match is found, keep counters of how many visit records matched

 ;for the area, su,facility,state,tribe,community, or contact type

 ;***************************************************************

 S ACDOK=0 D ^ACDWASF I $D(ACDONE),$D(ACDTWO),$D(ACDTHREE) S ACDOK=1 D ACDTRB,ACDSTA,CNT

 ;

 I $D(ACDCRST($P(ACDN0,U,4))),ACDOK S ACDCRST($P(ACDN0,U,4))=ACDCRST($P(ACDN0,U,4))+1

 I $D(ACDTRB(ACDTRIB)),ACDOK S ACDTRB(ACDTRIB)=ACDTRB(ACDTRIB)+1

 I $D(ACDSTA(ACDSTATE)),ACDOK S ACDSTA(ACDSTATE)=ACDSTA(ACDSTATE)+1

 I $D(ACDFAC(ACDAUF)),ACDOK S ACDFAC(ACDAUF)=ACDFAC(ACDAUF)+1 Q

 I $D(ACDAREA($E(ACDAUF,1,2))),ACDOK S ACDAREA($E(ACDAUF,1,2))=ACDAREA($E(ACDAUF,1,2))+1 Q

 I $D(ACDSU($E(ACDAUF,1,4))),ACDOK S ACDSU($E(ACDAUF,1,4))=ACDSU($E(ACDAUF,1,4))+1 Q

 ;

 ;**************************************************************

 ;If the user has selected to run the area, su, or facility reports

 ;with a further restriction by tribe, state, or community, come here

 ;and further validate the record meets print criteria.

 ;*************************************************************

 ;

ACDTRB ;

 ;See if user running by tribe

 I '$D(ACDTRB) Q  ;User not running by tribe

 I $D(ACDTRB("*ALL*")) Q  ;User wants all tribes

 I '$D(ACDTRB(ACDTRIB)) S ACDOK=0 Q  ;Sel tribes or category

 ;

ACDSTA ;

 ;See if user running by state

 I '$D(ACDSTA) Q  ;User not running by state

 I $D(ACDSTA("*ALL*")) Q  ;User wants all states

 I '$D(ACDSTA(ACDSTATE)) S ACDOK=0 Q  ;Sel states or categories

 ;

 ;

 ;

CNT ;Check to see if user is restricting output by contact type and

 ;if so, check the contact type of visit and see if it matches

 ;one that the user requested

 Q:'$D(ACDWDRV(1))

 I $D(ACDCRST),'$D(ACDCRST($P(ACDN0,U,4))) S ACDOK=0

ACDWVIS   ;IHS/ADC/EDE/KML - SET LOC VARS FROM ACDVIS GLOBAL;

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

 +2       ;*******************************************************************

 +3       ;//^ACDWCD1, ^ACDWCD2, ^ACDWCD3,^ACDWDRV1,^ACDWDRV2,^ACDWDRV3,^ACDWDRV4

 +4       ;//^ACDWSTAF

 +5       ;Needs ACDDA as internal DA to file entry

 +6       ;*****************************************************************

 +7        SET ACDN0=^ACDVIS(ACDDA,0)

           IF $PIECE(ACDN0,U,2)=""

               SET $PIECE(ACDN0,U,2)="PHANTOM"

 +8        SET ACDPG=^ACDVIS(ACDDA,"BWP")

 +9        IF $DATA(^ACDF5PI(ACDPG,0))

               SET ACDPG=$PIECE(^ACDF5PI(ACDPG,0),U)

               SET ACDPG=$PIECE(^AUTTLOC(ACDPG,0),U)

               SET ACDAUF=$PIECE(^(0),U,10)

               SET ACDPG=$PIECE(^DIC(4,ACDPG,0),U)

 +10      IF '$TEST

               SET ACDPG="NOT DEFINED"

 +11       SET Y=$PIECE(ACDN0,U)

           SET ACDCLIV=$$DD^ACDFUNC(Y)

 +12       SET ACDCOMC=$PIECE(ACDN0,U,2)

 +13       SET ACDCOMCS="???"

           IF ACDCOMC

               SET ACDCOMCS=$PIECE($GET(^ACDCOMP(ACDCOMC,0)),U,2)

 +14       SET ACDCOMCL=$PIECE($GET(^ACDCOMP(ACDCOMC,0)),U)

 +15      ;S ACDP(3)=$S($D(^ACDCOMP(ACDCOMC,0)):$P(^(0),U,6),1:""),ACDP(1)=9002170.1,ACDP(2)=5 S ACDCOMCL=$$SETS^ACDFUNC(.ACDP)

 +16       SET ACDCOMT=$PIECE(ACDN0,U,7)

 +17       SET ACDP(3)=ACDCOMT

           SET ACDP(1)=9002172.1

           SET ACDP(2)=5

           SET ACDCOMTL=$$SETS^ACDFUNC(.ACDP)

 +18      ;S ACDPROV=$P(ACDN0,U,3) S:'ACDPROV ACDPROV="NONE",ACDDFNP=0 S ACDPROV=$S($D(^DIC(16,ACDPROV,0)):$P(^(0),U),1:"NONE")

 +19       SET ACDPROV=$PIECE(ACDN0,U,3)

           IF 'ACDPROV

               SET ACDPROV="NONE"

               SET ACDDFNP=0

           SET ACDPROV=$SELECT($DATA(^VA(200,ACDPROV,0)):$PIECE(^(0),U),1:"NONE")

 +20       SET ACDPROVP=$PIECE(ACDN0,U,3)

 +21       SET ACDCONT=$PIECE(ACDN0,U,4)

 +22       SET ACDP(3)=ACDCONT

           SET ACDP(1)=9002172.1

           SET ACDP(2)=3

           SET ACDCONTL=$$SETS^ACDFUNC(.ACDP)

 +23       SET (ACDDFN,ACDDFNP)=$PIECE(ACDN0,U,5)

           IF 'ACDDFN

               SET ACDDFN="NONE"

               SET ACDDFNP=0

           SET ACDDFN=$SELECT($DATA(^DPT(ACDDFN,0)):$PIECE(^(0),U),1:"NONE")

 +24       SET ACDFOLL=$PIECE(ACDN0,U,6)

           IF $GET(ACDFOLL)=""

               SET ACDFOLL="UNKNOWN"

 +25       SET ACDTRIB=$PIECE(ACDN0,U,10)

           IF ACDTRIB=""

               SET ACDTRIB="UNKNOWN"

 +26       SET ACDSTATE=$PIECE(ACDN0,U,11)

           IF ACDSTATE=""

               SET ACDSTATE="UNKNOWN"

 +27      ;Many records at HQ/AREA could have the same DFN but they came from

 +28      ;different facilities. So, use ACDAUF_ACDDFNP so reports will sort

 +29      ;properly and be accurate. Only use when visit has a patient pointer.

 +30       IF ACDDFNP'=0

               SET ACDDFNP=1_ACDAUF_ACDDFNP

 +31       SET ACDFOLMO=$PIECE(ACDN0,U,6)

 +32       SET ACDP(3)=$PIECE(ACDN0,U,13)

           SET ACDP1(1)=9002172.1

           SET ACDP(2)=104

           SET ACDVET=$$SETS^ACDFUNC(.ACDP)

 +33       SET ACDAGE=$PIECE(ACDN0,U,16)

 +34       SET ACDP(3)=$PIECE(ACDN0,U,8)

           SET ACDP(2)=9

           SET ACDP(1)=9002172.1

           SET ACDAGER=$$SETS^ACDFUNC(.ACDP)

 +35       SET ACDP(3)=$PIECE(ACDN0,U,12)

           SET ACDP(1)=9002172.1

           SET ACDP(2)=103

           SET ACDSEX=$$SETS^ACDFUNC(.ACDP)

 +36      ;***********************

           IF 'ACDDFNP

               SET ACDDFNP=.1

 +37      ;

 +38      ;If staff report, stop after getting locals from the visit file

 +39      ;

 +40       IF $DATA(ACDWSTAF(1))

               QUIT 

MATCH     ;EP

 +1       ;//^ACDWDRV3

 +2       ;***************************************************************

 +3       ;This is the key to building report data or not. We go to ^ACDWASF

 +4       ;and check to see if the record ASUFAC matches one of the arrays

 +5       ;defined by the user's request. If so, ACDONE,ACDTWO,ACDTHREE will

 +6       ;come back defined.

 +7       ;If a match is found, keep counters of how many visit records matched

 +8       ;for the area, su,facility,state,tribe,community, or contact type

 +9       ;***************************************************************

 +10       SET ACDOK=0

           DO ^ACDWASF

           IF $DATA(ACDONE)

               IF $DATA(ACDTWO)

                   IF $DATA(ACDTHREE)

                       SET ACDOK=1

                       DO ACDTRB

                       DO ACDSTA

                       DO CNT

 +11      ;

 +12       IF $DATA(ACDCRST($PIECE(ACDN0,U,4)))

               IF ACDOK

                   SET ACDCRST($PIECE(ACDN0,U,4))=ACDCRST($PIECE(ACDN0,U,4))+1

 +13       IF $DATA(ACDTRB(ACDTRIB))

               IF ACDOK

                   SET ACDTRB(ACDTRIB)=ACDTRB(ACDTRIB)+1

 +14       IF $DATA(ACDSTA(ACDSTATE))

               IF ACDOK

                   SET ACDSTA(ACDSTATE)=ACDSTA(ACDSTATE)+1

 +15       IF $DATA(ACDFAC(ACDAUF))

               IF ACDOK

                   SET ACDFAC(ACDAUF)=ACDFAC(ACDAUF)+1

                   QUIT 

 +16       IF $DATA(ACDAREA($EXTRACT(ACDAUF,1,2)))

               IF ACDOK

                   SET ACDAREA($EXTRACT(ACDAUF,1,2))=ACDAREA($EXTRACT(ACDAUF,1,2))+1

                   QUIT 

 +17       IF $DATA(ACDSU($EXTRACT(ACDAUF,1,4)))

               IF ACDOK

                   SET ACDSU($EXTRACT(ACDAUF,1,4))=ACDSU($EXTRACT(ACDAUF,1,4))+1

                   QUIT 

 +18      ;

 +19      ;**************************************************************

 +20      ;If the user has selected to run the area, su, or facility reports

 +21      ;with a further restriction by tribe, state, or community, come here

 +22      ;and further validate the record meets print criteria.

 +23      ;*************************************************************

 +24      ;

ACDTRB    ;

 +1       ;See if user running by tribe

 +2       ;User not running by tribe

           IF '$DATA(ACDTRB)

               QUIT 

 +3       ;User wants all tribes

           IF $DATA(ACDTRB("*ALL*"))

               QUIT 

 +4       ;Sel tribes or category

           IF '$DATA(ACDTRB(ACDTRIB))

               SET ACDOK=0

               QUIT 

 +5       ;

ACDSTA    ;

 +1       ;See if user running by state

 +2       ;User not running by state

           IF '$DATA(ACDSTA)

               QUIT 

 +3       ;User wants all states

           IF $DATA(ACDSTA("*ALL*"))

               QUIT 

 +4       ;Sel states or categories

           IF '$DATA(ACDSTA(ACDSTATE))

               SET ACDOK=0

               QUIT 

 +5       ;

 +6       ;

 +7       ;

CNT       ;Check to see if user is restricting output by contact type and

 +1       ;if so, check the contact type of visit and see if it matches

 +2       ;one that the user requested

 +3        IF '$DATA(ACDWDRV(1))

               QUIT 

 +4        IF $DATA(ACDCRST)

               IF '$DATA(ACDCRST($PIECE(ACDN0,U,4)))

                   SET ACDOK=0