source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASLIB.m@ 1397

YSASLIB ;692/DCL-ASI LIBRARY FUNCTIONS ;1/13/97  09:51
 ;;5.01;MENTAL HEALTH;**24,37**;Dec 30, 1994
 Q
 ;
ID(YSAS) ;Identifiers for file 604, pass Y (IEN)
 Q:$G(YSAS)'>0 ""
 N YSASN,YSASD,YSAST,YSAS0,DIERR
 S YSAS0=^YSTX(604,YSAS,0),YSASN=$P(YSAS0,"^",2)
 S:YSASN>0 YSASN=$P(^DPT(YSASN,0),"^")
 S YSASD=$$FMTE^XLFDT($P(YSAS0,U,5),"5ZD")
 S YSAST=$$GET1^DIQ(604,YSAS_",",.04)
 Q $J("",(10-$L(YSAS)))_YSASN_$J("",(30-$L(YSASN)))_$J(YSASD,10)_" "_YSAST
 ;
FUID(YSAS) ;Identifiers for file 604, pass Y (IEN) used when listing FOLLOW-UP ASI.
 Q:$G(YSAS)'>0 ""
 N YSASN,YSASD,YSASF,YSASFN,YSAS0,DIERR,YSASP
 S YSAS0=^YSTX(604,YSAS,0),YSASN=$P(YSAS0,"^",2)
 S:YSASN>0 YSASN=$P(^DPT(YSASN,0),"^")
 S YSASD=$P($P($G(^YSTX(604,YSAS,11)),"^",10),"@")
 S YSASF=$P($G(^YSTX(604,YSAS,12)),"^",3),YSASP=$P(^(12),"^",2)
 S YSASFN=$S(YSASF>0:$P($G(^YSTX(604.5,YSASF,0)),"^"),1:"")
 Q $J("",(10-$L(YSAS)))_YSASN_$J("",(30-$L(YSASN)))_$J(YSASD,8)_$J(YSASP,9)_"  "_YSASFN
 ;
PID(YSAS) ;Identifiers for Patient file, #2 - pass Y (IEN)
 Q:$G(YSAS)'>0
 N YSASDOB,YSASSSN,YSAS0
 S YSAS0=^DPT(YSAS,0),YSASDOB=$$DT($P(YSAS0,"^",3))
 S YSASSSN=$$SSN($P(YSAS0,"^",9)),YSASN=$P(YSAS0,"^")
 Q $J("",(30-$L(YSASN)))_" "_$J(YSASDOB,8)_"   "_$J(YSASSSN,12)
 ;
DT(X) ;Convert date to external format
 Q:$G(X)="" ""
 Q $$FMTE^XLFDT(X,"5ZD")
 ;
SSN(X) ;Convert ssn to external format
 Q:$G(X)="" ""
 Q $E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
 ;
NEW() ;Adding New Entries - return an internal number - EXTRINSIC FUNCTION
 N AUI2X
 F AUI2X=$P(^YSTX(604,0),U,3):1 I '$D(^YSTX(604,AUI2X)) L ^YSTX(604,AUI2X):0 Q:$T
 Q AUI2X
 ;
NEW047(D0) ;Adding new sub-entry and return an internal number - EXTRINSIC
 Q:'$G(D0) ""
 Q:'$P(^YSTX(604,D0,.047,0),"^",3) 1
 N YSASX
 F YSASX=$P(^YSTX(604,D0,.047,0),"^",3):1 I '$D(^YSTX(604,D0,.047,YSASX)) L ^YSTX(604,D0,.047,YSASX):0 Q:$T
 Q YSASX
 ;
VL() ;
 I '$D(IOVL) D GSET^%ZISS
 Q IOG1_IOVL_IOG0
 ;
X(X,F,T) ;Check is X is integer or NN or XX and return truth value TO KILL X (INPUT TRANSFORM)
 ;Pass From To value for integers ie 0,9, 1,99 or 1,9999.
 I X?1N.N,$G(F)]"",$G(T)]"",X'<F,X'>T Q 0
 I X="NN" Q 0
 I X="XX" Q 0
 I X="X" Q 0
 Q 1
 ;
USI(YSADUZ) ;Unsigned Intakes, pass user's duz and return total number of unsigned intakes
 Q:$G(YSADUZ)'>0 ""
 N C,D,X
 S (C,X)=0,D="A.81."_YSADUZ
 F  S X=$O(^YSTX(604,D,X)) Q:X'>0  I $P(^YSTX(604,X,0),"^",4)=1 S C=C+1
 Q C
 ;
USF(YSADUZ) ;Unsigned Follow-ups, pass user's duz and return total number on unsigned follow-ups
 Q:$G(YSADUZ)'>0 ""
 N C,D,X
 S (C,X)=0,D="A.81."_YSADUZ
 F  S X=$O(^YSTX(604,D,X)) Q:X'>0  I $P(^YSTX(604,X,0),"^",4)=2 S C=C+1
 Q C
 ;
US(YSADUZ) ;Unsigned ASIs return in 2 piece string #INTAKEs^#FOLLOW-UPs
 Q:$G(YSADUZ)'>0 ""
 N C,C1,C2,C3,D,X
 S (C1,C2,C3,X)=0,D="A.81."_YSADUZ
 F  S X=$O(^YSTX(604,D,X)) Q:X'>0  D
 .S C=$P(^YSTX(604,X,0),"^",4)
 .Q:C'>0
 .I C=1 S C1=C1+1 Q
 .I C=2 S C2=C2+1 Q
 .I C=3 S C3=C3+1 Q
 .Q
 Q C1_"^"_C2_"^"_C3
 ;
DISP(YSADUZ,YSASCLS) ;Display ASI requiring signature - pass DUZ and CLASS (ASI TYPE)
 Q:$G(YSADUZ)'>0
 Q:$G(YSASCLS)'>0
 N C,C1,C2,D,X,X0,X11
 S (C1,C2,X)=0,D="A.81."_YSADUZ
 W !
 F  S X=$O(^YSTX(604,D,X)) Q:X'>0  D
 .S X0=^YSTX(604,X,0),X11=$G(^(11)),C=$P(X0,"^",4)
 .Q:C'>0
 .Q:C'=YSASCLS
 .W !?4,X,?14,$P(^DPT($P(X0,"^",2),0),"^"),?46,$P(X11,"^",10)
 .Q
 W !
 Q
 ;
 ;
INTRO ;
 W:$D(IOF) @IOF
 W !?20,"ADDICTION SEVERITY INDEX",!?25,"FIFTH EDITION",!!
 D STATUS()
 Q
STATUS(YSAU) ;Return status of unsigned ASIs on a user.
 S:$G(YSAU)'>0 YSAU=DUZ
 N YSAS,X
 S YSAS=$$US(YSAU)
 F I=1:1:3 S X=$P(YSAS,U,I) D:X
 .W !,"You have ",$J(X,3)," unsigned ASI ",$S(I=2:"Lite",I=3:"Followup",1:"Full Intake"),$S(X>1:"s",1:""),"."
 .Q
 Q
RACE(X) ;Pass file 2 race code and return ASI race code, if possible.
 Q:$G(X)'>0 ""
 I X=1 Q 2
 I X=3 Q 1
 I X=5 Q 5
 Q ""
REL(X) ;Pass file 2 religion code and return ASI religion code, if possible.
 Q:$G(X)'>0 ""
 I X=1 Q 3
 I X=20 Q 4
 I X=22 Q 5
 I X=99 Q 2
 Q ""
 ;