- 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
