source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMGRP1.m@ 1261

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1QAMGRP1 ;HISC/DAD-AUTO LOAD GROUP DATA: ICD DIAGNOSES ;9/3/93 13:14
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3 F QAQLABEL="AN1","AN2","AN3","AN4","AN5","TR8A","TR8B","TR10","TR11","TR12","CV4" S QAQCHECK=0 D LOOP Q:QAQCHECK=-1
4 G:QAQCHECK'=-1 ^QAMGRP2
5EXIT K X,DIC,DLAYGO,QAMD0,Y,OFFSET,LINE,ST,END,NUM,D0,DIK,DA,LASTD0,TAB,QAQCOUNT,QAQCHECK,QAQLABEL,NUMBER
6 Q
7LOOP ;
8 S X=$P($T(@QAQLABEL),";;",2) W !!,"Loading: ",X
9 S QAMD0=+$O(^QA(743.5,"B",$E(X,1,30),0)) I QAMD0 W !!?5,"*** ",X," already exists !! ***",*7 D G:(QAQCHECK=-1)!(QAQCHECK=2) XIT
10ASK . W !!?5,"Do you want to check this group's completeness"
11 . S %=2 D YN^DICN I '% W !!?10,"Please answer Y(es) or N(o)" G ASK
12 . S QAQCHECK=%
13 . Q
14 W !!,"Working",! S (QAQCOUNT,TAB)=0
15 I QAQCHECK'>0 K DD,DIC,DINUM,DO S DIC="^QA(743.5,",DIC(0)="LM",DIC("DR")=".02////80",DLAYGO=743.5 D FILE^DICN S QAMD0=+Y
16 F OFFSET=1:1 S LINE=$P($T(@QAQLABEL+OFFSET),";;",2) Q:LINE="" D
17 . S ST=+LINE,END=$S(LINE["-":+$P(LINE,"-",2),1:ST),NUM=ST-.000001
18 . F S NUM=$O(^ICD9("BA",NUM)) Q:(NUM'>0)!(NUM>END) D
19 .. F D0=0:0 S D0=$O(^ICD9("BA",NUM,D0)) Q:D0'>0 D
20 ... S NUMBER=$P($G(^ICD9(D0,0)),"^") Q:NUMBER'>0
21 ... S X=NUMBER_";"_D0
22 ... G:$O(^QA(743.5,QAMD0,"GRP","B",$E(X,1,30),0)) SKIP
23 ... S ^QA(743.5,QAMD0,"GRP",D0,0)=X
24 ... S QAQADICT=743.51,QAQAFLD=.01,DA(1)=QAMD0,DA=D0 D ENSET^QAQAXREF
25SKIP ... S LASTD0=D0,QAQCOUNT=QAQCOUNT+1
26 ... W:'TAB ! W ?TAB,NUMBER S TAB=TAB+$S(TAB=70:-70,1:10)
27 ... Q
28 .. Q
29 . Q
30 S ^QA(743.5,QAMD0,"GRP",0)="^743.51A^"_LASTD0_"^"_QAQCOUNT
31 W !!,QAQCOUNT," ICD-9-CM Diagnosis Codes ",$S(QAQCHECK=1:"checked",1:"loaded"),".",!
32XIT Q
33 ;
34AN1 ;;AN-1 DIAG GROUP
35 ;;431
36 ;;433.0
37 ;;433.1
38 ;;433.2
39 ;;433.3
40 ;;433.8
41 ;;433.9
42 ;;434.0
43 ;;434.1
44 ;;434.9
45 ;;436
46 ;;668.20
47 ;;668.21
48 ;;668.22
49 ;;997.0
50 ;;
51AN2 ;;AN-2 DIAG GROUP
52 ;;736.05
53 ;;736.79
54 ;;781.4
55 ;;782.0
56 ;;
57AN3 ;;AN-3 DIAG GROUP
58 ;;410.01
59 ;;410.11
60 ;;410.21
61 ;;410.31
62 ;;410.41
63 ;;410.51
64 ;;410.61
65 ;;410.71
66 ;;410.81
67 ;;410.91
68 ;;
69AN4 ;;AN-4 DIAG GROUP
70 ;;427.11
71 ;;427.5
72 ;;668.11
73 ;;668.12
74 ;;669.41
75 ;;669.42
76 ;;997.1
77 ;;
78AN5 ;;AN-5 DIAG GROUP
79 ;;669.1
80 ;;799.1
81 ;;995.4
82 ;;998.0
83 ;;
84TR8A ;;TR-8A DIAG GROUP (GUNSHOT)
85 ;;879.2-879.5
86 ;;
87TR8B ;;TR-8B DIAG GROUP (KNIFE)
88 ;;879.2-879.5
89 ;;
90TR10 ;;TR-10 DIAG GROUP
91 ;;821.01
92 ;;821.11
93 ;;
94TR11 ;;TR-11 DIAG GROUP
95 ;;852.2
96 ;;852.5
97 ;;868.03
98 ;;868.13
99 ;;860.2
100 ;;860.3
101 ;;860.4
102 ;;860.5
103 ;;901.0
104 ;;902.0
105 ;;423.9
106 ;;560.0
107 ;;560.1
108 ;;
109TR12 ;;TR-12 DIAG GROUP-BASIC TRAUMA
110 ;;800.-801.9
111 ;;802.1
112 ;;802.3-802.399999
113 ;;802.5
114 ;;802.7
115 ;;802.9-809.1
116 ;;810.1
117 ;;811.1
118 ;;812.1
119 ;;812.3
120 ;;812.5
121 ;;813.1
122 ;;813.3
123 ;;813.5
124 ;;813.9
125 ;;818-822.1
126 ;;823.1
127 ;;823.3
128 ;;823.9
129 ;;827
130 ;;939.9
131 ;;950-959.9
132 ;;
133CV4 ;;CV-4 DIAG GROUP
134 ;;410.0-410.1
135 ;;997.1
136 ;;
Note: See TracBrowser for help on using the repository browser.