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

YSDXR.m

Go to the documentation of this file. 
  1. YSDXR ;SLC/DKG/RWF/ASF/LJA,HIOFO/FT - (DSM-III) DIAGNOSIS REPORT ;9/20/11 16:37
  1.  ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
  1.  ;
  1.  ;D RECORD^YSDX0001("^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  ;  Called by routine YSDX3
  1. 1 ;
  1.  ;D RECORD^YSDX0001("1^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  R !,"SORT BY (D)IAGNOSIS or (C)HRONOLOGICALLY?  D// ",A:DTIME
  1.  S YSTOUT='$T,YSUOUT=A["^"
  1.  QUIT:YSTOUT!YSUOUT  ;->
  1.  S A=$TR($E(A_"D"),"cd","CD")
  1.  I "DC"'[A W:A'["?" " ?",$C(7) G 1 ;->
  1. 2 ;
  1.  ;D RECORD^YSDX0001("2^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  R !,"LIST ONLY ACTIVE DIAGNOSIS?  N// ",A1:DTIME
  1.  S YSTOUT='$T,YSUOUT=A1["^"
  1.  QUIT:YSTOUT!YSUOUT  ;->
  1.  S A1=$TR($E(A1_"N"),"yn","YN")
  1.  I "NY"'[A1 W:A1'["?" " ?",$C(7) G 2 ;->
  1.  K IOP S ZTSK="",%ZIS="Q" D ^%ZIS QUIT:POP  ;->
  1.  I $D(IO("Q")) D  QUIT
  1.  .  S ZTRTN="ENPR^YSDXR"
  1.  .  S (ZTSAVE("A"),ZTSAVE("A1"),ZTSAVE("YS*"))=""
  1.  .  S ZTDESC="YS DSM3 PRINT"
  1.  .  D ^%ZTLOAD
  1.  ;
  1. ENPR ;
  1.  ;D RECORD^YSDX0001("ENPR^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  S YSFHDR="Diagnosis List"
  1.  S YSFHDR(1)="W !,""DSM/ICD"",?8,""TITLE"" X YSFHDR(2),YSFHDR(3)",YSFHDR(2)="I $D(A1),A1?1""Y"".E W ?30,""**** ONLY ACTIVE DIAGNOSIS ****""",YSFHDR(3)="W !,""CODE"",?10,""DATE"""
  1.  S YSPP=0
  1. PR ;
  1.  ;D RECORD^YSDX0001("PR^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  U IO
  1.  D:'$D(YSNOFORM) ENHD^YSFORM
  1.  S Y1=0,T=0,YST=$S(IOST?1"P".E:1,1:0),YSSL=$S(YST:8,1:3),YSLFT=0
  1.  W !
  1.  ;
  1.  ;  Principal DSM-III Diagnosis
  1.  ;I $D(^MR(YSDFN,"DX1")),+^("DX1")?7N.E,$P(^("DX1"),U,2)?1N.E D
  1.  ;.  S X(1)=^MR(YSDFN,"DX1")
  1.  ;.  W !,"DXLS (DSM-III): ",$P(^YSD(627.7,+$P(X(1),U,2),0),U,2)
  1.  ;.  W " ON" S X=+X(1) D DAT
  1.  ;
  1.  ;  Principal ICD9 Diagnosis
  1.  ;I $D(^MR(YSDFN,"DX2")),+^("DX2")?7N.E,$P(^("DX2"),U,2)?1N.E D
  1.  ;.  S X(1)=^MR(YSDFN,"DX2")
  1.  ;.  W !,"DXLS (ICD9): ",$P(^ICD9($P(X(1),U,2),0),U)
  1.  ;.  W " ON" S X=+X(1) D DAT
  1.  ;
  1.  ;  X DSM-III Diagnosis
  1.  ;I $D(^MR(YSDFN,"DX1")),$P(^("DX1"),U,3)?7N.E,$P(^("DX1"),U,4)?1N.E D
  1.  ;.  S X(1)=^MR(YSDFN,"DX1")
  1.  ;.  W !,"'X' DIAGNOSIS (DSM-III): ",$P(^YSD(627.7,$P(X(1),U,4),0),U,2)
  1.  ;.  W " ON" S X=$P(^MR(YSDFN,"DX1"),U,3) D DAT
  1.  ;
  1.  ;  X ICD9 Diagnosis
  1.  ;I $D(^MR(YSDFN,"DX2")),$P(^("DX2"),U,3)?7N.E,$P(^("DX2"),U,4)?1N.E D
  1.  ;.  S X(1)=^MR(YSDFN,"DX2")
  1.  ;.  W !,"'X' DIAGNOSIS (ICD9): ",$P(^ICD9($P(X(1),U,4),0),U)
  1.  ;.  W " ON" S X=$P(^MR(YSDFN,"DX2"),U,3) D DAT
  1.  ;
  1.  ;  DSM-III Diagnosis
  1.  ;I $D(^MR(YSDFN,"DX",1)) W !!,"DSM-III DIAGNOSES:"
  1.  ;I $D(A) G:A?1"C".E ^YSDXR1 ;->
  1.  ;PRT ;
  1.  ;D RECORD^YSDX0001("PRT^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  ;S T=$O(^MR(YSDFN,"DX","B",T))
  1.  ;G PRE:'T ;->
  1.  ;S Y1=$O(^MR(+YSDFN,"DX","B",T,0))
  1.  ;G PRE:'Y1 ;->
  1.  ;S D2=^MR(YSDFN,"DX",+Y1,0),T1=0
  1.  ;G PRT:(D2<1) ;->
  1.  ;S Y2=^YSD(627.7,+D2,0)
  1.  ;I $D(A1),A1?1"Y".E G PRT:$P(D2,U,2)="I" ;->
  1.  ;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT  ;->
  1.  ;W !!,$P(Y2,U,2),?8
  1.  ;S Y2=$P(Y2,U)
  1.  ;F I=3:1:8 I $L($P(Y2," ",I))>70 QUIT
  1.  ;W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
  1.  ;S C=$P(^MR(YSDFN,"DX",Y1,0),U,2)
  1.  ;S C=$S(C="A":"A C T I V E",C="I":"** INACTIVE",1:"")
  1.  ;W "  ",C
  1.  ;PT1 ;
  1.  ;D RECORD^YSDX0001("PT1^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  ;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT  ;->
  1.  ;S T1=$O(^MR(YSDFN,"DX",Y1,1,T1))
  1.  ;G PRT:'T1 ;->
  1.  ;S S2=^MR(YSDFN,"DX",Y1,1,T1,0)
  1.  ;W !?8 S X=+S2,Z=$P(S2,U,2) D DAT,ENS
  1.  ;S X=$P(S2,U,3)
  1.  ;I X>0,$D(^VA(200,X,0)) D
  1.  ;.  W "  ",$P(^VA(200,X,0),U)
  1.  ;.  S X=$P(^VA(200,X,0),U,9)
  1.  ;. I X>0,$D(^DIC(3.1,X,0)) W ", ",^(0)
  1.  ;S X=$P(S2,U,4)
  1.  ;I $L(X) F I=4:1:10 IF $L($P(X," ",I))>50 QUIT
  1.  ;I $L(X) D
  1.  ;.  W !?20,"COMMENT: ",$P(X," ",1,I)
  1.  ;.  W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
  1.  ;G PT1
  1. PRE ;
  1.  ;D RECORD^YSDX0001("PRE^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  ;D MULT
  1.  ;I '$D(^MR(YSDFN,"PHDX",1)) G END ;->
  1.  ;S T=0
  1.  ;G ^YSPDXR ;->
  1.  ;
  1. DAT ;D DAT^YSDXR000 ;->
  1.  QUIT
  1.  ;
  1. ENS ;D ENS^YSDXR000 ;->
  1.  QUIT
  1.  ;
  1. MULT ;D MULT^YSDXR000 ;->
  1.  QUIT
  1.  ;
  1. CK ;D CK^YSDXR000 ;->
  1.  QUIT
  1.  ;
  1.  ;ENPP ;
  1.  ;D RECORD^YSDX0001("ENPP^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  ;S YSFHDR="DSM/ICDA9 Diagnosis List",YSPP=1
  1.  ;G PR ;->
  1.  ;
  1.  ;END ;
  1.  ;D RECORD^YSDX0001("END^YSDXR") ;Used for testing.  Inactivated in YSDX0001...
  1.  ;QUIT:$D(YSNOFORM)  ;->
  1.  ;D ENFT^YSFORM:YST
  1.  ;D:'YSPP WAIT^YSUTL:'YST
  1.  ;QUIT:YSPP  ;->
  1.  ;D ^%ZISC
  1.  ;S:$G(ZTSK) ZTREQ="@"
  1.  ;K:$G(ZTSK) YSCON
  1.  ;QUIT
  1.  ;
  1.  ;EOR ;YSDXR - (DSM-III) DIAGNOSIS REPORT ;12/6/90  11:24