source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2047B.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1LEX2047B ; ISL/KER - Post Install LEX*2.0*47 (part 2) ; 02/05/2007
2 ;;2.0;LEXICON UTILITY;**47**;Sep 23, 1996;Build 5
3 ;
4 ; Global Variables
5 ; ^ICPT( DBIA 4489
6 ; ^LEX(757.01 N/A
7 ; ^LEX(757.02 N/A
8 ; ^DIC(81.3, DBIA 4492
9 ;
10 ; External References
11 ; FILE^DIE DBIA 2053
12 ; UPDATE^DIE DBIA 2053
13 ; ^DIK DBIA 10013
14 ; IX1^DIK DBIA 10013
15 ; $$IENS^DILF DBIA 2054
16 ; MES^XPDUTL DBIA 10141
17 ;
18EN ; Main Entry Point
19 D C6,C7,C8,C9,C10,C11
20 Q
21C6 ; 161266 Canalith (HCPCS S9092) is misspelled
22 D IND(" "),REMI("CANALITH (S9092) is misspelled","HD0000000 161266")
23 D IND(" S9092 - Change CANOLITH to CANALITH")
24 N IENS,IENA,IENB,IEN,LEXDA,DA,DIK,DIE
25 K IENS,FDA S (IEN,DA)=329685,IENS=IEN_",",FDA(757.01,IENS,.01)="Canalith Repositioning, per visit" D FILE^DIE("","FDA") S DIK="^LEX(757.01," D IX1^DIK
26 S (IEN,DA(1),LEXDA(1))=107092,(IENA,LEXDA,DA)=$O(^ICPT(IEN,61,"B",3030101,0)) I +IEN>0,+IENA>0 D
27 . K IENS,FDA S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="CANALITH REPOSITIONING" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG")
28 S (IEN,DA(1),LEXDA(1))=107092,(IENA,LEXDA,DA)=$O(^ICPT(IEN,62,"B",3030101,0)) I +IEN>0,+IENA>0 D
29 . K IENS,FDA N DA,I S DA(2)=LEXDA(1),DA(1)=LEXDA S I=0 F S I=$O(^ICPT(DA(2),62,DA(1),1,I)) Q:+I'>0 D
30 . . S DA=I Q:$G(^ICPT(DA(2),62,DA(1),1,DA,0))'["CANOLITH REPOSITIONING, PER VISIT" N LEXDA S LEXDA(2)=DA(2),LEXDA(1)=DA(1),LEXDA=DA
31 . . S IENS=$$IENS^DILF(.LEXDA),FDA(81.621,IENS,.01)="CANALITH REPOSITIONING, PER VISIT" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG")
32 I $D(^ICPT(107092,"D",1,0)) D
33 . Q:$G(^ICPT(107092,"D",1,0))'["CANOLITH REPOSITIONING, PER VISIT"
34 . S ^ICPT(107092,"D",1,0)="CANALITH REPOSITIONING, PER VISIT" K ^ICPT(107092,"D","B") S ^ICPT(107092,"D","B","CANALITH REPOSITIONING, PER VI",1)=""
35 K IENS,DA,FDA S DA=IEN S FDA(81,IEN_",",2)="CANALITH REPOSITIONING" D FILE^DIE("","FDA") S DA=IEN,DIK="^ICPT(" D IX1^DIK
36 Q
37C7 ; 166892 CPT J0585 Botulinum Toxin Quantity
38 D IND(" "),REMI("Botulinum Toxin Quantity (J0585)","HD0000000 166892")
39 K IENS,FDA S (IEN,LEXDA,DA)=320347 S FDA(757.01,IEN_",",.01)="Botulinum toxin type A, per unit"
40 D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.01," D IX1^DIK
41 Q
42C8 ; 168449 Lookup 038.9 returns 995.91
43 D IND(" "),REMI("Lookup ICD 038.9 returns 995.91","HD0000000 168449")
44 D REMI("Lookup ICD 038.9 returns 995.91 (dupe)","HD0000000 171316")
45 N FDA,DA,DIK S DA=330020
46 K FDA S FDA(757.02,(DA_","),6)=0 D FILE^DIE("","FDA")
47 K FDA S FDA(757.02,(DA_","),4)=0 D FILE^DIE("","FDA") S DA=324672
48 K FDA S FDA(757.02,(DA_","),6)=1 D FILE^DIE("","FDA")
49 K FDA S FDA(757.02,(DA_","),4)=1 D FILE^DIE("","FDA")
50 K FDA S FDA(757.02,(DA_","),5)="" D FILE^DIE("","FDA")
51 S DA(1)=324672,DA=2 I $D(^LEX(757.02,DA(1),4,DA,0)) D
52 . S DIK="^LEX(757.02,"_DA(1)_",4," D ^DIK
53 K DA S DIK="^LEX(757.02,",DA=330020 D IX1^DIK S DA=324672 D IX1^DIK
54 Q
55C9 ; 174410 New dental code D2970
56 D IND(" "),REMI("New Dental Code D2970","HD0000000 174410")
57 N ACT,CPIEN,DA,DIC,DIE,DIK,EFF,EXIEN,EXIST,EXP,FDA,I,IEN,IENS,MSG,SOIEN,TXT S EXIEN=318447,IENS=EXIEN_","
58 S EXP="Temporary Crown (Fractured Tooth), usually a preformed artificial Crown, fitted over a damaged tooth as an immediate protective device. (not to be used as a temporization during crown fabrication)"
59 K FDA S FDA(757.01,IENS,.01)=EXP D FILE^DIE("","FDA") K DA S DA=EXIEN,DIK="^LEX(757.01," D IX1^DIK
60 K DA,DIK,DIC,FDA,IENS,ACT S SOIEN=254,ACT=3,EFF=3070101,IENS="+"_ACT_","_SOIEN_","
61 S EXIST=$O(^LEX(757.02,SOIEN,4,"B",EFF,0)),EXIST=$P($G(^LEX(757.02,SOIEN,4,+EXIST,0)),"^",2)
62 S FDA(757.28,IENS,.01)=EFF,FDA(757.28,IENS,1)=1 I '$L(EXIST)!(+EXIST'>0) D UPDATE^DIE("S","FDA",,("MSG("_SOIEN_")"))
63 K DA,DIK,DIC,FDA,IENS,ACT S CPIEN=100384,EFF=3070101
64 S IENS=CPIEN_",",FDA(81,IENS,2)="TEMPORARY CROWN (FX TOOTH)",FDA(81,IENS,5)="",FDA(81,IENS,7)=""
65 S FDA(81,IENS,8)=EFF D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
66 K DA,DIK,DIC,FDA,IENS,ACT S ACT=3,IENS="+"_ACT_","_CPIEN_","
67 S EXIST=$O(^ICPT(CPIEN,60,"B",EFF,0)),EXIST=$P($G(^ICPT(CPIEN,60,+EXIST,0)),"^",2)
68 S FDA(81.02,IENS,.01)=EFF,FDA(81.02,IENS,.02)=1
69 I '$L(EXIST)!(+EXIST'>0) D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
70 K DA,DIK,DIC,FDA,IENS,ACT,TXT S ACT=2,IENS="+"_ACT_","_CPIEN_",",TXT="TEMPORARY CROWN (FX TOOTH)"
71 S EXIST=$O(^ICPT(CPIEN,61,"B",EFF,0)),EXIST=$P($G(^ICPT(CPIEN,61,+EXIST,0)),"^",2)
72 S FDA(81.061,IENS,.01)=EFF,FDA(81.061,IENS,1)=TXT
73 I '$L(EXIST) D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
74 K DA,DIK,DIC,FDA,IENS,ACT,TXT,IEN S ACT=2,IENS="+"_ACT_","_CPIEN_",",IEN=0
75 S TXT(1)="TEMPORARY CROWN (FRACTURED TOOTH), USUALLY A PREFORMED ARTIFICIAL CROWN,"
76 S TXT(2)="FITTED OVER A DAMAGED TOOTH AS AN IMMEDIATE PROTECTIVE DEVICE. (NOT TO"
77 S TXT(3)="BE USED AS A TEMPORIZATION DURING CROWN FABRICATION)"
78 S EXIST=$O(^ICPT(CPIEN,62,"B",EFF,0)),EXIST=$P($G(^ICPT(CPIEN,62,+EXIST,0)),"^",1)
79 S FDA(81.062,IENS,.01)=EFF I '$L(EXIST)!(EXIST'=EFF) D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
80 S IEN=$O(^ICPT(CPIEN,62,"B",EFF,0)) I +IEN>0 D
81 . N DA,DIK,I S DA(2)=CPIEN,DA(1)=IEN S I=0 F S I=$O(^ICPT(DA(2),62,DA(1),1,I)) Q:+I'>0 D
82 . . S DIK="^ICPT("_DA(2)_",62,"_DA(1)_",1,",DA=I D ^DIK
83 . S DA(2)=CPIEN,DA(1)=IEN S I=0 F S I=$O(TXT(I)) Q:+I'>0 D
84 . . Q:'$L($G(TXT(I))) S ^ICPT(DA(2),62,DA(1),1,I,0)=$G(TXT(I))
85 . . S DIK="^ICPT("_DA(2)_",62,"_DA(1)_",1,",DA=I D:+($G(CPIEN))>0&(+($G(IEN))>0)&(+($G(I))>0) IX1^DIK
86 K DA,DIK S DA(1)=CPIEN,DA=IEN,DIK="^ICPT("_DA(1)_",62," D:+($G(CPIEN))>0&(+($G(IEN))>0) IX1^DIK
87 Q
88C10 ; 162142 - 63044 with RT
89 ; 169057 - 63043-63044 with RT
90 D IND(" "),REMI("CPT Modifier Ranges Added for RT/LT","HD0000000 161142")
91 D REMI("CPT Modifier Ranges Added for RT/LT (similar)","HD0000000 169057")
92 D IND(" CPT Range 63040")
93 N MIEN,RIEN,VAL,NIEN
94 S VAL="63040^63040^3070101^",MIEN=83,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
95 . Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
96 . N DA,DIK S DA(1)=MIEN,DA=RIEN,DIK="^DIC(81.3,"_DA(1)_",10," D ^DIK K ^DIC(81.3,MIEN,10,RIEN,0)
97 I '$D(^DIC(81.3,MIEN,"M",63040)) D
98 . N NIEN S NIEN=$O(^DIC(81.3,MIEN,10," "),-1)+1,^DIC(81.3,MIEN,10,NIEN,0)=VAL,DA=MIEN,DIK="^DIC(81.3," D IX1^DIK
99 S VAL="63042^63044^3070101^",MIEN=83,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
100 . Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
101 . N DA,DIK S DA(1)=MIEN,DA=RIEN,DIK="^DIC(81.3,"_DA(1)_",10," D ^DIK K ^DIC(81.3,MIEN,10,RIEN,0)
102 I '$D(^DIC(81.3,MIEN,"M",63042)) D
103 . N NIEN S NIEN=$O(^DIC(81.3,MIEN,10," "),-1)+1,^DIC(81.3,MIEN,10,NIEN,0)=VAL,DA=MIEN,DIK="^DIC(81.3," D IX1^DIK
104 D IND(" CPT Range 63042-63044")
105 S VAL="63040^63040^3070101^",MIEN=109,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
106 . Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
107 . N DA,DIK S DA(1)=MIEN,DA=RIEN,DIK="^DIC(81.3,"_DA(1)_",10," D ^DIK K ^DIC(81.3,MIEN,10,RIEN,0)
108 I '$D(^DIC(81.3,MIEN,"M",63040)) D
109 . N NIEN S NIEN=$O(^DIC(81.3,MIEN,10," "),-1)+1,^DIC(81.3,MIEN,10,NIEN,0)=VAL,DA=MIEN,DIK="^DIC(81.3," D IX1^DIK
110 S VAL="63042^63044^3070101^",MIEN=109,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
111 . Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
112 . N DA,DIK S DA(1)=MIEN,DA=RIEN,DIK="^DIC(81.3,"_DA(1)_",10," D ^DIK K ^DIC(81.3,MIEN,10,RIEN,0)
113 I '$D(^DIC(81.3,MIEN,"M",63042)) D
114 . N NIEN S NIEN=$O(^DIC(81.3,MIEN,10," "),-1)+1,^DIC(81.3,MIEN,10,NIEN,0)=VAL,DA=MIEN,DIK="^DIC(81.3," D IX1^DIK
115 Q
116C11 ; 173816 - Re-Code Hyperglycemia as ICD 790.29
117 D IND(" "),REMI("Re-Code ""Hyperglycemia"" as ICD Code 790.29","HD0000000 173816")
118 N DA,DIE,DIK,EFF,EXIST,FDA,IEN,IENE,IENS,TXT
119 K FDA,IENS,IEN,DA,DIK S IEN=63620,IENS=IEN_","
120 S FDA(757.02,IENS,1)=790.29 D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.02," D IX1^DIK
121 K FDA,IENS,IEN,DA,DIK S IEN=329955,IENS=IEN_","
122 S FDA(757.01,IENS,.01)="Abnormal Glucose" D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.01," D IX1^DIK
123 Q
124 ;
125 ; Miscellaneous
126REMI(X,Y) ; Remedy Ticket - Indented
127 N I S X=$G(X),Y=$G(Y) Q:'$L(X)
128 I $L(Y) S X=" "_X F Q:$L(X)>54 S X=X_" "
129 S X=X_" "_Y S:$E(X,1)'=" " X=" "_X D MES^XPDUTL(X) Q
130IND(X) ; Indent Text
131 N I S X=$G(X) Q:'$L(X) S X=" "_X D MES^XPDUTL(X) Q
Note: See TracBrowser for help on using the repository browser.