ACDWCD1 ;IHS/ADC/EDE/KML - CLIENT DET OP FOR IN/RE/IR/FU/OT;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;*********************************************************************
;//^ACDWDRV3, ^ACDWIIF, ^ACDPFACE
;*********************************************************************
K ACDQUIT
S ACDP1="" F S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1="" D Q:$D(ACDQUIT)
. F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2 S ACDDA=ACDP2 D ^ACDWIIF S ACDDA=^ACDIIF(ACDP2,"BWP") D ^ACDWVIS D P1 Q:$D(ACDQUIT)
. Q
D ^ACDWK
Q
;
P1 ;EP-Output
;//^ACDPFACE
I $D(ACDPFACE),$D(IOF),$E(IOST,1,2)'="P-" W @IOF
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 !,"TYPE CONTACT:",?40,ACDCONTL
D F W !!,"PROVIDER:",?40,ACDPROV
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 !,"TOBACCO USE:",?40,ACDTOB
D F W !,"DAYS USED ALCOHOL:",?40,ACDDUA,$S(ACDDUA=999:"=UNKNOWN",1:"")
D F W !,"DAYS USED DRUGS:",?40,ACDDUD,$S(ACDDUD=999:"=UNKNOWN",1:"")
D F W !,"DRUG TYPE:" S ACDLP="" F D F S ACDLP=$O(ACDDTA(ACDLP)) Q:ACDLP="" W ?40,ACDLP,!
D F W !,"DAYS HOSPITALIZED:",?40,ACDDH,$S(ACDDH=999:"=UNKNOWN",1:"")
D F W !,"DRUG/ALCOHOL RELATED ARREST:",?40,ACDAAR
D F W !!,"CLIENT STAGE ALC/SUB:",?40,ACDSUS
D F W !,"CLIENT STAGE PHYSICAL:",?40,ACDPS
D F W !,"CLIENT STAGE EMOTIONAL:",?40,ACDES
D F W !,"CLIENT STAGE SOCIAL:",?40,ACDSS
D F W !,"CLIENT STAGE CULTURAL:",?40,ACDCS
D F W !,"CLIENT STAGE BEHAVIORAL:",?40,ACDBS
D F W !,"CLIENT STAGE VOC/ED:",?40,ACDBV
D F W !,"STAGING AVERAGE:",?40,ACDSAVG
D F W !,"CLIENT STATUS:",?40,$S(ACDSTAT="UNKNOWN":"",1:ACDSTAT)
D F W !!,"RECOMMENDED PLACEMENT:",?40,ACDPLAR_" / "_ACDPLARL
D F W !,"ACTUAL PLACEMENT:",?40,ACDPLAA_" / "_ACDPLAAL
D F W !,"DIFFERENCE REASON:",?40,ACDDIF
D F W !!,"HOURS:",?40,ACDHRS
W !!,"..........................................",!
;
Q
F ;Form feed
I $Y+4>IOSL D
. I '$D(ACDPFACE) D F^ACDWUTL Q
. I '$D(ZTQUEUED),'$D(ACDSLAVE),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU S:$D(DIRUT) ACDQUIT=1,ACDQ=1
. W @IOF
. Q
Q
ACDWCD1 ;IHS/ADC/EDE/KML - CLIENT DET OP FOR IN/RE/IR/FU/OT;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;*********************************************************************
+3 ;//^ACDWDRV3, ^ACDWIIF, ^ACDPFACE
+4 ;*********************************************************************
+5 KILL ACDQUIT
+6 SET ACDP1=""
FOR
SET ACDP1=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1))
IF ACDP1=""
QUIT
Begin DoDot:1
+7 FOR ACDP2=0:0
SET ACDP2=$ORDER(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2))
IF 'ACDP2
QUIT
SET ACDDA=ACDP2
DO ^ACDWIIF
SET ACDDA=^ACDIIF(ACDP2,"BWP")
DO ^ACDWVIS
DO P1
IF $DATA(ACDQUIT)
QUIT
+8 QUIT
End DoDot:1
IF $DATA(ACDQUIT)
QUIT
+9 DO ^ACDWK
+10 QUIT
+11 ;
P1 ;EP-Output
+1 ;//^ACDPFACE
+2 IF $DATA(ACDPFACE)
IF $DATA(IOF)
IF $EXTRACT(IOST,1,2)'="P-"
WRITE @IOF
+3 DO F
WRITE !,"CLIENT NAME:",?40,ACDDFN
+4 DO F
WRITE !," VETERAN STATUS:",?40,ACDVET
+5 DO F
WRITE !," AGE/SEX:",?40,$SELECT($GET(ACDAGE)'="":ACDAGE,1:"UNKNOWN - ")," YEARS OLD / ",ACDSEX
+6 SET ACDTRIBN=$ORDER(^AUTTTRI("C",ACDTRIB,0))
IF ACDTRIBN
SET ACDTRIBN=$PIECE(^AUTTTRI(ACDTRIBN,0),U)
+7 SET ACDSTATN=$ORDER(^DIC(5,"C",ACDSTATE,0))
IF ACDSTATN
SET ACDSTATN=$PIECE(^DIC(5,ACDSTATN,0),U)
+8 DO F
WRITE !," STATE/STATE CODE:",?40,$SELECT($GET(ACDSTATN)'="":$EXTRACT(ACDSTATN,1,35),1:"UNKNOWN")," / ",ACDSTATE
+9 DO F
WRITE !," TRIBE/TRIBE CODE",?40,$SELECT($GET(ACDTRIBN)'="":$EXTRACT(ACDTRIBN,1,35),1:"UNKNOWN")," / ",ACDTRIB
+10 DO F
WRITE !!,"VISIT DATE:",?40,ACDCLIV
+11 DO F
WRITE !,"COMPONENT:",?40,ACDCOMCL," / ",ACDCOMTL
+12 DO F
WRITE !,"TYPE CONTACT:",?40,ACDCONTL
+13 DO F
WRITE !!,"PROVIDER:",?40,ACDPROV
+14 DO F
WRITE !,"PRIMARY PROBLEM:",?40,ACDPROBP
+15 DO F
WRITE !,"OTHER PROBLEMS:"
SET ACDLP=""
FOR
DO F
SET ACDLP=$ORDER(ACDPTA(ACDLP))
IF ACDLP=""
QUIT
WRITE ?40,ACDLP,!
+16 DO F
WRITE !,"TOBACCO USE:",?40,ACDTOB
+17 DO F
WRITE !,"DAYS USED ALCOHOL:",?40,ACDDUA,$SELECT(ACDDUA=999:"=UNKNOWN",1:"")
+18 DO F
WRITE !,"DAYS USED DRUGS:",?40,ACDDUD,$SELECT(ACDDUD=999:"=UNKNOWN",1:"")
+19 DO F
WRITE !,"DRUG TYPE:"
SET ACDLP=""
FOR
DO F
SET ACDLP=$ORDER(ACDDTA(ACDLP))
IF ACDLP=""
QUIT
WRITE ?40,ACDLP,!
+20 DO F
WRITE !,"DAYS HOSPITALIZED:",?40,ACDDH,$SELECT(ACDDH=999:"=UNKNOWN",1:"")
+21 DO F
WRITE !,"DRUG/ALCOHOL RELATED ARREST:",?40,ACDAAR
+22 DO F
WRITE !!,"CLIENT STAGE ALC/SUB:",?40,ACDSUS
+23 DO F
WRITE !,"CLIENT STAGE PHYSICAL:",?40,ACDPS
+24 DO F
WRITE !,"CLIENT STAGE EMOTIONAL:",?40,ACDES
+25 DO F
WRITE !,"CLIENT STAGE SOCIAL:",?40,ACDSS
+26 DO F
WRITE !,"CLIENT STAGE CULTURAL:",?40,ACDCS
+27 DO F
WRITE !,"CLIENT STAGE BEHAVIORAL:",?40,ACDBS
+28 DO F
WRITE !,"CLIENT STAGE VOC/ED:",?40,ACDBV
+29 DO F
WRITE !,"STAGING AVERAGE:",?40,ACDSAVG
+30 DO F
WRITE !,"CLIENT STATUS:",?40,$SELECT(ACDSTAT="UNKNOWN":"",1:ACDSTAT)
+31 DO F
WRITE !!,"RECOMMENDED PLACEMENT:",?40,ACDPLAR_" / "_ACDPLARL
+32 DO F
WRITE !,"ACTUAL PLACEMENT:",?40,ACDPLAA_" / "_ACDPLAAL
+33 DO F
WRITE !,"DIFFERENCE REASON:",?40,ACDDIF
+34 DO F
WRITE !!,"HOURS:",?40,ACDHRS
+35 WRITE !!,"..........................................",!
+36 ;
+37 QUIT
F ;Form feed
+1 IF $Y+4>IOSL
Begin DoDot:1
+2 IF '$DATA(ACDPFACE)
DO F^ACDWUTL
QUIT
+3 IF '$DATA(ZTQUEUED)
IF '$DATA(ACDSLAVE)
IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^ACDDEU
IF $DATA(DIRUT)
SET ACDQUIT=1
SET ACDQ=1
+4 WRITE @IOF
+5 QUIT
End DoDot:1
+6 QUIT
