ACDWCD4.m

ACDWCD4 ;IHS/ADC/EDE/KML - CLIENT DET OP FOR INTERVENTIONS 10:11;

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

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

 ;//^ACDWDRV3, ^ACDWIIF

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

 ;S ACDP1="" F  S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1=""  F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2  S ACDDA=ACDP2 D ^ACDWCINV D P1

 S ACDP1=""

 F  S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1=""  D  Q:$D(DIRUT)

 . F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2  S ACDDA=ACDP2 D ^ACDWCINV D P1 Q:$D(DIRUT)

 . Q

 D ^ACDWK Q

P1 ;Output

 D F W !,"CLIENT NAME:",?40,ACDDFN

 D F W !,"  VETERAN STATUS:",?40,ACDVET

 D F W !,"  AGE/SEX:",?40,$S($G(ACDAGE)'="":ACDAGE,1:"UNKNOWN - ")," YEARS OLD  / ",ACDSEX

 S ACDTRIBN=$O(^AUTTTRI("C",ACDTRIB,0)) I ACDTRIBN S ACDTRIBN=$P(^AUTTTRI(ACDTRIBN,0),U)

 S ACDSTATN=$O(^DIC(5,"C",ACDSTATE,0)) I ACDSTATN S ACDSTATN=$P(^DIC(5,ACDSTATN,0),U)

 D F W !,"  STATE/STATE CODE:",?40,$S($G(ACDSTATN)'="":$E(ACDSTATN,1,35),1:"UNKNOWN")," / ",ACDSTATE

 D F W !,"  TRIBE/TRIBE CODE",?40,$S($G(ACDTRIBN)'="":$E(ACDTRIBN,1,35),1:"UNKNOWN")," / ",ACDTRIB

 D F W !!,"VISIT DATE:",?40,ACDCLIV

 D F W !,"COMPONENT:",?40,ACDCOMCL," / ",ACDCOMTL

 D F W !,"INTERVENTION MEMBERS:" S ACDLP="" F  D F S ACDLP=$O(ACDPROVA(ACDLP)) Q:ACDLP=""  W ?40,ACDLP,!

 D F W !!,"PRIMARY PROBLEM:",?40,ACDPROBP

 D F W !,"OTHER PROBLEMS:" S ACDLP="" F  D F S ACDLP=$O(ACDPTA(ACDLP)) Q:ACDLP=""  W ?40,ACDLP,!

 D F W !!,"SUICIDE HISTORY:",?40,ACDINVSH

XXX ;

 D F W !!,"RECOMMENDED PLACEMENT:",?40,ACDPLAR_" / "_ACDPLAR1

 D F W !,"ACTUAL PLACEMENT:",?40,ACDPLAA_" / "_ACDPLAA1

 D F W !,"DIFFERENCE REASON:",?40,ACDDIF

 D F W !,"PLACEMENT PROGRAM: ",?40,ACDINVPP

 D F W !,"COST ($$$): ",?40,ACDINVCT

 D F W !,"TOTAL DAYS OF TREATMENT:",?40,ACDINVTD

 D F W !,"TREATMENT COMPLETE:",?40,ACDINVTC

 W !!,"..........................................",!

 ;

 Q

F ;Form feed

 Q:$D(DIRUT)

 I $Y+4>IOSL D F^ACDWUTL

ACDWCD4   ;IHS/ADC/EDE/KML - CLIENT DET OP FOR INTERVENTIONS 10:11;

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

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

 +3       ;//^ACDWDRV3, ^ACDWIIF

 +4       ;*********************************************************************

 +5       ;S ACDP1="" F  S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1=""  F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2  S ACDDA=ACDP2 D ^ACDWCINV D P1

 +6        SET ACDP1=""

 +7        FOR 

               SET ACDP1=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1))

               IF ACDP1=""

                   QUIT 

               Begin DoDot:1

 +8                FOR ACDP2=0:0

                       SET ACDP2=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2))

                       IF 'ACDP2

                           QUIT 

                       SET ACDDA=ACDP2

                       DO ^ACDWCINV

                       DO P1

                       IF $DATA(DIRUT)

                           QUIT 

 +9                QUIT 

               End DoDot:1

               IF $DATA(DIRUT)

                   QUIT 

 +10       DO ^ACDWK

           QUIT 

P1        ;Output

 +1        DO F

           WRITE !,"CLIENT NAME:",?40,ACDDFN

 +2        DO F

           WRITE !,"  VETERAN STATUS:",?40,ACDVET

 +3        DO F

           WRITE !,"  AGE/SEX:",?40,$SELECT($GET(ACDAGE)'="":ACDAGE,1:"UNKNOWN - ")," YEARS OLD  / ",ACDSEX

 +4        SET ACDTRIBN=$ORDER(^AUTTTRI("C",ACDTRIB,0))

           IF ACDTRIBN

               SET ACDTRIBN=$PIECE(^AUTTTRI(ACDTRIBN,0),U)

 +5        SET ACDSTATN=$ORDER(^DIC(5,"C",ACDSTATE,0))

           IF ACDSTATN

               SET ACDSTATN=$PIECE(^DIC(5,ACDSTATN,0),U)

 +6        DO F

           WRITE !,"  STATE/STATE CODE:",?40,$SELECT($GET(ACDSTATN)'="":$EXTRACT(ACDSTATN,1,35),1:"UNKNOWN")," / ",ACDSTATE

 +7        DO F

           WRITE !,"  TRIBE/TRIBE CODE",?40,$SELECT($GET(ACDTRIBN)'="":$EXTRACT(ACDTRIBN,1,35),1:"UNKNOWN")," / ",ACDTRIB

 +8        DO F

           WRITE !!,"VISIT DATE:",?40,ACDCLIV

 +9        DO F

           WRITE !,"COMPONENT:",?40,ACDCOMCL," / ",ACDCOMTL

 +10       DO F

           WRITE !,"INTERVENTION MEMBERS:"

           SET ACDLP=""

           FOR 

               DO F

               SET ACDLP=$ORDER(ACDPROVA(ACDLP))

               IF ACDLP=""

                   QUIT 

               WRITE ?40,ACDLP,!

 +11       DO F

           WRITE !!,"PRIMARY PROBLEM:",?40,ACDPROBP

 +12       DO F

           WRITE !,"OTHER PROBLEMS:"

           SET ACDLP=""

           FOR 

               DO F

               SET ACDLP=$ORDER(ACDPTA(ACDLP))

               IF ACDLP=""

                   QUIT 

               WRITE ?40,ACDLP,!

 +13       DO F

           WRITE !!,"SUICIDE HISTORY:",?40,ACDINVSH

XXX       ;

 +1        DO F

           WRITE !!,"RECOMMENDED PLACEMENT:",?40,ACDPLAR_" / "_ACDPLAR1

 +2        DO F

           WRITE !,"ACTUAL PLACEMENT:",?40,ACDPLAA_" / "_ACDPLAA1

 +3        DO F

           WRITE !,"DIFFERENCE REASON:",?40,ACDDIF

 +4        DO F

           WRITE !,"PLACEMENT PROGRAM: ",?40,ACDINVPP

 +5        DO F

           WRITE !,"COST ($$$): ",?40,ACDINVCT

 +6        DO F

           WRITE !,"TOTAL DAYS OF TREATMENT:",?40,ACDINVTD

 +7        DO F

           WRITE !,"TREATMENT COMPLETE:",?40,ACDINVTC

 +8        WRITE !!,"..........................................",!

 +9       ;

 +10       QUIT 

F         ;Form feed

 +1        IF $DATA(DIRUT)

               QUIT 

 +2        IF $Y+4>IOSL

               DO F^ACDWUTL