Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDWCD70

ACDWCD70.m

Go to the documentation of this file.
  1. ACDWCD70 ;IHS/ADC/EDE/KML - CLENT DET OP FOR FU;
  1. ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1. ;*********************************************************************
  1. ;//^ACDWDRV3, ^ACDWIIF
  1. ;*********************************************************************
  1. ;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 ^ACDWIIF S ACDDA=^ACDIIF(ACDP2,"BWP") D ^ACDWVIS D P1
  1. S ACDP1=""
  1. F S ACDP1=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1)) Q:ACDP1="" D Q:$D(DIRUT)
  1. . F ACDP2=0:0 S ACDP2=$O(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDP1,ACDP2)) Q:'ACDP2 D Q:$D(DIRUT)
  1. .. S ACDDA=ACDP2 D ^ACDWIIF S ACDDA=^ACDIIF(ACDP2,"BWP") D ^ACDWVIS D P1
  1. .. Q
  1. . Q
  1. D ^ACDWK Q
  1. P1 ;Output
  1. D F W !,"CLIENT NAME:",?40,ACDDFN
  1. D F W !," VETERAN STATUS:",?40,ACDVET
  1. D F W !," AGE/SEX:",?40,$S($G(ACDAGE)'="":ACDAGE,1:"UNKNOWN - ")," YEARS OLD / ",ACDSEX
  1. S ACDTRIBN=$O(^AUTTTRI("C",ACDTRIB,0)) I ACDTRIBN S ACDTRIBN=$P(^AUTTTRI(ACDTRIBN,0),U)
  1. S ACDSTATN=$O(^DIC(5,"C",ACDSTATE,0)) I ACDSTATN S ACDSTATN=$P(^DIC(5,ACDSTATN,0),U)
  1. D F W !," STATE/STATE CODE:",?40,$S($G(ACDSTATN)'="":$E(ACDSTATN,1,35),1:"UNKNOWN")," / ",ACDSTATE
  1. D F W !," TRIBE/TRIBE CODE",?40,$S($G(ACDTRIBN)'="":$E(ACDTRIBN,1,35),1:"UNKNOWN")," / ",ACDTRIB
  1. D F W !!,"VISIT DATE:",?40,ACDCLIV
  1. D F W !,"COMPONENT:",?40,ACDCOMCL," / ",ACDCOMTL
  1. D F W !!,"PROVIDER:",?40,ACDPROV
  1. D F W !,"FOLLOW UP MONTHS:",?40,ACDFOLL
  1. D F W !,"PRIMARY PROBLEM:",?40,ACDPROBP
  1. D F W !,"OTHER PROBLEMS:" S ACDLP="" F D F S ACDLP=$O(ACDPTA(ACDLP)) Q:ACDLP="" W ?40,ACDLP,!
  1. D F W !,"CLIENT IN TREATMENT:",?40,ACDCIT
  1. D F W !,"DAYS USED ALCOHOL:",?40,ACDDUA,$S(ACDDUA=999:"=UNKNOWN",1:"")
  1. D F W !,"DAYS USED DRUGS:",?40,ACDDUD,$S(ACDDUD=999:"=UNKNOWN",1:"")
  1. D F W !,"DRUG TYPE:" S ACDLP="" F D F S ACDLP=$O(ACDDTA(ACDLP)) Q:ACDLP="" W ?40,ACDLP,!
  1. D F W !,"DAYS HOSPITALIZED:",?40,ACDDH,$S(ACDDH=999:"=UNKNOWN",1:"")
  1. D F W !,"DRUG/ALCOHOL RELATED ARREST:",?40,ACDAAR
  1. D F W !!,"CLIENT STAGE ALC/SUB:",?40,ACDSUS
  1. D F W !,"CLIENT STAGE PHYSICAL:",?40,ACDPS
  1. D F W !,"CLIENT STAGE EMOTIONAL:",?40,ACDES
  1. D F W !,"CLIENT STAGE SOCIAL:",?40,ACDSS
  1. D F W !,"CLIENT STAGE CULTURAL:",?40,ACDCS
  1. D F W !,"CLIENT STAGE BEHAVIORAL:",?40,ACDBS
  1. W !!,"..........................................",!
  1. Q
  1. F ;Form feed
  1. Q:$D(DIRUT)
  1. I $Y+4>IOSL D F^ACDWUTL