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

YSASLIB.m

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