YSDX3RU ;SLC/DJP/LJA - Print Utilities for Diagnoses Reporting in H Med Rec ;13 May 2013 9:54 AM
;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
;D RECORD^YSDX0001("YSDX3RU^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
;
DX ; Called from routines YSDX3R, YSPP6
; Lists out diagnoses sequentially
;D RECORD^YSDX0001("DX^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
S L="" ; DFN
F S L=$O(^YSD(627.8,"AG",L)) QUIT:L="" D
. S L1="" ; Global Reference to DSM or ICD DIAGNOSIS tables
. F S L1=$O(^YSD(627.8,"AG",L,YSDFN,L1)) QUIT:L1="" D
. . S L2=0 ; IEN
. . F S L2=$O(^YSD(627.8,"AG",L,YSDFN,L1,L2)) QUIT:'L2 D COND Q:YSLFT D DXVAR
QUIT
;
CHR ; called from routine YSDX3R, YSPP6
;D RECORD^YSDX0001("CHR^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
S L=0
F S L=$O(^YSD(627.8,"AF",YSDFN,L)) QUIT:'L D ;Inverse date
. S L1=""
. F S L1=$O(^YSD(627.8,"AF",YSDFN,+L,L1)) QUIT:L1="" D ;Global ref
. . S L2=0
. . F S L2=$O(^YSD(627.8,"AF",YSDFN,L,L1,L2)) QUIT:'L2 D COND Q:YSLFT S (YSTOP1,YSTOP2)=1 D DXVAR
QUIT
;
COND ;
;D RECORD^YSDX0001("COND^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
S:$D(YSPPF) YSPPF=2 K YSSTOP S YSCD=$P(^YSD(627.8,L2,1),U,4)
S YSCOND=$S(YSCD["A":"A C T I V E",YSCD["I":"I N A C T I V E",1:"")
I YSTY="ACT" S:YSCD="I" YSSTOP=1
QUIT
;
DXVAR ;
;D RECORD^YSDX0001("DXVAR^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
N YSDXI
QUIT:$D(YSSTOP) ;->
;
S YSDXCSTX=""
; Points to ^YSD(627.7 ?
I L1["YSD" D
. S YSD3FLG="DSM DIAGNOSES: "
. S L4=$P(L1,";",2) ; Global reference
. S L5=+$P(L1,";") ; IEN
. S L6="^"_L4_L5_","_0_")" ; Global reference of 0 node
. S L60=@L6 ; 0 node's data
. S YSDXN=^YSD(627.7,+L5,"D") ; Diagnosis name
. S YSDXNN=$P(L60,U) ; ICD Code
. S YSDXCSTX="(ICD-"_$S($P(L60,U,8)'="":$P(L60,U,8),1:"9")_")"
;
; Points to ^ICD9( ?
I L1["ICD" D
. S YSDIFLG="ICD DIAGNOSES: "
. S L4=$P(L1,";",2) ; Global reference
. S L5=+$P(L1,";") ; IEN
. S L6="^"_L4_L5_","_0_")" ; Global reference of 0 node
. S L60=@L6 ; 0 node's data
. N YSDXDATA S YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",L5,$P(^YSD(627.8,+L2,0),U,3),"I")
. S YSDXN=$P(YSDXDATA,U,4) ; Diagnosis (free text)
. S YSDXNN=$P(YSDXDATA,U,2) ; ICD Code
. S YSDXCSTX=$P($P($$SINFO^ICDEX($P(YSDXDATA,U,20)),U,2),"-",2)
. S YSDXCSTX="(ICD-"_YSDXCSTX_")"
;
; Modifiers?
I $D(^YSD(627.8,+L2,5)) D
. S YSML=$P(^YSD(627.8,+L2,5,0),U,3)
. F YSDXI=1:1:YSML D
. . S M1=$G(^YSD(627.8,+L2,5,+YSDXI,0))
. . QUIT:M1']"" ;->
. . S YSMOD(+YSDXI)=$P(M1,U,3)
. . K M1
;
; Status
S L8=$P(^YSD(627.8,+L2,1),U,2)
S YSDXS=$S(L8="v":"VERIFIED",L8="p":"PROVISIONAL",L8="i":"INACTIVE",L8="r":"REFORMULATED",L8="n":"NOT FOUND",L8="ru":"RULE OUT",1:"")
S Y=$P(^YSD(627.8,+L2,0),U,3) D DD^%DT S YSDXDT=Y
;
AUTH ;
;D RECORD^YSDX0001("AUTH^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
; Diagnosed by
S L9=+$P(^YSD(627.8,L2,0),U,4)
I L9>0 D
. S L10=$P($G(^VA(200,L9,0)),U) ; New Person's name
. S L11=$P($G(^VA(200,L9,0)),U,9) ; Title
. S:L11>0 L11=$P(^DIC(3.1,+L11,0),U) ; Title file
. S YSAUTH=L10_" "_L11
PRINTL ;
;D RECORD^YSDX0001("PRINTL^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
I $Y+YSSL+4>IOSL D CK Q:YSTOUT!(YSUOUT)!(YSLFT)
I $D(YSD3FLG)&'$D(YSTOP1) W !!,YSD3FLG S YSTOP1=1
I $D(YSDIFLG)&'$D(YSTOP2) W !!,YSDIFLG S YSTOP2=1
W !!,YSDXCSTX," ",YSDXNN,!?3,$E(YSDXN,1,76),!?3,YSCOND
I $D(YSMOD) F I=1:1:YSML I $D(YSMOD(I)) W:$TR(YSMOD(I)," ","")]"" !?8,"--- "_YSMOD(I)
W:YSDXS'=" " !?8,"--- "_YSDXS
I $D(^YSD(627.8,L2,80,0)) W !?8,"Comments: " S DIWL=20,DIWR=75,DIWF="W" K ^UTILITY($J,"W") S M=0 F S M=$O(^YSD(627.8,L2,80,M)) Q:'M S X=^(M,0) D ^DIWP
I $D(M),M<1 D ^DIWW K ^UTILITY($J,"W")
W !?8,"Entered by: " W:$D(YSAUTH) YSAUTH W !?8,"Dated: ",?21,YSDXDT
QUIT
;
CK ; Called by routines YSDX3R1, YSDX3RUA
;D RECORD^YSDX0001("CK^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
I 'YST D WAIT^YSUTL W:YSTOUT!YSUOUT @IOF Q
S:YSSL YSCON=1 D ENFT^YSFORM D:($Y+YSSL+4>IOSL) ENHD^YSFORM Q
ENPP ;
;D RECORD^YSDX0001("ENPP^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
S YSFHDR="DIAGNOSIS LIST",YSPP=1 G PR^YSDX3R
;
FINISH ; Called by routines YSDX3R, YSDX3RUA
;D RECORD^YSDX0001("FINISH^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
K YSDXCSTX,YSFFS I $D(YSNOFORM) D ^%ZISC,KILL^%ZTLOAD Q
W !!?10,"*** LIST COMPLETE ***",! S YSFFS=1
I YST=1 D ENFT^YSFORM,^%ZISC,KILL^%ZTLOAD Q
D WAIT^YSUTL
QUIT
;
EOR ;YSDX3RU-Print Utilities for Diagnoses in Med Record ;10/19/89 17:10
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDX3RU 4843 printed Sep 23, 2025@19:50:23 Page 2
YSDX3RU ;SLC/DJP/LJA - Print Utilities for Diagnoses Reporting in H Med Rec ;13 May 2013 9:54 AM
+1 ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
+2 ;D RECORD^YSDX0001("YSDX3RU^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+3 ;
DX ; Called from routines YSDX3R, YSPP6
+1 ; Lists out diagnoses sequentially
+2 ;D RECORD^YSDX0001("DX^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+3 ; DFN
SET L=""
+4 FOR
SET L=$ORDER(^YSD(627.8,"AG",L))
if L=""
QUIT
Begin DoDot:1
+5 ; Global Reference to DSM or ICD DIAGNOSIS tables
SET L1=""
+6 FOR
SET L1=$ORDER(^YSD(627.8,"AG",L,YSDFN,L1))
if L1=""
QUIT
Begin DoDot:2
+7 ; IEN
SET L2=0
+8 FOR
SET L2=$ORDER(^YSD(627.8,"AG",L,YSDFN,L1,L2))
if 'L2
QUIT
DO COND
if YSLFT
QUIT
DO DXVAR
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
CHR ; called from routine YSDX3R, YSPP6
+1 ;D RECORD^YSDX0001("CHR^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 SET L=0
+3 ;Inverse date
FOR
SET L=$ORDER(^YSD(627.8,"AF",YSDFN,L))
if 'L
QUIT
Begin DoDot:1
+4 SET L1=""
+5 ;Global ref
FOR
SET L1=$ORDER(^YSD(627.8,"AF",YSDFN,+L,L1))
if L1=""
QUIT
Begin DoDot:2
+6 SET L2=0
+7 FOR
SET L2=$ORDER(^YSD(627.8,"AF",YSDFN,L,L1,L2))
if 'L2
QUIT
DO COND
if YSLFT
QUIT
SET (YSTOP1,YSTOP2)=1
DO DXVAR
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
COND ;
+1 ;D RECORD^YSDX0001("COND^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 if $DATA(YSPPF)
SET YSPPF=2
KILL YSSTOP
SET YSCD=$PIECE(^YSD(627.8,L2,1),U,4)
+3 SET YSCOND=$SELECT(YSCD["A":"A C T I V E",YSCD["I":"I N A C T I V E",1:"")
+4 IF YSTY="ACT"
if YSCD="I"
SET YSSTOP=1
+5 QUIT
+6 ;
DXVAR ;
+1 ;D RECORD^YSDX0001("DXVAR^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 NEW YSDXI
+3 ;->
if $DATA(YSSTOP)
QUIT
+4 ;
+5 SET YSDXCSTX=""
+6 ; Points to ^YSD(627.7 ?
+7 IF L1["YSD"
Begin DoDot:1
+8 SET YSD3FLG="DSM DIAGNOSES: "
+9 ; Global reference
SET L4=$PIECE(L1,";",2)
+10 ; IEN
SET L5=+$PIECE(L1,";")
+11 ; Global reference of 0 node
SET L6="^"_L4_L5_","_0_")"
+12 ; 0 node's data
SET L60=@L6
+13 ; Diagnosis name
SET YSDXN=^YSD(627.7,+L5,"D")
+14 ; ICD Code
SET YSDXNN=$PIECE(L60,U)
+15 SET YSDXCSTX="(ICD-"_$SELECT($PIECE(L60,U,8)'="":$PIECE(L60,U,8),1:"9")_")"
End DoDot:1
+16 ;
+17 ; Points to ^ICD9( ?
+18 IF L1["ICD"
Begin DoDot:1
+19 SET YSDIFLG="ICD DIAGNOSES: "
+20 ; Global reference
SET L4=$PIECE(L1,";",2)
+21 ; IEN
SET L5=+$PIECE(L1,";")
+22 ; Global reference of 0 node
SET L6="^"_L4_L5_","_0_")"
+23 ; 0 node's data
SET L60=@L6
+24 NEW YSDXDATA
SET YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",L5,$PIECE(^YSD(627.8,+L2,0),U,3),"I")
+25 ; Diagnosis (free text)
SET YSDXN=$PIECE(YSDXDATA,U,4)
+26 ; ICD Code
SET YSDXNN=$PIECE(YSDXDATA,U,2)
+27 SET YSDXCSTX=$PIECE($PIECE($$SINFO^ICDEX($PIECE(YSDXDATA,U,20)),U,2),"-",2)
+28 SET YSDXCSTX="(ICD-"_YSDXCSTX_")"
End DoDot:1
+29 ;
+30 ; Modifiers?
+31 IF $DATA(^YSD(627.8,+L2,5))
Begin DoDot:1
+32 SET YSML=$PIECE(^YSD(627.8,+L2,5,0),U,3)
+33 FOR YSDXI=1:1:YSML
Begin DoDot:2
+34 SET M1=$GET(^YSD(627.8,+L2,5,+YSDXI,0))
+35 ;->
if M1']""
QUIT
+36 SET YSMOD(+YSDXI)=$PIECE(M1,U,3)
+37 KILL M1
End DoDot:2
End DoDot:1
+38 ;
+39 ; Status
+40 SET L8=$PIECE(^YSD(627.8,+L2,1),U,2)
+41 SET YSDXS=$SELECT(L8="v":"VERIFIED",L8="p":"PROVISIONAL",L8="i":"INACTIVE",L8="r":"REFORMULATED",L8="n":"NOT FOUND",L8="ru":"RULE OUT",1:"")
+42 SET Y=$PIECE(^YSD(627.8,+L2,0),U,3)
DO DD^%DT
SET YSDXDT=Y
+43 ;
AUTH ;
+1 ;D RECORD^YSDX0001("AUTH^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 ; Diagnosed by
+3 SET L9=+$PIECE(^YSD(627.8,L2,0),U,4)
+4 IF L9>0
Begin DoDot:1
+5 ; New Person's name
SET L10=$PIECE($GET(^VA(200,L9,0)),U)
+6 ; Title
SET L11=$PIECE($GET(^VA(200,L9,0)),U,9)
+7 ; Title file
if L11>0
SET L11=$PIECE(^DIC(3.1,+L11,0),U)
+8 SET YSAUTH=L10_" "_L11
End DoDot:1
PRINTL ;
+1 ;D RECORD^YSDX0001("PRINTL^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 IF $Y+YSSL+4>IOSL
DO CK
if YSTOUT!(YSUOUT)!(YSLFT)
QUIT
+3 IF $DATA(YSD3FLG)&'$DATA(YSTOP1)
WRITE !!,YSD3FLG
SET YSTOP1=1
+4 IF $DATA(YSDIFLG)&'$DATA(YSTOP2)
WRITE !!,YSDIFLG
SET YSTOP2=1
+5 WRITE !!,YSDXCSTX," ",YSDXNN,!?3,$EXTRACT(YSDXN,1,76),!?3,YSCOND
+6 IF $DATA(YSMOD)
FOR I=1:1:YSML
IF $DATA(YSMOD(I))
if $TRANSLATE(YSMOD(I)," ","")]""
WRITE !?8,"--- "_YSMOD(I)
+7 if YSDXS'=" "
WRITE !?8,"--- "_YSDXS
+8 IF $DATA(^YSD(627.8,L2,80,0))
WRITE !?8,"Comments: "
SET DIWL=20
SET DIWR=75
SET DIWF="W"
KILL ^UTILITY($JOB,"W")
SET M=0
FOR
SET M=$ORDER(^YSD(627.8,L2,80,M))
if 'M
QUIT
SET X=^(M,0)
DO ^DIWP
+9 IF $DATA(M)
IF M<1
DO ^DIWW
KILL ^UTILITY($JOB,"W")
+10 WRITE !?8,"Entered by: "
if $DATA(YSAUTH)
WRITE YSAUTH
WRITE !?8,"Dated: ",?21,YSDXDT
+11 QUIT
+12 ;
CK ; Called by routines YSDX3R1, YSDX3RUA
+1 ;D RECORD^YSDX0001("CK^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 IF 'YST
DO WAIT^YSUTL
if YSTOUT!YSUOUT
WRITE @IOF
QUIT
+3 if YSSL
SET YSCON=1
DO ENFT^YSFORM
if ($Y+YSSL+4>IOSL)
DO ENHD^YSFORM
QUIT
ENPP ;
+1 ;D RECORD^YSDX0001("ENPP^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 SET YSFHDR="DIAGNOSIS LIST"
SET YSPP=1
GOTO PR^YSDX3R
+3 ;
FINISH ; Called by routines YSDX3R, YSDX3RUA
+1 ;D RECORD^YSDX0001("FINISH^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
+2 KILL YSDXCSTX,YSFFS
IF $DATA(YSNOFORM)
DO ^%ZISC
DO KILL^%ZTLOAD
QUIT
+3 WRITE !!?10,"*** LIST COMPLETE ***",!
SET YSFFS=1
+4 IF YST=1
DO ENFT^YSFORM
DO ^%ZISC
DO KILL^%ZTLOAD
QUIT
+5 DO WAIT^YSUTL
+6 QUIT
+7 ;
EOR ;YSDX3RU-Print Utilities for Diagnoses in Med Record ;10/19/89 17:10
