source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSD4CK00.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.2 KB
Line 
1YSD4CK00 ;DALISC/LJA - Check integrity of DSM3, 3R,DSM,&Qual files ;6/2/94 1553
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;;
4 ;
5INIT ;
6 K ^TMP($J)
7 K A7UCT S A7UCT=0
8 ;
9CTRL ;
10 D EXIT
11 D DSM3
12 D DSM3R
13 D DSM
14 D REPORT
15 QUIT
16 ;
17REPORT ;
18 W !!,$S($D(^TMP($J)):"Errors found...",1:"No errors found...")
19 QUIT
20 ;
21DSM3 ;
22 W !!,"Comparing DSM3 to DSM file"
23 S (A7UCT,A7UIEN)=0
24 F S A7UIEN=$O(^DIC(627,A7UIEN)) QUIT:A7UIEN'>0 D
25 . S A7UCT=A7UCT+1 W:'(A7UCT#20) "."
26 . S A7U0=$G(^DIC(627,+A7UIEN,0))
27 . S A7UK=$$STRIP($G(^DIC(627,+A7UIEN,2)))
28 . S A7U7IEN=+$P(A7U0,U,4)
29 . I 'A7U7IEN S ^TMP($J,"E",+A7UIEN,+A7U7IEN,1)="No DSM conversion number"
30 . S A7U70=$G(^YSD(627.7,+A7U7IEN,0))
31 . S A7U7D=$G(^YSD(627.7,+A7U7IEN,"D"))
32 . S A7U7K=$$STRIP($G(^YSD(627.7,+A7U7IEN,"K")))
33 . I $P(A7U70,U,2)'=3 S ^TMP($J,"E",+A7UIEN,+A7U7IEN,1.5)="DSM version not present"
34 . I $P(A7U70,U)'=A7UIEN S ^TMP($J,"E",+A7UIEN,+A7U7IEN,2)="Number error"
35 . I $P(A7U0,U)'=A7U7D S ^TMP($J,"E",+A7UIEN,+A7U7IEN,3)="Name error"
36 . I $P(A7U0,U,2)'=$P(A7U70,U,9) S ^TMP($J,"E",+A7UIEN,+A7U7IEN,4)="ICD9 Code error"
37 . I $P(A7U0,U,3)'=$P(A7U70,U,4) S ^TMP($J,"E",+A7UIEN,+A7U7IEN,5)="DSM3 Speck error"
38 . I A7UK'=A7U7K S ^TMP($J,"E",+A7UIEN,+A7U7IEN,6)="Keyword error"
39 . I $P(A7U70,U,3)'=A7UIEN S ^TMP($J,"E",+A7UIEN,+A7U7IEN,7)="Source IEN error"
40 QUIT
41 ;
42STRIP(K) ;
43 QUIT:$G(K)']"" ""
44 F QUIT:$E(K)'=" "&($E(K,$L(K))'=" ") D
45 . I $E(K)=" " S K=$E(K,2,999)
46 . I $E(K,$L(K))=" " S K=$E(K,1,$L(K)-1)
47 QUIT K
48 ;
49DSM3R ;
50 W !!,"Comparing DSM-III-R to DSM file"
51 S (A7UCT,A7UIEN)=0
52 F S A7UIEN=$O(^DIC(627.5,A7UIEN)) QUIT:A7UIEN'>0 D
53 .
54 . ; Set DSM-III-R data
55 . S A7UCT=A7UCT+1 W:'(A7UCT#20) "."
56 . S A7U0=$G(^DIC(627.5,+A7UIEN,0))
57 . S A7U3=$G(^DIC(627.5,+A7UIEN,3))
58 . S A7UK=$$STRIP($G(^DIC(627.5,+A7UIEN,1)))
59 . S A7UQ=$$QUAL(627.5,+A7UIEN)
60 . S A7U7IEN=+$P(A7U0,U,3)
61 .
62 . ; Conversion number exists?
63 . I 'A7U7IEN S ^TMP($J,"E",+A7UIEN,+A7U7IEN,1)="No DSM conversion number" QUIT ;->
64 .
65 . ; Set DSM data
66 . S A7U70=$G(^YSD(627.7,+A7U7IEN,0))
67 . S A7U7D=$G(^YSD(627.7,+A7U7IEN,"D"))
68 . S A7U7K=$$STRIP($G(^YSD(627.7,+A7U7IEN,"K")))
69 . S A7U7Q=$$QUAL(627.7,+A7U7IEN)
70 .
71 . ; Apply tests...
72 . I $P(A7U70,U)'=$P(A7U0,U,2) S ^TMP($J,"E",+A7UIEN,+A7U7IEN,2)="Number error"
73 . I $P(A7U0,U)'=A7U7D S ^TMP($J,"E",+A7UIEN,+A7U7IEN,3)="Name error"
74 . I $P(A7U3,U)'=$P(A7U70,U,15) S ^TMP($J,"E",+A7UIEN,+A7U7IEN,8)="Short name error"
75 . I A7UK'=A7U7K S ^TMP($J,"E",+A7UIEN,+A7U7IEN,6)="Keyword error"
76 . I A7UQ'=A7U7Q S ^TMP($J,"E",+A7UIEN,+A7U7IEN,1.3)="Unequal qualifiers"_" "_A7UQ_":"_A7U7Q
77 . I $P(A7U70,U,2)'="3R" S ^TMP($J,"E",+A7UIEN,+A7U7IEN,1.5)="DSM version not present"
78 . I $P(A7U70,U,3)'=A7UIEN S ^TMP($J,"E",+A7UIEN,+A7U7IEN,7)="Source IEN error"
79 QUIT
80 ;
81QUAL(FILE,NO) ;
82 N NODE,QSTR
83 QUIT:$G(FILE)'>0!($G(NO)'>0) ""
84 S GREF=$S(FILE=627.5:"^DIC(627.5,",FILE=627.7:"^YSD(627.7,",1:"")
85 S NODE=$S(FILE=627.5:2,FILE=627.7:"""Q""",1:"")
86 I GREF']""!(NODE']"") QUIT ""
87 S GREF=GREF_+NO_","_NODE
88 S LP=GREF_")",STOP=GREF_","
89 S QSTR="" K QUAL
90 F S LP=$Q(@LP) QUIT:LP'[STOP D
91 . QUIT:$P(LP,",",4)'>0 ;->
92 . S QNO=+@LP
93 . S QUAL(QNO)=""
94 S QNO=0
95 F S QNO=$O(QUAL(QNO)) Q:'QNO S QSTR=QSTR_+QNO
96 QUIT QSTR
97 ;
98DSM ;
99 W !!,"Checking DSM file, and comparing to DSM3 and DSM-III-R file"
100 S CT=0
101 S IENDSM=0
102 F S IENDSM=$O(^YSD(627.7,IENDSM)) QUIT:IENDSM'>0 D
103 . S CT=CT+1 W:'(CT#20) "."
104 . S N0=^YSD(627.7,+IENDSM,0)
105 . S ND=^YSD(627.7,+IENDSM,"D")
106 . S NK=$G(^YSD(627.7,+IENDSM,"K"))
107 . S NQ=$$QUAL(627.7,+IENDSM)
108 . S OK=1
109 . F I=1,2,8 I $P(N0,U,I)']"" S ^TMP($J,"E",627.7,+IENDSM,12)="Missing pieces"
110 . I ND']"" S ^TMP($J,"E",627.7,+IENDSM,13)="No diagnosis name"
111 . I NK']"",$P(N0,U,2)="3R" S ^TMP($J,"E",627.7,+IENDSM,5)="No Keywords"
112 . I NQ']"",$P(N0,U,2)="3R" D
113 . . QUIT:'$D(^DIC(627.5,+$P(N0,U,3),2)) ;->
114 . . S ^TMP($J,"E",627.7,+IENDSM,14)="3R/4 entry w/no qualifiers"
115 . S A7UX=$P(N0,U,2)
116 . I A7UX=3,'$D(^DIC(627,+$P(N0,U,3))) D
117 . . S ^TMP($J,"E",627.7,+IENDSM,2)="No source data",OK=0
118 . I A7UX="3R",'$D(^DIC(627.5,+$P(N0,U,3))) D
119 . . S ^TMP($J,"E",627.7,+IENDSM,2)="No source data",OK=0
120 . I $P(N0,U,2)'=4,A7UX'=3,A7UX'="3R" S ^TMP($J,"E",627.7,+IENDSM,3)="Bum DSM version",OK=0
121 QUIT
122 ;
123EXIT ;
124 QUIT
125 ;
126EOR ;YSD4CK00 - Check integrity of DSM3,3R,DSM,&Qual files ;6/2/94 1553
127 ;
Note: See TracBrowser for help on using the repository browser.