source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3RU.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1YSDX3RU ;SLC/DJP/LJA-Print Utilities for Diagnoses Reporting in the MH Medical Record ;12/14/93 12:58
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;D RECORD^YSDX0001("YSDX3RU^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
4 ;
5DX ; Called from routins YSDX3R, YSPP6
6 ; Lists out diagnoses sequentially
7 ;D RECORD^YSDX0001("DX^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
8 S L="" ; DFN
9 F S L=$O(^YSD(627.8,"AG",L)) QUIT:L="" D
10 . S L1="" ; Global Reference to DSM or ICD9
11 . F S L1=$O(^YSD(627.8,"AG",L,YSDFN,L1)) QUIT:L1="" D
12 . . S L2=0 ; IEN
13 . . F S L2=$O(^YSD(627.8,"AG",L,YSDFN,L1,L2)) QUIT:'L2 D COND Q:YSLFT D DXVAR
14 QUIT
15 ;
16CHR ; called from routine YSDX3R, YSPP6
17 ;D RECORD^YSDX0001("CHR^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
18 S L=0
19 F S L=$O(^YSD(627.8,"AF",YSDFN,L)) QUIT:'L D ;Inverse date
20 . S L1=""
21 . F S L1=$O(^YSD(627.8,"AF",YSDFN,+L,L1)) QUIT:L1="" D ;Global ref
22 . . S L2=0
23 . . F S L2=$O(^YSD(627.8,"AF",YSDFN,L,L1,L2)) QUIT:'L2 D COND Q:YSLFT S (YSTOP1,YSTOP2)=1 D DXVAR
24 QUIT
25 ;
26COND ;
27 ;D RECORD^YSDX0001("COND^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
28 S:$D(YSPPF) YSPPF=2 K YSSTOP S YSCD=$P(^YSD(627.8,L2,1),U,4)
29 S YSCOND=$S(YSCD["A":"A C T I V E",YSCD["I":"I N A C T I V E",1:"")
30 I YSTY="ACT" S:YSCD="I" YSSTOP=1
31 QUIT
32 ;
33DXVAR ;
34 ;D RECORD^YSDX0001("DXVAR^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
35 N YSDXI
36 QUIT:$D(YSSTOP) ;->
37 ;
38 ; Points to ^YSD(627.7 ?
39 I L1["YSD" D
40 . S YSD3FLG="DSM DIAGNOSES: "
41 . S L4=$P(L1,";",2) ; Global reference
42 . S L5=+$P(L1,";") ; IEN
43 . S L6="^"_L4_L5_","_0_")" ; Global reference of 0 node
44 . S L60=@L6 ; 0 node's data
45 . S YSDXN=^YSD(627.7,+L5,"D") ; Diagnosis name
46 . S YSDXNN=$P(L60,U) ; ICD9 #
47 ;
48 ; Points to ^ICD9( ?
49 I L1["ICD" D
50 . S YSDIFLG="ICD9 DIAGNOSES: "
51 . S L4=$P(L1,";",2) ; Global reference
52 . S L5=+$P(L1,";") ; IEN
53 . S L6="^"_L4_L5_","_0_")" ; Global reference of 0 node
54 . S L60=@L6 ; 0 node's data
55 . S YSDXN=$P(L60,U,3) ; Diagnosis (free text)
56 . S YSDXNN=$P(L60,U) ; ICD9 #
57 ;
58 ; Modifiers?
59 I $D(^YSD(627.8,+L2,5)) D
60 . S YSML=$P(^YSD(627.8,+L2,5,0),U,3)
61 . F YSDXI=1:1:YSML D
62 . . S M1=$G(^YSD(627.8,+L2,5,+YSDXI,0))
63 . . QUIT:M1']"" ;->
64 . . S YSMOD(+YSDXI)=$P(M1,U,3)
65 . . K M1
66 ;
67 ; Status
68 S L8=$P(^YSD(627.8,+L2,1),U,2)
69 S YSDXS=$S(L8="v":"VERIFIED",L8="p":"PROVISIONAL",L8="i":"INACTIVE",L8="r":"REFORMULATED",L8="n":"NOT FOUND",L8="ru":"RULE OUT",1:"")
70 S Y=$P(^YSD(627.8,+L2,0),U,3) D DD^%DT S YSDXDT=Y
71 ;
72AUTH ;
73 ;D RECORD^YSDX0001("AUTH^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
74 ; Diagnosed by
75 S L9=+$P(^YSD(627.8,L2,0),U,4)
76 I L9>0 D
77 . S L10=$P($G(^VA(200,L9,0)),U) ; New Person's name
78 . S L11=$P($G(^VA(200,L9,0)),U,9) ; Title
79 . S:L11>0 L11=$P(^DIC(3.1,+L11,0),U) ; Title file
80 . S YSAUTH=L10_" "_L11
81PRINTL ;
82 ;D RECORD^YSDX0001("PRINTL^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
83 I $Y+YSSL+4>IOSL D CK Q:YSTOUT!(YSUOUT)!(YSLFT)
84 I $D(YSD3FLG)&'$D(YSTOP1) W !!,YSD3FLG S YSTOP1=1
85 I $D(YSDIFLG)&'$D(YSTOP2) W !!,YSDIFLG S YSTOP2=1
86 W !!,YSDXNN,!?3,$E(YSDXN,1,76),!?3,YSCOND
87 I $D(YSMOD) F I=1:1:YSML I $D(YSMOD(I)) W:$TR(YSMOD(I)," ","")]"" !?8,"--- "_YSMOD(I)
88 W:YSDXS'=" " !?8,"--- "_YSDXS
89 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
90 I $D(M),M<1 D ^DIWW K ^UTILITY($J,"W")
91 W !?8,"Entered by: " W:$D(YSAUTH) YSAUTH W !?8,"Dated: ",?21,YSDXDT
92 QUIT
93 ;
94CK ; Called by routines YSDX3R1, YSDX3RUA
95 ;D RECORD^YSDX0001("CK^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
96 I 'YST D WAIT^YSUTL W:YSTOUT!YSUOUT @IOF Q
97 S:YSSL YSCON=1 D ENFT^YSFORM D:($Y+YSSL+4>IOSL) ENHD^YSFORM Q
98ENPP ;
99 ;D RECORD^YSDX0001("ENPP^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
100 S YSFHDR="DIAGNOSIS LIST",YSPP=1 G PR^YSDX3R
101 ;
102FINISH ; Called by routines YSDX3R, YSDX3RUA
103 ;D RECORD^YSDX0001("FINISH^YSDX3RU") ;Used for testing. Inactivated in YSDX0001...
104 K YSFFS I $D(YSNOFORM) D ^%ZISC,KILL^%ZTLOAD Q
105 W !!?10,"*** LIST COMPLETE ***",! S YSFFS=1
106 I YST=1 D ENFT^YSFORM,^%ZISC,KILL^%ZTLOAD Q
107 D WAIT^YSUTL
108 QUIT
109 ;
110EOR ;YSDX3RU-Print Utilities for Diagnoses in Med Record ;10/19/89 17:10
Note: See TracBrowser for help on using the repository browser.