source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2043A.m@ 841

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

initial load of WorldVistAEHR
File size: 9.0 KB
RevLine 
[613]1LEX2043A ; ISL/KER - Post Install LEX*2.0*43 ; 09/06/2006
2 ;;2.0;LEXICON UTILITY;**43**;Sep 23, 1996;Build 1
3 ;
4ALL ;
5 D EN,EN^LEX2043B,EN^LEX2043C,EN^LEX2043D
6 Q
7EN ; Main Entry Point
8 D MES^XPDUTL(" "),MES^XPDUTL(" Fixes made to correct errors in Lexicon Code Lookups"),MES^XPDUTL(" ")
9 D C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16
10 Q
11C1 ; Lookup 038.49 returns 038.40
12 D IND("Lookup 038.49 returns 038.40") N IEN,DA,DIK
13 S IEN=306947 K FDA S FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
14 S IEN=273231 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
15 Q
16C2 ; Lookup 039.4 returns 039.9
17 D IND("Lookup 039.4 returns 039.9") N IEN,DA,DIK
18 S IEN=77345 K FDA S FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
19 S IEN=77352 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
20 Q
21C3 ; Lookup 070.31 returns 070.20
22 D IND("Lookup 070.31 returns 070.20") N IEN,DA,DIK
23 S IEN=273372 K FDA S FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
24 S IEN=273373 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
25 Q
26C4 ; Lookup 134.9 returns 136.9
27 D IND("Lookup 134.9 returns 136.9") N IEN,DA,DIK
28 S IEN=95357 K FDA S FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
29 S IEN=95355 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
30 Q
31C5 ; Lookup 201.10 returns 201.90
32 D IND("Lookup 201.10 returns 201.90") N IEN,DA,DIK
33 S IEN=306577 K FDA S FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
34 S IEN=303992 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
35 Q
36C6 ; Lookup 237.71 returns 237.70
37 D IND("Lookup 237.71 returns 237.70") N IEN,DA,DIK
38 S IEN=87807 K FDA S FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
39 S IEN=87824 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
40 S IEN=87807 K FDA S FDA(757.02,IEN_",",4)="" D FILE^DIE("","FDA")
41 S IEN=285394 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
42 S IEN=285394 K FDA S FDA(757.02,IEN_",",4)="1" D FILE^DIE("","FDA")
43 S IEN=87824 K FDA S FDA(757.02,IEN_",",4)="1" D FILE^DIE("","FDA")
44 S IEN=87815 K FDA S FDA(757.02,IEN_",",4)="" D FILE^DIE("","FDA")
45 S IEN=82712 K FDA S FDA(757.01,IEN_",",.01)="Neurofibromatosis Type 1 (Von Recklinghausen's Disease)" D FILE^DIE("","FDA")
46 S IEN=274566 K FDA S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
47 S IEN=274566 K FDA S FDA(757.02,IEN_",",4)="1" D FILE^DIE("","FDA")
48 S IEN=267773 K FDA S FDA(757.01,IEN_",",.01)="Neurofibromatosis Type 2 (Acoustic)" D FILE^DIE("","FDA")
49 Q
50C7 ; Lookup 307.54 returns 536.2
51 D IND("Lookup 307.54 returns 536.2") N IEN,DA,DIK
52 S IEN=271705 K FDA S FDA(757.02,IEN_",",4)="" D FILE^DIE("","FDA")
53 S IEN=271708 K FDA S FDA(757.02,IEN_",",4)="" D FILE^DIE("","FDA")
54 S IEN=127248 K FDA S FDA(757.01,IEN_",",.01)="Psychogenic Vomiting" D FILE^DIE("","FDA")
55 S IEN=134692 K FDA S FDA(757.02,IEN_",",1)="307.54",FDA(757.02,IEN_",",2)="1",FDA(757.02,IEN_",",4)="1"
56 S FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
57 Q
58C8 ; Lookup 315.02 returns 784.61
59 D IND("Lookup 315.02 returns 784.61") N IEN,DA,DIK
60 S IEN=37559 K FDA S FDA(757.01,IEN_",",.01)="Dyslexia, Developmental" D FILE^DIE("","FDA")
61 S IEN=37562 K FDA S FDA(757.01,IEN_",",.01)="Developmental Dyslexia" D FILE^DIE("","FDA")
62 S IEN=39781 K FDA S FDA(757.02,IEN_",",4)="",FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
63 S IEN=39788 K FDA S FDA(757.02,IEN_",",4)="1",FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
64 S IEN=4790 K FDA S FDA(757.01,IEN_",",.01)="Alexia and Dyslexia" D FILE^DIE("","FDA")
65 S IEN=4995 K FDA S FDA(757.02,IEN_",",4)="1",FDA(757.02,IEN_",",6)="1"
66 Q
67C9 ; Lookup 327.51 returns 780.58
68 D IND("Lookup 327.51 returns 780.58") N IEN,DA,DIK
69 S IEN=331568 K FDA S FDA(757.01,IEN_",",.01)="Limb Related Movement Disorder" D FILE^DIE("","FDA")
70 S IEN=327520 K FDA S FDA(757.02,IEN_",",4)="",FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
71 Q
72C10 ; Lookup 335.21 returns 335.10
73 D IND("Lookup 335.21 returns 335.10") N IEN,DA,DIK
74 S ^LEX(757,16240,0)="79999^" S DA=16240,DIK="^LEX(757," D IX1^DIK
75 S ^LEX(757.001,16240,0)="16240^4^6" S DA=16240,DIK="^LEX(757.001," D IX1^DIK
76 S ^LEX(757.1,23383,0)="16240^6^47" S DA=23383,DIK="^LEX(757.1," D IX1^DIK
77 S IEN=79999 K FDA S FDA(757.01,IEN_",",1)="16240",FDA(757.01,IEN_",",2)="1" D FILE^DIE("","FDA")
78 S ^LEX(757.01,79999,0)="Progressive Muscular Atrophy"
79 S ^LEX(757.01,79999,1)="16240^1^D^12"
80 S IEN=84909 K FDA S FDA(757.02,IEN_",",3)="16240",FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
81 S ^LEX(757.02,84909,0)="79999^335.21^1^16240^1^^1"
82 S IEN=80005 K FDA S FDA(757.01,IEN_",",.01)="Spinal Muscular Atrophy, Unspecified" D FILE^DIE("","FDA")
83 S IEN=88186 K FDA S FDA(757.01,IEN_",",.01)="Spinal Muscular Atrophy, Other" D FILE^DIE("","FDA")
84 Q
85C11 ; Lookup 345.51 returns 345.40
86 D IND("Lookup 345.51 returns 345.40") N IEN,DA,DIK
87 S IEN=90499 K FDA S FDA(757.01,IEN_",",.01)="Partial epilepsy, without mention of impairment of consciousness, with intractable epilepsy" D FILE^DIE("","FDA")
88 S DA=275286,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,275286,0)="90499^345.51^1^18596^1^^1",^LEX(757.02,275286,4,0)="^757.28D^1^1",^LEX(757.02,275286,4,1,0)="2781001^1" D IX1^DIK
89 Q
90C12 ; Lookup 346.80 returns 346.90
91 D IND("Lookup 346.80 returns 345.90") N IEN,DA,DIK
92 S IEN=55511 K FDA S FDA(757.01,IEN_",",.01)="Migraine, unspecified, without mention of Intractable Migraine" D FILE^DIE("","FDA")
93 S IEN=304585 K FDA S FDA(757.02,IEN_",",4)="",FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
94 S IEN=306567 K FDA S FDA(757.02,IEN_",",4)="1",FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
95 S IEN=293880 K FDA S FDA(757.01,IEN_",",.01)="Other forms of Migraine without mention of Intractable Migraine" D FILE^DIE("","FDA")
96 S IEN=304584 K FDA S FDA(757.02,IEN_",",4)="1",FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
97 S IEN=77884 K FDA S FDA(757.01,IEN_",",.01)="Other forms of Migraine with Intractable Migraine, so stated" D FILE^DIE("","FDA")
98 S DA=304384,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,304384,0)="77884^346.81^1^15780^1^^1",^LEX(757.02,304384,4,0)="^757.28D^1^1",^LEX(757.02,304384,4,1,0)="2781001^1" D IX1^DIK
99 Q
100C13 ; Lookup 357.2 returns 250.60
101 D REMI("Lookup 357.2 returns 250.60","HD0000000 141151")
102 D REMI("Lookup 357.2 returns 250.60 (dupe)","HD0000000 140716")
103 D REMI("Lookup 357.2 returns 250.60 (dupe)","HD0000000 141456")
104 D REMI("Lookup 357.2 returns 250.60 (dupe)","HD0000000 142510")
105 D REMI("Lookup 357.2 returns 250.60 (dupe)","HD0000000 145965")
106 N IEN,DA,DIK
107 S IEN=102058 K FDA S FDA(757.02,IEN_",",4)="1",FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
108 S IEN=306728 K FDA S FDA(757.02,IEN_",",4)="",FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
109 Q
110C14 ; Lookup 362.02 returns 250.50
111 D IND("Lookup 362.02 returns 250.50") N IEN,DA,DIK
112 S IEN=275435 K FDA S FDA(757.02,IEN_",",4)="1",FDA(757.02,IEN_",",6)="1" D FILE^DIE("","FDA")
113 S IEN=307963 K FDA S FDA(757.02,IEN_",",4)="",FDA(757.02,IEN_",",6)="0" D FILE^DIE("","FDA")
114 Q
115C15 ; Lookup 363.22 returns 364.24
116 D IND("Lookup 363.22 returns 364.24") N IEN,DA,DIK
117 S ^LEX(757,130566,0)="265238^",DA=130566,DIK="^LEX(757," D IX1^DIK
118 S ^LEX(757.001,130566,0)="130566^4^4",DA=130566,DIK="^LEX(757.001," D IX1^DIK
119 S ^LEX(757.1,196103,0)="130566^6^47",DA=196103,DIK="^LEX(757.1," D IX1^DIK
120 S IEN=265238 K FDA S FDA(757.01,IEN_",",.01)="Harada's Syndrome",FDA(757.01,IEN_",",1)="130566",FDA(757.01,IEN_",",2)="1",FDA(757.01,IEN_",",4)="1" D FILE^DIE("","FDA")
121 S IEN=265239 K FDA S FDA(757.01,IEN_",",.01)="Harada's Disease",FDA(757.01,IEN_",",1)="130566" D FILE^DIE("","FDA")
122 S DA=271631,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,271631,0)="265238^D-X443^8^130566^0^^0",^LEX(757.02,271631,4,0)="^757.28D^1^1",^LEX(757.02,271631,4,1,0)="2960923^1" D IX1^DIK
123 S DA=271632,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,271632,0)="265239^363.22^1^130566^1^^1",^LEX(757.02,271632,4,0)="^757.28D^1^1",^LEX(757.02,271632,4,1,0)="2781001^1" D IX1^DIK
124 Q
125C16 ; Lookup 365.13 returns 365.10
126 D IND("Lookup 365.13 returns 365.10") N IEN,DA,DIK
127 S ^LEX(757,10567,0)="51211^" S DA=10567,DIK="^LEX(757," D IX1^DIK
128 S ^LEX(757.001,10567,0)="10567^4^4" S DA=10567,DIK="^LEX(757.001," D IX1^DIK
129 S ^LEX(757.1,15651,0)="10567^6^47" S DA=15651,DIK="^LEX(757.1," D IX1^DIK
130 S IEN=51211 K FDA S FDA(757.01,IEN_",",.01)="Pigmentary Glaucoma",FDA(757.01,IEN_",",1)="10567",FDA(757.01,IEN_",",2)="1",FDA(757.01,IEN_",",4)="1" D FILE^DIE("","FDA")
131 S IEN=51210 K FDA S FDA(757.01,IEN_",",.01)="Pigmentary Glaucoma, Open Angle",FDA(757.01,IEN_",",1)="10567" D FILE^DIE("","FDA")
132 S DA=54078,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,54078,0)="51210^D-X316^8^10567^1^^0",^LEX(757.02,54078,4,0)="^757.28D^1^1",^LEX(757.02,54078,4,1,0)="2960923^1" D IX1^DIK
133 S DA=54079,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,54079,0)="51211^365.13^1^10567^1^^1",^LEX(757.02,54079,4,0)="^757.28D^1^1",^LEX(757.02,54079,4,1,0)="2781001^1" D IX1^DIK
134 Q
135REM(X,Y) ; Remedy Ticket
136 N I S X=$G(X),Y=$G(Y) Q:'$L(X) I $L(Y) S X=" "_X F Q:$L(X)>48 S X=X_" "
137 S X=X_" "_Y S:$E(X,1)'=" " X=" "_X D MES^XPDUTL(X)
138REMI(X,Y) ; Remedy Ticket - Indented
139 N I S X=$G(X),Y=$G(Y) Q:'$L(X)
140 I $L(Y) S X=" "_X F Q:$L(X)>48 S X=X_" "
141 S X=X_" "_Y S:$E(X,1)'=" " X=" "_X D MES^XPDUTL(X)
142 Q
143IND(X) ; Indent Text
144 N I S X=$G(X) Q:'$L(X) S X=" "_X D MES^XPDUTL(X)
145 Q
Note: See TracBrowser for help on using the repository browser.