source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3U.m@ 1111

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1YSDX3U ;SLC/DJP/LJA-Utilities for Diagnoses Entered in the MH Medical Record ;12/17/93 14:52
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;D RECORD^YSDX0001("^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
4 ;
5END D END^YSDX3U00 ;->
6 QUIT
7 ;
8LIST ; Called by routines YSDX3, YSDX3A, YSDX3U
9 ; List diagnoses on file for a specific patient
10 ;D RECORD^YSDX0001("LIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
11 K YSDXN,YSDXNN,YSDXST,YSMOD,YSDXDT,YSNO S N1=0
12 I '$O(^YSD(627.8,"AC",YSDFN,0)) D QUIT ;->
13 . W !?10,"No diagnoses on file for ",YSNM S YSNO=1
14 ;
15AXIS1 ; DSM display
16 ;D RECORD^YSDX0001("AXIS1^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
17 I YSAX=1 D
18 . S L2=0
19 . F S L2=$O(^YSD(627.8,"AC",YSDFN,L2)) Q:'L2 D
20 . . S L3=""
21 . . F S L3=$O(^YSD(627.8,"AC",YSDFN,L2,L3)) Q:L3="" I $P(L3,";",2)["YSD" D SELECTL
22AXIS3 ; ICD9 Display
23 ;D RECORD^YSDX0001("AXIS3^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
24 I YSAX=3 D
25 . S L2=0
26 . F S L2=$O(^YSD(627.8,"AC",YSDFN,L2)) Q:'L2 D
27 . . S L3=""
28 . . F S L3=$O(^YSD(627.8,"AC",YSDFN,L2,L3)) Q:L3="" I $P(L3,";",2)["ICD" D SELECTL
29 QUIT
30 ;
31SELECTL ;
32 ;D RECORD^YSDX0001("SELECTL^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
33 S L4=""
34 F S L4=$O(^YSD(627.8,"AC",YSDFN,L2,L3,L4)) Q:L4="" D
35 . S L5=0
36 . F S L5=$O(^YSD(627.8,"AC",YSDFN,L2,L3,L4,L5)) Q:'L5 D STATUS,ALST:YSDTY="A",ILST:YSDTY="I",IRNLST:YSDTY="IRN"
37 QUIT
38STATUS ;
39 ;D RECORD^YSDX0001("STATUS^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
40 S L9=$P(^YSD(627.8,L5,1),U,2)
41 S:L9="i" F1=1
42 S:"rn"[L9!($P(^YSD(627.8,L5,1),U,4)="I") F2=1
43 QUIT
44 ;
45ALST ;
46 ;D RECORD^YSDX0001("ALST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
47 D:L4="A" PLIST
48 QUIT
49 ;
50ILST ;
51 ;D RECORD^YSDX0001("ILST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
52 D:L9="i" PLIST
53 QUIT
54 ;
55IRNLST ;
56 ;D RECORD^YSDX0001("IRNLST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
57 D:L4="I" PLIST
58 QUIT
59 ;
60PLIST ;Sets variables for print of list line
61 ;
62 ; Axis 1
63 ;D RECORD^YSDX0001("PLIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
64 I YSAX=1 D
65 . S P3=$P(L3,";",2)
66 . S P4=$P(L3,";")
67 . S P5="^"_P3_P4_","_0_")"
68 . S P50=@P5
69 . S YSDXN=^YSD(627.7,+P4,"D") ; Diagnosis name
70 . S YSDXNN=$P(P50,U) ; ICD#
71 ;
72 ; Axis 3
73 I YSAX=3 D
74 . S P3=$P(L3,";",2)
75 . S P4=$P(L3,";")
76 . S P5="^"_P3_P4_","_0_")"
77 . S P50=@P5
78 . S YSDXNN=$P(P50,U) ; Diagnosis name
79 . S YSDXN=$P(P50,U,3) ; ICD#
80 ;
81 S YSDXST=$S(L9="v":"VERIFIED",L9="p":"PROVISIONAL",L9="i":"INACTIVE",L9="r":"REFORMULATED",L9="n":"NOT FOUND",L9="ru":"RULE OUT",1:"")
82 S Y=$P(^YSD(627.8,L5,0),U,3) D DD^%DT S YSDXDT=Y
83 ;
84 ; Modifiers?
85 I $D(^YSD(627.8,L5,5)) D
86 . S L7=$P(^YSD(627.8,L5,5,0),U,3)
87 . F I=1:1:L7 S YSMOD(I)=$P(^YSD(627.8,L5,5,I,0),U,3)
88 ;
89 ; DXLS?
90 S L10=$P($G(^YSD(627.8,L5,1)),U,6) I L10]"" D
91 . S YSDXSTAT="INACTIVATED",Y=$P(^YSD(627.8,L5,1),U,5) D DD^%DT S YSTATDT=Y
92 ;
93 S N1=N1+1,N2(N1)=$P(L3,";"),N4=0 K YSSTOP
94 F N3=1:1 S:P4=N2(N3) N4=N4+1 S:N4>1 YSSTOP=1 Q:N3=N1
95 QUIT:$D(YSSTOP) ;->
96 S P1=P1+1 S P2(P1)=L5
97PRINT ;
98 ;D RECORD^YSDX0001("PRINT^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
99 Q:YSDTY="IRN"&(L9="i") ;->
100 W !,P1,?3,YSDXNN,!?3,$E(YSDXN,1,75)
101 I $D(YSMOD) F I=1:1:L7 I $D(YSMOD(I)) W:$TR(YSMOD(I)," ","")]"" !?8," --- "_YSMOD(I)
102 W !?8," --- "_YSDXST,?35,YSDXDT I $D(YSDXSTAT) W !?8," --- "_YSDXSTAT,?35,YSTATDT
103 QUIT
104 ;
105INQ ; Called by routines YSDX3, YSDX3A
106 ;D RECORD^YSDX0001("INQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
107 Q:$D(YSNO) ;->
108 K %
109 S F3=$S(YSAX=1:" Axes 1 & 2 ",YSAX=3:" Axis 3 ",1:"")
110 I $D(F1) W !!,"List INACTIVE diagnoses" S %=2 D YN^DICN K:%=2 F1 S:%=1 YSDTY="I" I %=0 W !!,"YES will list all INACTIVE,",F3,"diagnoses for ",$E(YSNM,1,20),".",! G INQ
111 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) Q:YSTOUT!YSUOUT
112 I $D(%) I %=-1 Q
113 I $D(F2) D RNQ I YSTOUT!YSUOUT Q
114 I $D(F1)!$D(F2) D LIST^YSDX3U I '$D(YSDXN) W !,"No additional",F3,"dx found."
115 QUIT
116 ;
117RNQ ;
118 ;D RECORD^YSDX0001("RNQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
119 S %=0
120 F Q:$G(%) W !!,"List REFORMULATED/NOT FOUND diagnoses" S %=2 D
121 . D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) W !
122 . I '% D
123 . . W !!,"YES will list, in addition to all INACTIVE"
124 . . W F3,"diagnoses,",!?3," all REFORMULATED/NOT FOUND"
125 . . W F3,"diagnoses on file",!?3,"for ",$E(YSNM,1,20),".",!
126 I %=2 K F2 QUIT ;->
127 S:%=1 YSDTY="IRN"
128 I %=-1 S YSQT=1
129 QUIT
130 ;
131EOR ;YSDX3U - Utilities for Diagnoses in MH Med Record ;6/30/89 09:49
Note: See TracBrowser for help on using the repository browser.