source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX0001.m@ 1742

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1YSDX0001 ;DALISC/LJA - Diagnosis Miscellaneous Code ;12/17/93 11:03
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ; Various non-YSDX*-namespaced routines contained code directly
4 ; accessing ^MR or ^YSD(627.8 DSM data. As much as possible,
5 ; direct access of DSM data should be done in YSDX*-namespaced
6 ; routine. So, in these instances, code was lifted from
7 ; the non-YSDX* routine locations, moved here, and called from their
8 ; original locations...
9 ;
10DX1 ; Called by DX1^YSPROB5 (Profile of Patient, #10 - Short Problem List)
11 ;D RECORD^YSDX0001("DX1^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
12 D:$Y+YSSL+1>IOSL CK
13 G:YSLFT FIN ;->
14 I '$D(^YSD(627.8,"AE","D",YSDFN)) W !!,"NO DSM DIAGNOSES ON FILE" G PHDX
15 W !!,"DSM DIAGNOSES:" S L="D",L2="",L1=0
16 F S L1=$O(^YSD(627.8,"AE",L,YSDFN,L1)) Q:'L1 D
17 . F S L2=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2)) Q:L2="" D
18 . . S L3=0
19 . . F S L3=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2,L3)) Q:'L3 D VAR
20PHDX ;
21 ;D RECORD^YSDX0001("PHDX^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
22 D:$Y+YSSL+1>IOSL CK
23 G:YSLFT FIN ;->
24 I '$D(^YSD(627.8,"AE","I",YSDFN)) W !!,"NO ICD9 DIAGNOSES ON FILE" G FIN
25 W !!,"ICD9 DIAGNOSES:" S L="I",L2="",L1=0
26 F S L1=$O(^YSD(627.8,"AE",L,YSDFN,L1)) Q:'L1 D
27 . F S L2=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2)) Q:L2="" D
28 . . S L3=0
29 . . F S L3=$O(^YSD(627.8,"AE",L,YSDFN,L1,L2,L3)) Q:'L3 D VAR
30 QUIT
31 ;
32VAR ;
33 ; DSM Diagnosis
34 ;D RECORD^YSDX0001("VAR^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
35 ;
36 S DX=$P(L2,";",2),DX1=$P(L2,";"),DX2="^"_DX_DX1_","_0_")"
37 ;
38 I DX["YSD" D
39 . S YSDXN=^YSD(627.7,+DX1,"D")
40 ;
41 ;
42 ; ICD Diagnosis
43 I DX["ICD" D
44 . S YSDXN=$P(@DX2,U,3),YSDXNN=$P(@DX2,U)
45 ;
46 S Z=$P(^YSD(627.8,L3,0),U,3)
47 D DC
48 S RDT=Z,ST=$P(^YSD(627.8,L3,1),U,4)
49 S ST1=$S(ST="A":"ACTIVE",ST="I":"INACTIVE",1:"UNKNOWN")
50 S Z=$P(^YSD(627.8,L3,1),U,5)
51 D DC
52 S STDT=Z
53PLINE ;
54 ;D RECORD^YSDX0001("PLINE^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
55 D:$Y+YSSL>IOSL CK
56 G:YSLFT FIN ;->
57 ;W !,$E(YSDXN,1,55),?63,$J(ST1,8),?72,STDT
58 W !,$E(YSDXN,1,52),?55,$J(ST1,12),?69,STDT
59 QUIT
60 ;
61DC ;
62 ;D RECORD^YSDX0001("DC^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
63 S Z=$E(Z,1,7) S:Z]"" Z=$$FMTE^XLFDT(Z,"5ZD")
64 QUIT
65 ;
66CK ;
67 ;D RECORD^YSDX0001("CK^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
68 I $D(YSNOFORM) D:'YST WAIT QUIT:YSLFT W:YST @IOF QUIT ;->
69 S:YST&(YSLFT=0) YSCON=1
70 D ENFT^YSFORM:YST,WAIT:'YST
71 QUIT:YSLFT ;->
72 D:YST ENHD^YSFORM
73 X:'YST YSFHDR(1)
74 QUIT
75WAIT ;
76 ;D RECORD^YSDX0001("WAIT^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
77 N DIR,DIRUT,DTOUT,DUOUT
78 F I0=1:1:(IOSL-$Y-2) W !
79 W:($Y+1)<IOSL !
80 S DIR(0)="E"
81 D ^DIR K DIR
82 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
83 W @IOF
84 QUIT
85 ;
86FIN ;
87 ;D RECORD^YSDX0001("FIN^YSDX0001") ;Used for testing. Inactivated in YSDX0001...
88 S:YST YSLFT=1
89 D:'$D(PROFILE) CK
90 QUIT
91 ;---------------------------------------------------------------------
92RECORD(TXT) ;
93 N YSUCT,YSUOPT
94 QUIT:$G(TXT)']"" ;->
95 S YSUOPT=$S($G(XQY0)']"":"Unknown",1:$P(XQY0,U,1,2))
96 I YSUOPT'="Unknown" S YSUOPT=$P(YSUOPT,U,2)_" ["_$P(YSUOPT,U)_"]"
97 S YSUCT=$G(^TMP("YSDX","COUNT",+DUZ))+1,^TMP("YSDX","COUNT",+DUZ)=YSUCT
98 S ^TMP("YSDX",+$G(DUZ),YSUCT)=$H_U_YSUOPT_"~"_TXT
99 QUIT
100 ;
101EOR ;YSDX0001 - Diagnosis Miscellaneous Code ;11/17/93 14:01
Note: See TracBrowser for help on using the repository browser.