LEX2047B ; ISL/KER - Post Install LEX*2.0*47 (part 2) ; 02/05/2007
;;2.0;LEXICON UTILITY;**47**;Sep 23, 1996;Build 5
;
; Global Variables
; ^ICPT( DBIA 4489
; ^LEX(757.01 N/A
; ^LEX(757.02 N/A
; ^DIC(81.3, DBIA 4492
;
; External References
; FILE^DIE DBIA 2053
; UPDATE^DIE DBIA 2053
; ^DIK DBIA 10013
; IX1^DIK DBIA 10013
; $$IENS^DILF DBIA 2054
; MES^XPDUTL DBIA 10141
;
EN ; Main Entry Point
D C6,C7,C8,C9,C10,C11
Q
C6 ; 161266 Canalith (HCPCS S9092) is misspelled
D IND(" "),REMI("CANALITH (S9092) is misspelled","HD0000000 161266")
D IND(" S9092 - Change CANOLITH to CANALITH")
N IENS,IENA,IENB,IEN,LEXDA,DA,DIK,DIE
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
S (IEN,DA(1),LEXDA(1))=107092,(IENA,LEXDA,DA)=$O(^ICPT(IEN,61,"B",3030101,0)) I +IEN>0,+IENA>0 D
. K IENS,FDA S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="CANALITH REPOSITIONING" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG")
S (IEN,DA(1),LEXDA(1))=107092,(IENA,LEXDA,DA)=$O(^ICPT(IEN,62,"B",3030101,0)) I +IEN>0,+IENA>0 D
. 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
. . 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
. . S IENS=$$IENS^DILF(.LEXDA),FDA(81.621,IENS,.01)="CANALITH REPOSITIONING, PER VISIT" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG")
I $D(^ICPT(107092,"D",1,0)) D
. Q:$G(^ICPT(107092,"D",1,0))'["CANOLITH REPOSITIONING, PER VISIT"
. 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)=""
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
Q
C7 ; 166892 CPT J0585 Botulinum Toxin Quantity
D IND(" "),REMI("Botulinum Toxin Quantity (J0585)","HD0000000 166892")
K IENS,FDA S (IEN,LEXDA,DA)=320347 S FDA(757.01,IEN_",",.01)="Botulinum toxin type A, per unit"
D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.01," D IX1^DIK
Q
C8 ; 168449 Lookup 038.9 returns 995.91
D IND(" "),REMI("Lookup ICD 038.9 returns 995.91","HD0000000 168449")
D REMI("Lookup ICD 038.9 returns 995.91 (dupe)","HD0000000 171316")
N FDA,DA,DIK S DA=330020
K FDA S FDA(757.02,(DA_","),6)=0 D FILE^DIE("","FDA")
K FDA S FDA(757.02,(DA_","),4)=0 D FILE^DIE("","FDA") S DA=324672
K FDA S FDA(757.02,(DA_","),6)=1 D FILE^DIE("","FDA")
K FDA S FDA(757.02,(DA_","),4)=1 D FILE^DIE("","FDA")
K FDA S FDA(757.02,(DA_","),5)="" D FILE^DIE("","FDA")
S DA(1)=324672,DA=2 I $D(^LEX(757.02,DA(1),4,DA,0)) D
. S DIK="^LEX(757.02,"_DA(1)_",4," D ^DIK
K DA S DIK="^LEX(757.02,",DA=330020 D IX1^DIK S DA=324672 D IX1^DIK
Q
C9 ; 174410 New dental code D2970
D IND(" "),REMI("New Dental Code D2970","HD0000000 174410")
N ACT,CPIEN,DA,DIC,DIE,DIK,EFF,EXIEN,EXIST,EXP,FDA,I,IEN,IENS,MSG,SOIEN,TXT S EXIEN=318447,IENS=EXIEN_","
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)"
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
K DA,DIK,DIC,FDA,IENS,ACT S SOIEN=254,ACT=3,EFF=3070101,IENS="+"_ACT_","_SOIEN_","
S EXIST=$O(^LEX(757.02,SOIEN,4,"B",EFF,0)),EXIST=$P($G(^LEX(757.02,SOIEN,4,+EXIST,0)),"^",2)
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_")"))
K DA,DIK,DIC,FDA,IENS,ACT S CPIEN=100384,EFF=3070101
S IENS=CPIEN_",",FDA(81,IENS,2)="TEMPORARY CROWN (FX TOOTH)",FDA(81,IENS,5)="",FDA(81,IENS,7)=""
S FDA(81,IENS,8)=EFF D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
K DA,DIK,DIC,FDA,IENS,ACT S ACT=3,IENS="+"_ACT_","_CPIEN_","
S EXIST=$O(^ICPT(CPIEN,60,"B",EFF,0)),EXIST=$P($G(^ICPT(CPIEN,60,+EXIST,0)),"^",2)
S FDA(81.02,IENS,.01)=EFF,FDA(81.02,IENS,.02)=1
I '$L(EXIST)!(+EXIST'>0) D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
K DA,DIK,DIC,FDA,IENS,ACT,TXT S ACT=2,IENS="+"_ACT_","_CPIEN_",",TXT="TEMPORARY CROWN (FX TOOTH)"
S EXIST=$O(^ICPT(CPIEN,61,"B",EFF,0)),EXIST=$P($G(^ICPT(CPIEN,61,+EXIST,0)),"^",2)
S FDA(81.061,IENS,.01)=EFF,FDA(81.061,IENS,1)=TXT
I '$L(EXIST) D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
K DA,DIK,DIC,FDA,IENS,ACT,TXT,IEN S ACT=2,IENS="+"_ACT_","_CPIEN_",",IEN=0
S TXT(1)="TEMPORARY CROWN (FRACTURED TOOTH), USUALLY A PREFORMED ARTIFICIAL CROWN,"
S TXT(2)="FITTED OVER A DAMAGED TOOTH AS AN IMMEDIATE PROTECTIVE DEVICE. (NOT TO"
S TXT(3)="BE USED AS A TEMPORIZATION DURING CROWN FABRICATION)"
S EXIST=$O(^ICPT(CPIEN,62,"B",EFF,0)),EXIST=$P($G(^ICPT(CPIEN,62,+EXIST,0)),"^",1)
S FDA(81.062,IENS,.01)=EFF I '$L(EXIST)!(EXIST'=EFF) D UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
S IEN=$O(^ICPT(CPIEN,62,"B",EFF,0)) I +IEN>0 D
. 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
. . S DIK="^ICPT("_DA(2)_",62,"_DA(1)_",1,",DA=I D ^DIK
. S DA(2)=CPIEN,DA(1)=IEN S I=0 F S I=$O(TXT(I)) Q:+I'>0 D
. . Q:'$L($G(TXT(I))) S ^ICPT(DA(2),62,DA(1),1,I,0)=$G(TXT(I))
. . S DIK="^ICPT("_DA(2)_",62,"_DA(1)_",1,",DA=I D:+($G(CPIEN))>0&(+($G(IEN))>0)&(+($G(I))>0) IX1^DIK
K DA,DIK S DA(1)=CPIEN,DA=IEN,DIK="^ICPT("_DA(1)_",62," D:+($G(CPIEN))>0&(+($G(IEN))>0) IX1^DIK
Q
C10 ; 162142 - 63044 with RT
; 169057 - 63043-63044 with RT
D IND(" "),REMI("CPT Modifier Ranges Added for RT/LT","HD0000000 161142")
D REMI("CPT Modifier Ranges Added for RT/LT (similar)","HD0000000 169057")
D IND(" CPT Range 63040")
N MIEN,RIEN,VAL,NIEN
S VAL="63040^63040^3070101^",MIEN=83,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
. Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
. 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)
I '$D(^DIC(81.3,MIEN,"M",63040)) D
. 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
S VAL="63042^63044^3070101^",MIEN=83,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
. Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
. 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)
I '$D(^DIC(81.3,MIEN,"M",63042)) D
. 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
D IND(" CPT Range 63042-63044")
S VAL="63040^63040^3070101^",MIEN=109,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
. Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
. 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)
I '$D(^DIC(81.3,MIEN,"M",63040)) D
. 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
S VAL="63042^63044^3070101^",MIEN=109,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
. Q:$G(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
. 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)
I '$D(^DIC(81.3,MIEN,"M",63042)) D
. 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
Q
C11 ; 173816 - Re-Code Hyperglycemia as ICD 790.29
D IND(" "),REMI("Re-Code ""Hyperglycemia"" as ICD Code 790.29","HD0000000 173816")
N DA,DIE,DIK,EFF,EXIST,FDA,IEN,IENE,IENS,TXT
K FDA,IENS,IEN,DA,DIK S IEN=63620,IENS=IEN_","
S FDA(757.02,IENS,1)=790.29 D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.02," D IX1^DIK
K FDA,IENS,IEN,DA,DIK S IEN=329955,IENS=IEN_","
S FDA(757.01,IENS,.01)="Abnormal Glucose" D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.01," D IX1^DIK
Q
;
; Miscellaneous
REMI(X,Y) ; Remedy Ticket - Indented
N I S X=$G(X),Y=$G(Y) Q:'$L(X)
I $L(Y) S X=" "_X F Q:$L(X)>54 S X=X_" "
S X=X_" "_Y S:$E(X,1)'=" " X=" "_X D MES^XPDUTL(X) Q
IND(X) ; Indent Text
N I S X=$G(X) Q:'$L(X) S X=" "_X D MES^XPDUTL(X) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2047B 8340 printed Nov 22, 2024@17:14:22 Page 2
LEX2047B ; ISL/KER - Post Install LEX*2.0*47 (part 2) ; 02/05/2007
+1 ;;2.0;LEXICON UTILITY;**47**;Sep 23, 1996;Build 5
+2 ;
+3 ; Global Variables
+4 ; ^ICPT( DBIA 4489
+5 ; ^LEX(757.01 N/A
+6 ; ^LEX(757.02 N/A
+7 ; ^DIC(81.3, DBIA 4492
+8 ;
+9 ; External References
+10 ; FILE^DIE DBIA 2053
+11 ; UPDATE^DIE DBIA 2053
+12 ; ^DIK DBIA 10013
+13 ; IX1^DIK DBIA 10013
+14 ; $$IENS^DILF DBIA 2054
+15 ; MES^XPDUTL DBIA 10141
+16 ;
EN ; Main Entry Point
+1 DO C6
DO C7
DO C8
DO C9
DO C10
DO C11
+2 QUIT
C6 ; 161266 Canalith (HCPCS S9092) is misspelled
+1 DO IND(" ")
DO REMI("CANALITH (S9092) is misspelled","HD0000000 161266")
+2 DO IND(" S9092 - Change CANOLITH to CANALITH")
+3 NEW IENS,IENA,IENB,IEN,LEXDA,DA,DIK,DIE
+4 KILL IENS,FDA
SET (IEN,DA)=329685
SET IENS=IEN_","
SET FDA(757.01,IENS,.01)="Canalith Repositioning, per visit"
DO FILE^DIE("","FDA")
SET DIK="^LEX(757.01,"
DO IX1^DIK
+5 SET (IEN,DA(1),LEXDA(1))=107092
SET (IENA,LEXDA,DA)=$ORDER(^ICPT(IEN,61,"B",3030101,0))
IF +IEN>0
IF +IENA>0
Begin DoDot:1
+6 KILL IENS,FDA
SET IENS=$$IENS^DILF(.LEXDA)
SET FDA(81.061,IENS,1)="CANALITH REPOSITIONING"
KILL IENR,MSG
DO UPDATE^DIE("","FDA","IENR","MSG")
End DoDot:1
+7 SET (IEN,DA(1),LEXDA(1))=107092
SET (IENA,LEXDA,DA)=$ORDER(^ICPT(IEN,62,"B",3030101,0))
IF +IEN>0
IF +IENA>0
Begin DoDot:1
+8 KILL IENS,FDA
NEW DA,I
SET DA(2)=LEXDA(1)
SET DA(1)=LEXDA
SET I=0
FOR
SET I=$ORDER(^ICPT(DA(2),62,DA(1),1,I))
if +I'>0
QUIT
Begin DoDot:2
+9 SET DA=I
if $GET(^ICPT(DA(2),62,DA(1),1,DA,0))'["CANOLITH REPOSITIONING, PER VISIT"
QUIT
NEW LEXDA
SET LEXDA(2)=DA(2)
SET LEXDA(1)=DA(1)
SET LEXDA=DA
+10 SET IENS=$$IENS^DILF(.LEXDA)
SET FDA(81.621,IENS,.01)="CANALITH REPOSITIONING, PER VISIT"
KILL IENR,MSG
DO UPDATE^DIE("","FDA","IENR","MSG")
End DoDot:2
End DoDot:1
+11 IF $DATA(^ICPT(107092,"D",1,0))
Begin DoDot:1
+12 if $GET(^ICPT(107092,"D",1,0))'["CANOLITH REPOSITIONING, PER VISIT"
QUIT
+13 SET ^ICPT(107092,"D",1,0)="CANALITH REPOSITIONING, PER VISIT"
KILL ^ICPT(107092,"D","B")
SET ^ICPT(107092,"D","B","CANALITH REPOSITIONING, PER VI",1)=""
End DoDot:1
+14 KILL IENS,DA,FDA
SET DA=IEN
SET FDA(81,IEN_",",2)="CANALITH REPOSITIONING"
DO FILE^DIE("","FDA")
SET DA=IEN
SET DIK="^ICPT("
DO IX1^DIK
+15 QUIT
C7 ; 166892 CPT J0585 Botulinum Toxin Quantity
+1 DO IND(" ")
DO REMI("Botulinum Toxin Quantity (J0585)","HD0000000 166892")
+2 KILL IENS,FDA
SET (IEN,LEXDA,DA)=320347
SET FDA(757.01,IEN_",",.01)="Botulinum toxin type A, per unit"
+3 DO FILE^DIE("","FDA")
SET DA=IEN
SET DIK="^LEX(757.01,"
DO IX1^DIK
+4 QUIT
C8 ; 168449 Lookup 038.9 returns 995.91
+1 DO IND(" ")
DO REMI("Lookup ICD 038.9 returns 995.91","HD0000000 168449")
+2 DO REMI("Lookup ICD 038.9 returns 995.91 (dupe)","HD0000000 171316")
+3 NEW FDA,DA,DIK
SET DA=330020
+4 KILL FDA
SET FDA(757.02,(DA_","),6)=0
DO FILE^DIE("","FDA")
+5 KILL FDA
SET FDA(757.02,(DA_","),4)=0
DO FILE^DIE("","FDA")
SET DA=324672
+6 KILL FDA
SET FDA(757.02,(DA_","),6)=1
DO FILE^DIE("","FDA")
+7 KILL FDA
SET FDA(757.02,(DA_","),4)=1
DO FILE^DIE("","FDA")
+8 KILL FDA
SET FDA(757.02,(DA_","),5)=""
DO FILE^DIE("","FDA")
+9 SET DA(1)=324672
SET DA=2
IF $DATA(^LEX(757.02,DA(1),4,DA,0))
Begin DoDot:1
+10 SET DIK="^LEX(757.02,"_DA(1)_",4,"
DO ^DIK
End DoDot:1
+11 KILL DA
SET DIK="^LEX(757.02,"
SET DA=330020
DO IX1^DIK
SET DA=324672
DO IX1^DIK
+12 QUIT
C9 ; 174410 New dental code D2970
+1 DO IND(" ")
DO REMI("New Dental Code D2970","HD0000000 174410")
+2 NEW ACT,CPIEN,DA,DIC,DIE,DIK,EFF,EXIEN,EXIST,EXP,FDA,I,IEN,IENS,MSG,SOIEN,TXT
SET EXIEN=318447
SET IENS=EXIEN_","
+3 SET 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)"
+4 KILL FDA
SET FDA(757.01,IENS,.01)=EXP
DO FILE^DIE("","FDA")
KILL DA
SET DA=EXIEN
SET DIK="^LEX(757.01,"
DO IX1^DIK
+5 KILL DA,DIK,DIC,FDA,IENS,ACT
SET SOIEN=254
SET ACT=3
SET EFF=3070101
SET IENS="+"_ACT_","_SOIEN_","
+6 SET EXIST=$ORDER(^LEX(757.02,SOIEN,4,"B",EFF,0))
SET EXIST=$PIECE($GET(^LEX(757.02,SOIEN,4,+EXIST,0)),"^",2)
+7 SET FDA(757.28,IENS,.01)=EFF
SET FDA(757.28,IENS,1)=1
IF '$LENGTH(EXIST)!(+EXIST'>0)
DO UPDATE^DIE("S","FDA",,("MSG("_SOIEN_")"))
+8 KILL DA,DIK,DIC,FDA,IENS,ACT
SET CPIEN=100384
SET EFF=3070101
+9 SET IENS=CPIEN_","
SET FDA(81,IENS,2)="TEMPORARY CROWN (FX TOOTH)"
SET FDA(81,IENS,5)=""
SET FDA(81,IENS,7)=""
+10 SET FDA(81,IENS,8)=EFF
DO UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
+11 KILL DA,DIK,DIC,FDA,IENS,ACT
SET ACT=3
SET IENS="+"_ACT_","_CPIEN_","
+12 SET EXIST=$ORDER(^ICPT(CPIEN,60,"B",EFF,0))
SET EXIST=$PIECE($GET(^ICPT(CPIEN,60,+EXIST,0)),"^",2)
+13 SET FDA(81.02,IENS,.01)=EFF
SET FDA(81.02,IENS,.02)=1
+14 IF '$LENGTH(EXIST)!(+EXIST'>0)
DO UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
+15 KILL DA,DIK,DIC,FDA,IENS,ACT,TXT
SET ACT=2
SET IENS="+"_ACT_","_CPIEN_","
SET TXT="TEMPORARY CROWN (FX TOOTH)"
+16 SET EXIST=$ORDER(^ICPT(CPIEN,61,"B",EFF,0))
SET EXIST=$PIECE($GET(^ICPT(CPIEN,61,+EXIST,0)),"^",2)
+17 SET FDA(81.061,IENS,.01)=EFF
SET FDA(81.061,IENS,1)=TXT
+18 IF '$LENGTH(EXIST)
DO UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
+19 KILL DA,DIK,DIC,FDA,IENS,ACT,TXT,IEN
SET ACT=2
SET IENS="+"_ACT_","_CPIEN_","
SET IEN=0
+20 SET TXT(1)="TEMPORARY CROWN (FRACTURED TOOTH), USUALLY A PREFORMED ARTIFICIAL CROWN,"
+21 SET TXT(2)="FITTED OVER A DAMAGED TOOTH AS AN IMMEDIATE PROTECTIVE DEVICE. (NOT TO"
+22 SET TXT(3)="BE USED AS A TEMPORIZATION DURING CROWN FABRICATION)"
+23 SET EXIST=$ORDER(^ICPT(CPIEN,62,"B",EFF,0))
SET EXIST=$PIECE($GET(^ICPT(CPIEN,62,+EXIST,0)),"^",1)
+24 SET FDA(81.062,IENS,.01)=EFF
IF '$LENGTH(EXIST)!(EXIST'=EFF)
DO UPDATE^DIE("S","FDA",,("MSG("_CPIEN_")"))
+25 SET IEN=$ORDER(^ICPT(CPIEN,62,"B",EFF,0))
IF +IEN>0
Begin DoDot:1
+26 NEW DA,DIK,I
SET DA(2)=CPIEN
SET DA(1)=IEN
SET I=0
FOR
SET I=$ORDER(^ICPT(DA(2),62,DA(1),1,I))
if +I'>0
QUIT
Begin DoDot:2
+27 SET DIK="^ICPT("_DA(2)_",62,"_DA(1)_",1,"
SET DA=I
DO ^DIK
End DoDot:2
+28 SET DA(2)=CPIEN
SET DA(1)=IEN
SET I=0
FOR
SET I=$ORDER(TXT(I))
if +I'>0
QUIT
Begin DoDot:2
+29 if '$LENGTH($GET(TXT(I)))
QUIT
SET ^ICPT(DA(2),62,DA(1),1,I,0)=$GET(TXT(I))
+30 SET DIK="^ICPT("_DA(2)_",62,"_DA(1)_",1,"
SET DA=I
if +($GET(CPIEN))>0&(+($GET(IEN))>0)&(+($GET(I))>0)
DO IX1^DIK
End DoDot:2
End DoDot:1
+31 KILL DA,DIK
SET DA(1)=CPIEN
SET DA=IEN
SET DIK="^ICPT("_DA(1)_",62,"
if +($GET(CPIEN))>0&(+($GET(IEN))>0)
DO IX1^DIK
+32 QUIT
C10 ; 162142 - 63044 with RT
+1 ; 169057 - 63043-63044 with RT
+2 DO IND(" ")
DO REMI("CPT Modifier Ranges Added for RT/LT","HD0000000 161142")
+3 DO REMI("CPT Modifier Ranges Added for RT/LT (similar)","HD0000000 169057")
+4 DO IND(" CPT Range 63040")
+5 NEW MIEN,RIEN,VAL,NIEN
+6 SET VAL="63040^63040^3070101^"
SET MIEN=83
SET RIEN=0
FOR
SET RIEN=$ORDER(^DIC(81.3,MIEN,10,RIEN))
if +RIEN'>0
QUIT
Begin DoDot:1
+7 if $GET(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
QUIT
+8 NEW DA,DIK
SET DA(1)=MIEN
SET DA=RIEN
SET DIK="^DIC(81.3,"_DA(1)_",10,"
DO ^DIK
KILL ^DIC(81.3,MIEN,10,RIEN,0)
End DoDot:1
+9 IF '$DATA(^DIC(81.3,MIEN,"M",63040))
Begin DoDot:1
+10 NEW NIEN
SET NIEN=$ORDER(^DIC(81.3,MIEN,10," "),-1)+1
SET ^DIC(81.3,MIEN,10,NIEN,0)=VAL
SET DA=MIEN
SET DIK="^DIC(81.3,"
DO IX1^DIK
End DoDot:1
+11 SET VAL="63042^63044^3070101^"
SET MIEN=83
SET RIEN=0
FOR
SET RIEN=$ORDER(^DIC(81.3,MIEN,10,RIEN))
if +RIEN'>0
QUIT
Begin DoDot:1
+12 if $GET(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
QUIT
+13 NEW DA,DIK
SET DA(1)=MIEN
SET DA=RIEN
SET DIK="^DIC(81.3,"_DA(1)_",10,"
DO ^DIK
KILL ^DIC(81.3,MIEN,10,RIEN,0)
End DoDot:1
+14 IF '$DATA(^DIC(81.3,MIEN,"M",63042))
Begin DoDot:1
+15 NEW NIEN
SET NIEN=$ORDER(^DIC(81.3,MIEN,10," "),-1)+1
SET ^DIC(81.3,MIEN,10,NIEN,0)=VAL
SET DA=MIEN
SET DIK="^DIC(81.3,"
DO IX1^DIK
End DoDot:1
+16 DO IND(" CPT Range 63042-63044")
+17 SET VAL="63040^63040^3070101^"
SET MIEN=109
SET RIEN=0
FOR
SET RIEN=$ORDER(^DIC(81.3,MIEN,10,RIEN))
if +RIEN'>0
QUIT
Begin DoDot:1
+18 if $GET(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
QUIT
+19 NEW DA,DIK
SET DA(1)=MIEN
SET DA=RIEN
SET DIK="^DIC(81.3,"_DA(1)_",10,"
DO ^DIK
KILL ^DIC(81.3,MIEN,10,RIEN,0)
End DoDot:1
+20 IF '$DATA(^DIC(81.3,MIEN,"M",63040))
Begin DoDot:1
+21 NEW NIEN
SET NIEN=$ORDER(^DIC(81.3,MIEN,10," "),-1)+1
SET ^DIC(81.3,MIEN,10,NIEN,0)=VAL
SET DA=MIEN
SET DIK="^DIC(81.3,"
DO IX1^DIK
End DoDot:1
+22 SET VAL="63042^63044^3070101^"
SET MIEN=109
SET RIEN=0
FOR
SET RIEN=$ORDER(^DIC(81.3,MIEN,10,RIEN))
if +RIEN'>0
QUIT
Begin DoDot:1
+23 if $GET(^DIC(81.3,MIEN,10,RIEN,0))'=VAL
QUIT
+24 NEW DA,DIK
SET DA(1)=MIEN
SET DA=RIEN
SET DIK="^DIC(81.3,"_DA(1)_",10,"
DO ^DIK
KILL ^DIC(81.3,MIEN,10,RIEN,0)
End DoDot:1
+25 IF '$DATA(^DIC(81.3,MIEN,"M",63042))
Begin DoDot:1
+26 NEW NIEN
SET NIEN=$ORDER(^DIC(81.3,MIEN,10," "),-1)+1
SET ^DIC(81.3,MIEN,10,NIEN,0)=VAL
SET DA=MIEN
SET DIK="^DIC(81.3,"
DO IX1^DIK
End DoDot:1
+27 QUIT
C11 ; 173816 - Re-Code Hyperglycemia as ICD 790.29
+1 DO IND(" ")
DO REMI("Re-Code ""Hyperglycemia"" as ICD Code 790.29","HD0000000 173816")
+2 NEW DA,DIE,DIK,EFF,EXIST,FDA,IEN,IENE,IENS,TXT
+3 KILL FDA,IENS,IEN,DA,DIK
SET IEN=63620
SET IENS=IEN_","
+4 SET FDA(757.02,IENS,1)=790.29
DO FILE^DIE("","FDA")
SET DA=IEN
SET DIK="^LEX(757.02,"
DO IX1^DIK
+5 KILL FDA,IENS,IEN,DA,DIK
SET IEN=329955
SET IENS=IEN_","
+6 SET FDA(757.01,IENS,.01)="Abnormal Glucose"
DO FILE^DIE("","FDA")
SET DA=IEN
SET DIK="^LEX(757.01,"
DO IX1^DIK
+7 QUIT
+8 ;
+9 ; Miscellaneous
REMI(X,Y) ; Remedy Ticket - Indented
+1 NEW I
SET X=$GET(X)
SET Y=$GET(Y)
if '$LENGTH(X)
QUIT
+2 IF $LENGTH(Y)
SET X=" "_X
FOR
if $LENGTH(X)>54
QUIT
SET X=X_" "
+3 SET X=X_" "_Y
if $EXTRACT(X,1)'=" "
SET X=" "_X
DO MES^XPDUTL(X)
QUIT
IND(X) ; Indent Text
+1 NEW I
SET X=$GET(X)
if '$LENGTH(X)
QUIT
SET X=" "_X
DO MES^XPDUTL(X)
QUIT
