YSDXR ;SLC/DKG/RWF/ASF/LJA,HIOFO/FT - (DSM-III) DIAGNOSIS REPORT ;9/20/11 16:37
;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
;
;D RECORD^YSDX0001("^YSDXR") ;Used for testing. Inactivated in YSDX0001...
; Called by routine YSDX3
1 ;
;D RECORD^YSDX0001("1^YSDXR") ;Used for testing. Inactivated in YSDX0001...
R !,"SORT BY (D)IAGNOSIS or (C)HRONOLOGICALLY? D// ",A:DTIME
S YSTOUT='$T,YSUOUT=A["^"
QUIT:YSTOUT!YSUOUT ;->
S A=$TR($E(A_"D"),"cd","CD")
I "DC"'[A W:A'["?" " ?",$C(7) G 1 ;->
2 ;
;D RECORD^YSDX0001("2^YSDXR") ;Used for testing. Inactivated in YSDX0001...
R !,"LIST ONLY ACTIVE DIAGNOSIS? N// ",A1:DTIME
S YSTOUT='$T,YSUOUT=A1["^"
QUIT:YSTOUT!YSUOUT ;->
S A1=$TR($E(A1_"N"),"yn","YN")
I "NY"'[A1 W:A1'["?" " ?",$C(7) G 2 ;->
K IOP S ZTSK="",%ZIS="Q" D ^%ZIS QUIT:POP ;->
I $D(IO("Q")) D QUIT
. S ZTRTN="ENPR^YSDXR"
. S (ZTSAVE("A"),ZTSAVE("A1"),ZTSAVE("YS*"))=""
. S ZTDESC="YS DSM3 PRINT"
. D ^%ZTLOAD
;
ENPR ;
;D RECORD^YSDX0001("ENPR^YSDXR") ;Used for testing. Inactivated in YSDX0001...
S YSFHDR="Diagnosis List"
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"""
S YSPP=0
PR ;
;D RECORD^YSDX0001("PR^YSDXR") ;Used for testing. Inactivated in YSDX0001...
U IO
D:'$D(YSNOFORM) ENHD^YSFORM
S Y1=0,T=0,YST=$S(IOST?1"P".E:1,1:0),YSSL=$S(YST:8,1:3),YSLFT=0
W !
;
; Principal DSM-III Diagnosis
;I $D(^MR(YSDFN,"DX1")),+^("DX1")?7N.E,$P(^("DX1"),U,2)?1N.E D
;. S X(1)=^MR(YSDFN,"DX1")
;. W !,"DXLS (DSM-III): ",$P(^YSD(627.7,+$P(X(1),U,2),0),U,2)
;. W " ON" S X=+X(1) D DAT
;
; Principal ICD9 Diagnosis
;I $D(^MR(YSDFN,"DX2")),+^("DX2")?7N.E,$P(^("DX2"),U,2)?1N.E D
;. S X(1)=^MR(YSDFN,"DX2")
;. W !,"DXLS (ICD9): ",$P(^ICD9($P(X(1),U,2),0),U)
;. W " ON" S X=+X(1) D DAT
;
; X DSM-III Diagnosis
;I $D(^MR(YSDFN,"DX1")),$P(^("DX1"),U,3)?7N.E,$P(^("DX1"),U,4)?1N.E D
;. S X(1)=^MR(YSDFN,"DX1")
;. W !,"'X' DIAGNOSIS (DSM-III): ",$P(^YSD(627.7,$P(X(1),U,4),0),U,2)
;. W " ON" S X=$P(^MR(YSDFN,"DX1"),U,3) D DAT
;
; X ICD9 Diagnosis
;I $D(^MR(YSDFN,"DX2")),$P(^("DX2"),U,3)?7N.E,$P(^("DX2"),U,4)?1N.E D
;. S X(1)=^MR(YSDFN,"DX2")
;. W !,"'X' DIAGNOSIS (ICD9): ",$P(^ICD9($P(X(1),U,4),0),U)
;. W " ON" S X=$P(^MR(YSDFN,"DX2"),U,3) D DAT
;
; DSM-III Diagnosis
;I $D(^MR(YSDFN,"DX",1)) W !!,"DSM-III DIAGNOSES:"
;I $D(A) G:A?1"C".E ^YSDXR1 ;->
;PRT ;
;D RECORD^YSDX0001("PRT^YSDXR") ;Used for testing. Inactivated in YSDX0001...
;S T=$O(^MR(YSDFN,"DX","B",T))
;G PRE:'T ;->
;S Y1=$O(^MR(+YSDFN,"DX","B",T,0))
;G PRE:'Y1 ;->
;S D2=^MR(YSDFN,"DX",+Y1,0),T1=0
;G PRT:(D2<1) ;->
;S Y2=^YSD(627.7,+D2,0)
;I $D(A1),A1?1"Y".E G PRT:$P(D2,U,2)="I" ;->
;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT ;->
;W !!,$P(Y2,U,2),?8
;S Y2=$P(Y2,U)
;F I=3:1:8 I $L($P(Y2," ",I))>70 QUIT
;W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
;S C=$P(^MR(YSDFN,"DX",Y1,0),U,2)
;S C=$S(C="A":"A C T I V E",C="I":"** INACTIVE",1:"")
;W " ",C
;PT1 ;
;D RECORD^YSDX0001("PT1^YSDXR") ;Used for testing. Inactivated in YSDX0001...
;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT ;->
;S T1=$O(^MR(YSDFN,"DX",Y1,1,T1))
;G PRT:'T1 ;->
;S S2=^MR(YSDFN,"DX",Y1,1,T1,0)
;W !?8 S X=+S2,Z=$P(S2,U,2) D DAT,ENS
;S X=$P(S2,U,3)
;I X>0,$D(^VA(200,X,0)) D
;. W " ",$P(^VA(200,X,0),U)
;. S X=$P(^VA(200,X,0),U,9)
;. I X>0,$D(^DIC(3.1,X,0)) W ", ",^(0)
;S X=$P(S2,U,4)
;I $L(X) F I=4:1:10 IF $L($P(X," ",I))>50 QUIT
;I $L(X) D
;. W !?20,"COMMENT: ",$P(X," ",1,I)
;. W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
;G PT1
PRE ;
;D RECORD^YSDX0001("PRE^YSDXR") ;Used for testing. Inactivated in YSDX0001...
;D MULT
;I '$D(^MR(YSDFN,"PHDX",1)) G END ;->
;S T=0
;G ^YSPDXR ;->
;
DAT ;D DAT^YSDXR000 ;->
QUIT
;
ENS ;D ENS^YSDXR000 ;->
QUIT
;
MULT ;D MULT^YSDXR000 ;->
QUIT
;
CK ;D CK^YSDXR000 ;->
QUIT
;
;ENPP ;
;D RECORD^YSDX0001("ENPP^YSDXR") ;Used for testing. Inactivated in YSDX0001...
;S YSFHDR="DSM/ICDA9 Diagnosis List",YSPP=1
;G PR ;->
;
;END ;
;D RECORD^YSDX0001("END^YSDXR") ;Used for testing. Inactivated in YSDX0001...
;QUIT:$D(YSNOFORM) ;->
;D ENFT^YSFORM:YST
;D:'YSPP WAIT^YSUTL:'YST
;QUIT:YSPP ;->
;D ^%ZISC
;S:$G(ZTSK) ZTREQ="@"
;K:$G(ZTSK) YSCON
;QUIT
;
;EOR ;YSDXR - (DSM-III) DIAGNOSIS REPORT ;12/6/90 11:24
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDXR 4504 printed Apr 09, 2024@21:23:24 Page 2
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
+2 ;
+3 ;D RECORD^YSDX0001("^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+4 ; Called by routine YSDX3
1 ;
+1 ;D RECORD^YSDX0001("1^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+2 READ !,"SORT BY (D)IAGNOSIS or (C)HRONOLOGICALLY? D// ",A:DTIME
+3 SET YSTOUT='$TEST
SET YSUOUT=A["^"
+4 ;->
if YSTOUT!YSUOUT
QUIT
+5 SET A=$TRANSLATE($EXTRACT(A_"D"),"cd","CD")
+6 ;->
IF "DC"'[A
if A'["?"
WRITE " ?",$CHAR(7)
GOTO 1
2 ;
+1 ;D RECORD^YSDX0001("2^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+2 READ !,"LIST ONLY ACTIVE DIAGNOSIS? N// ",A1:DTIME
+3 SET YSTOUT='$TEST
SET YSUOUT=A1["^"
+4 ;->
if YSTOUT!YSUOUT
QUIT
+5 SET A1=$TRANSLATE($EXTRACT(A1_"N"),"yn","YN")
+6 ;->
IF "NY"'[A1
if A1'["?"
WRITE " ?",$CHAR(7)
GOTO 2
+7 ;->
KILL IOP
SET ZTSK=""
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTRTN="ENPR^YSDXR"
+10 SET (ZTSAVE("A"),ZTSAVE("A1"),ZTSAVE("YS*"))=""
+11 SET ZTDESC="YS DSM3 PRINT"
+12 DO ^%ZTLOAD
End DoDot:1
QUIT
+13 ;
ENPR ;
+1 ;D RECORD^YSDX0001("ENPR^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+2 SET YSFHDR="Diagnosis List"
+3 SET YSFHDR(1)="W !,""DSM/ICD"",?8,""TITLE"" X YSFHDR(2),YSFHDR(3)"
SET YSFHDR(2)="I $D(A1),A1?1""Y"".E W ?30,""**** ONLY ACTIVE DIAGNOSIS ****"""
SET YSFHDR(3)="W !,""CODE"",?10,""DATE"""
+4 SET YSPP=0
PR ;
+1 ;D RECORD^YSDX0001("PR^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+2 USE IO
+3 if '$DATA(YSNOFORM)
DO ENHD^YSFORM
+4 SET Y1=0
SET T=0
SET YST=$SELECT(IOST?1"P".E:1,1:0)
SET YSSL=$SELECT(YST:8,1:3)
SET YSLFT=0
+5 WRITE !
+6 ;
+7 ; Principal DSM-III Diagnosis
+8 ;I $D(^MR(YSDFN,"DX1")),+^("DX1")?7N.E,$P(^("DX1"),U,2)?1N.E D
+9 ;. S X(1)=^MR(YSDFN,"DX1")
+10 ;. W !,"DXLS (DSM-III): ",$P(^YSD(627.7,+$P(X(1),U,2),0),U,2)
+11 ;. W " ON" S X=+X(1) D DAT
+12 ;
+13 ; Principal ICD9 Diagnosis
+14 ;I $D(^MR(YSDFN,"DX2")),+^("DX2")?7N.E,$P(^("DX2"),U,2)?1N.E D
+15 ;. S X(1)=^MR(YSDFN,"DX2")
+16 ;. W !,"DXLS (ICD9): ",$P(^ICD9($P(X(1),U,2),0),U)
+17 ;. W " ON" S X=+X(1) D DAT
+18 ;
+19 ; X DSM-III Diagnosis
+20 ;I $D(^MR(YSDFN,"DX1")),$P(^("DX1"),U,3)?7N.E,$P(^("DX1"),U,4)?1N.E D
+21 ;. S X(1)=^MR(YSDFN,"DX1")
+22 ;. W !,"'X' DIAGNOSIS (DSM-III): ",$P(^YSD(627.7,$P(X(1),U,4),0),U,2)
+23 ;. W " ON" S X=$P(^MR(YSDFN,"DX1"),U,3) D DAT
+24 ;
+25 ; X ICD9 Diagnosis
+26 ;I $D(^MR(YSDFN,"DX2")),$P(^("DX2"),U,3)?7N.E,$P(^("DX2"),U,4)?1N.E D
+27 ;. S X(1)=^MR(YSDFN,"DX2")
+28 ;. W !,"'X' DIAGNOSIS (ICD9): ",$P(^ICD9($P(X(1),U,4),0),U)
+29 ;. W " ON" S X=$P(^MR(YSDFN,"DX2"),U,3) D DAT
+30 ;
+31 ; DSM-III Diagnosis
+32 ;I $D(^MR(YSDFN,"DX",1)) W !!,"DSM-III DIAGNOSES:"
+33 ;I $D(A) G:A?1"C".E ^YSDXR1 ;->
+34 ;PRT ;
+35 ;D RECORD^YSDX0001("PRT^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+36 ;S T=$O(^MR(YSDFN,"DX","B",T))
+37 ;G PRE:'T ;->
+38 ;S Y1=$O(^MR(+YSDFN,"DX","B",T,0))
+39 ;G PRE:'Y1 ;->
+40 ;S D2=^MR(YSDFN,"DX",+Y1,0),T1=0
+41 ;G PRT:(D2<1) ;->
+42 ;S Y2=^YSD(627.7,+D2,0)
+43 ;I $D(A1),A1?1"Y".E G PRT:$P(D2,U,2)="I" ;->
+44 ;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT ;->
+45 ;W !!,$P(Y2,U,2),?8
+46 ;S Y2=$P(Y2,U)
+47 ;F I=3:1:8 I $L($P(Y2," ",I))>70 QUIT
+48 ;W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
+49 ;S C=$P(^MR(YSDFN,"DX",Y1,0),U,2)
+50 ;S C=$S(C="A":"A C T I V E",C="I":"** INACTIVE",1:"")
+51 ;W " ",C
+52 ;PT1 ;
+53 ;D RECORD^YSDX0001("PT1^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+54 ;I $Y+YSSL+2>IOSL D CK QUIT:YSLFT ;->
+55 ;S T1=$O(^MR(YSDFN,"DX",Y1,1,T1))
+56 ;G PRT:'T1 ;->
+57 ;S S2=^MR(YSDFN,"DX",Y1,1,T1,0)
+58 ;W !?8 S X=+S2,Z=$P(S2,U,2) D DAT,ENS
+59 ;S X=$P(S2,U,3)
+60 ;I X>0,$D(^VA(200,X,0)) D
+61 ;. W " ",$P(^VA(200,X,0),U)
+62 ;. S X=$P(^VA(200,X,0),U,9)
+63 ;. I X>0,$D(^DIC(3.1,X,0)) W ", ",^(0)
+64 ;S X=$P(S2,U,4)
+65 ;I $L(X) F I=4:1:10 IF $L($P(X," ",I))>50 QUIT
+66 ;I $L(X) D
+67 ;. W !?20,"COMMENT: ",$P(X," ",1,I)
+68 ;. W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
+69 ;G PT1
PRE ;
+1 ;D RECORD^YSDX0001("PRE^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+2 ;D MULT
+3 ;I '$D(^MR(YSDFN,"PHDX",1)) G END ;->
+4 ;S T=0
+5 ;G ^YSPDXR ;->
+6 ;
DAT ;D DAT^YSDXR000 ;->
+1 QUIT
+2 ;
ENS ;D ENS^YSDXR000 ;->
+1 QUIT
+2 ;
MULT ;D MULT^YSDXR000 ;->
+1 QUIT
+2 ;
CK ;D CK^YSDXR000 ;->
+1 QUIT
+2 ;
+3 ;ENPP ;
+4 ;D RECORD^YSDX0001("ENPP^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+5 ;S YSFHDR="DSM/ICDA9 Diagnosis List",YSPP=1
+6 ;G PR ;->
+7 ;
+8 ;END ;
+9 ;D RECORD^YSDX0001("END^YSDXR") ;Used for testing. Inactivated in YSDX0001...
+10 ;QUIT:$D(YSNOFORM) ;->
+11 ;D ENFT^YSFORM:YST
+12 ;D:'YSPP WAIT^YSUTL:'YST
+13 ;QUIT:YSPP ;->
+14 ;D ^%ZISC
+15 ;S:$G(ZTSK) ZTREQ="@"
+16 ;K:$G(ZTSK) YSCON
+17 ;QUIT
+18 ;
+19 ;EOR ;YSDXR - (DSM-III) DIAGNOSIS REPORT ;12/6/90 11:24
