LEX2047A ; ISL/KER - Post Install LEX*2.0*47 ; 02/05/2007 ;;2.0;LEXICON UTILITY;**47**;Sep 23, 1996;Build 5 ; ; Global Variables ; ^ICPT( DBIA 4489 ; ^DIC(81.3, DBIA 4492 ; ; External References ; FILE^DIE DBIA 2053 ; UPDATE^DIE DBIA 2053 ; IX1^DIK DBIA 10013 ; $$IENS^DILF DBIA 2054 ; $$CODEN^ICPTCOD DBIA 1995 ; $$CPT^ICPTCOD DBIA 1995 ; $$MOD^ICPTMOD DBIA 1996 ; $$DT^XLFDT DBIA 10103 ; $$FMADD^XLFDT DBIA 10103 ; MES^XPDUTL DBIA 10141 ; EN ; Main Entry Point D C1,C2,C3,C4,C5,EN^LEX2047B Q ; ; Changes C1 ; 123616 - 99212/G0245 with A8, AA, QY and 57 D IND(" "),REMI("CPT Modifier Ranges Added for A8/AA/QY/57","HD0000000 123616") N CODE,PRO,MOD,MT,VDT K SHOWSTA S CODE="99212",VDT=3050101,PRO=$P($$CPT^ICPTCOD(CODE,(VDT+1)),"^",3) F MOD="A8","AA","QY","57" D . D:MOD="A8" IND((" CPT Range "_CODE)) . N ACR,PRO,MT,ND,NN,DA,DIK,MIEN S ACR=$$ACR(CODE,MOD,VDT) Q:+ACR>0 . S MT=$$MOD^ICPTMOD(MOD,"E",(VDT+1)) . S MIEN=+MT,MT=$P(MT,"^",3) Q:+MIEN'>0 S DA=$O(^DIC(81.3,+MIEN,10," "),-1)+1 Q:+DA'>1 . S DA(1)=MIEN,DIK="^DIC(81.3,"_DA(1)_",10," . S NN=CODE_"^"_CODE_"^"_VDT_"^",ND=DIK_DA_",0)" . S @ND=NN D IX1^DIK S CODE="G0245",PRO=$P($$CPT^ICPTCOD(CODE,(VDT+1)),"^",3) F MOD="A8","AA","QY","57" D . D:MOD="A8" IND((" CPT Range "_CODE)) . N ACR,PRO,MT,ND,NN,DA,DIK,MIEN S ACR=$$ACR(CODE,MOD,VDT) Q:+ACR>0 . S MT=$$MOD^ICPTMOD(MOD,"E",(VDT+1)) . S MIEN=+MT,MT=$P(MT,"^",3) Q:+MIEN'>0 S DA=$O(^DIC(81.3,+MIEN,10," "),-1)+1 Q:+DA'>1 . S DA(1)=MIEN,DIK="^DIC(81.3,"_DA(1)_",10," . S NN=CODE_"^"_CODE_"^"_VDT_"^",ND=DIK_DA_",0)" . S @ND=NN D IX1^DIK Q C2 ; 174408 CPT Modifier Ranges Added for TC/26 D IND(" "),REMI("CPT Modifier Ranges Added for TC/26","HD0000000 174408") N I,VDT,RANGE S I=0,VDT=3070101,RANGE="" F D Q:'$L($G(RANGE)) . N EXEC,CODE,END,MIEN1,MIEN2,MOD,DA,DIK,ND,NN,ACR . S I=I+1,EXEC="S RANGE=$T(TC26+"_I_")" X EXEC . S RANGE=$P(RANGE,";;",2,299) Q:'$L(RANGE) I '$L($TR($TR(RANGE,";","")," ","")) S RANGE="" Q . S CODE=$P(RANGE,";",1),END=$P(RANGE,";",2) Q:$L(CODE)'=5!($L(END)'=5) . S MIEN1=$P(RANGE,";",3),MIEN2=$P(RANGE,";",4) Q:+MIEN1'>0 Q:+MIEN2'>0 . D IND((" CPT Range "_CODE)) . S MOD="TC",DA(1)=35,DA=MIEN1,DIK="^DIC(81.3,"_DA(1)_",10,",ND=DIK_DA_",0)",NN=CODE_"^"_END_"^"_VDT_"^" . S ACR=$$ACR(CODE,MOD,(VDT+1)) I +ACR'>0 S @ND=NN D IX1^DIK . S MOD="26",DA(1)=7,DA=MIEN2,DIK="^DIC(81.3,"_DA(1)_",10,",ND=DIK_DA_",0)",NN=CODE_"^"_END_"^"_VDT_"^" . S ACR=$$ACR(CODE,MOD,(VDT+1)) I +ACR'>0 S @ND=NN D IX1^DIK Q ; C3 ; 134531 - CPT Descriptions for 83519 and 83520 D IND(" "),REMI("CPT Descriptions for 83519 and 83520","HD0000000 134531") D IND(" 83519 - IMMUNOASSAY, RIA") D IND(" 83520 - IMMUNOASSAY, NONANTIBODY") N IENS,IENA,IENB,IEN,LEXDA,DA,DIK,DIE S IENA=$O(^ICPT(83519,61,"B",2940601,0)),IENB=$O(^ICPT(83520,61,"B",2940601,0)) Q:IENA'>0 Q:IENB'>0 K IENS,FDA S (IEN,LEXDA(1),DA(1))=83519,(LEXDA,DA)=IENA S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="IMMUNOASSAY, RIA" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG") K FDA S FDA(81,IEN_",",2)="IMMUNOASSAY, RIA" D FILE^DIE("","FDA") S DA=IEN,DIK="^ICPT(" D IX1^DIK K IENS,FDA S (IEN,LEXDA(1),DA(1))=83520,(LEXDA,DA)=IENB S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="IMMUNOASSAY, NONANTIBODY" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG") K FDA S FDA(81,IEN_",",2)="IMMUNOASSAY, NONANTIBODY" D FILE^DIE("","FDA") S DA=IEN,DIK="^ICPT(" D IX1^DIK K IENS,FDA S (IEN,LEXDA,DA)=301847 S FDA(757.01,IEN_",",.01)="Immunoassay, Analyte, Quantitative; by Radiopharmaceutical Technique (eg, RIA)" D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.01," D IX1^DIK Q C4 ; 134531 - CPT Descriptions for 82270 and 82271 D IND(" "),REMI("CPT Descriptions for 82270 and 82271","HD0000000 134531") D IND(" 82270 - OCCULT BLOOD, FECES, SINGLE") D IND(" 82271 - OCCULT BLOOD, OTHER SOURCES") N IENS,IENA,IENB,IEN,LEXDA,DA,DIK,DIE S IENA=$O(^ICPT(82270,61,"B",3060101,0)),IENB=$O(^ICPT(82271,61,"B",3060101,0)) Q:IENA'>0 Q:IENB'>0 K IENS,FDA S (IEN,LEXDA(1),DA(1))=82270,(LEXDA,DA)=IENA S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="OCCULT BLOOD, FECES, SINGLE" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG") K FDA S FDA(81,IEN_",",2)="OCCULT BLOOD, FECES, SINGLE" D FILE^DIE("","FDA") S DA=IEN,DIK="^ICPT(" D IX1^DIK K IENS,FDA S (IEN,LEXDA,DA)=333338 S FDA(757.01,(IEN_","),.01)="Blood, Occult, by Peroxidase Activity (Eg, Guaiac), Qualitative; Feces, consec collected specimens w/ Single Determination, for Colorectal Neoplasm Screening" S FDA(757.01,(IEN_","),.01)=FDA(757.01,(IEN_","),.01)_" (ie, patient was provided 3 cards or single triple card for consec collection)" D FILE^DIE("","FDA") S DA=IEN,DIK="^LEX(757.01," D IX1^DIK K IENS,FDA S (IEN,LEXDA(1),DA(1))=82271,(LEXDA,DA)=IENB S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="OCCULT BLOOD, OTHER SOURCES" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG") K FDA S FDA(81,IEN_",",2)="OCCULT BLOOD, OTHER SOURCES" D FILE^DIE("","FDA") S DA=IEN,DIK="^ICPT(" D IX1^DIK Q C5 ; 138905 - CPT Descriptions for 96101-96103 D IND(" "),REMI("CPT Descriptions for 96101-96103","HD0000000 138905") D IND(" 96101 - PSYCH TESTING BY PSYCH/PHYS") D IND(" 96102 - PSYCH TESTING BY TECHNICIAN") D IND(" 96103 - PSYCH TESTING ADMIN BY COMP") N IENS,IENA,IENB,IEN,LEXDA,DA,DIK,DIE S (IEN,DA(1),LEXDA(1))=96101,(IENA,LEXDA,DA)=$O(^ICPT(IEN,61,"B",3060101,0)) I +IEN>0,+IENA>0 D . K IENS,FDA S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="PSYCH TESTING BY PSYCH/PHYS" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG") . K IENS,DA,FDA S DA=IEN S FDA(81,IEN_",",2)="PSYCH TESTING BY PSYCH/PHYS" D FILE^DIE("","FDA") . K DA S DA=IEN,DIK="^ICPT(" D IX1^DIK S (IEN,DA(1),LEXDA(1))=96102,(IENA,LEXDA,DA)=$O(^ICPT(IEN,61,"B",3060101,0)) I +IEN>0,+IENA>0 D . K IENS,FDA S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="PSYCH TESTING BY TECHNICIAN" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG") . K IENS,DA,FDA S DA=IEN S FDA(81,IEN_",",2)="PSYCH TESTING BY TECHNICIAN" D FILE^DIE("","FDA") . K DA S DA=IEN,DIK="^ICPT(" D IX1^DIK S (IEN,DA(1),LEXDA(1))=96103,(IENA,LEXDA,DA)=$O(^ICPT(IEN,61,"B",3060101,0)) I +IEN>0,+IENA>0 D . K IENS,FDA S IENS=$$IENS^DILF(.LEXDA),FDA(81.061,IENS,1)="PSYCH TESTING ADMIN BY COMP" K IENR,MSG D UPDATE^DIE("","FDA","IENR","MSG") . K IENS,DA,FDA S DA=IEN S FDA(81,IEN_",",2)="PSYCH TESTING ADMIN BY COMP" D FILE^DIE("","FDA") . K DA S DA=IEN,DIK="^ICPT(" D IX1^DIK Q ; ; Miscellaneous TC26 ; Modifiers TC and 26 Ranges ;;76998;76998;248;163 ;;77001;77003;249;164 ;;77011;77014;250;165 ;;77021;77022;251;166 ;;77031;77032;252;167 ;;77051;77059;253;168 ;;77072;77084;254;169 ;;92025;92025;255;170 ;;96020;96020;256;171 ;;G0389;G0389;257;172 ;; Q ACR(X,MOD,EFF) ; Code contained in Active Modifier Code Range N CODE S CODE=$G(X),MOD=$G(MOD),EFF=$G(EFF) N TD,CIEN,MIEN,RIEN,IEN,IEN2,BEG,END,BN,EN,CN,ACT,INA,IN,OK,NIEN,ND,NN S TD=$$FMADD^XLFDT($$DT^XLFDT,91) Q:'$D(^ICPT("BA",(CODE_" "))) -1 Q:'$D(^DIC(81.3,"BA",(MOD_" "))) -1 Q:EFF'?7N -1 Q:EFF'0 D . N IEN2,STA,ND S IEN2=$O(^DIC(81.3,IEN,60,"B"," "),-1),IEN2=$O(^DIC(81.3,IEN,60,"B",+IEN2," "),-1) . S ND=$G(^DIC(81.3,IEN,60,IEN2,0)),STA=$P(ND,"^",2) Q:+STA'>0 S MIEN=IEN Q:CIEN'>0 -1 Q:'$D(^ICPT(CIEN,0)) -1 Q:MIEN'>0 -1 Q:'$D(^DIC(81.3,MIEN,0)) -1 S (OK,IEN,IN)=0 F S IEN=$O(^DIC(81.3,MIEN,10,IEN)) Q:+IEN=0 D Q:OK . N ND S ND=$G(^DIC(81.3,MIEN,10,IEN,0)),BEG=$P(ND,"^",1),END=$P(ND,"^",2),ACT=$P(ND,"^",3),INA=$P(ND,"^",4) . S:$L(BEG)=5&('$L(END)) END=BEG Q:$L(END)'=5 Q:$L(BEG)'=5 . S BN=$S(BEG?1.N:+BEG,BEG?4N1A:$A($E(BEG,5))*10_$E(BEG,1,4),1:$A(BEG)_$E(BEG,2,5)) . S EN=$S(END?1.N:+END,END?4N1A:$A($E(END,5))*10_$E(END,1,4),1:$A(END)_$E(END,2,5)) . S CN=$S(CODE?1.N:+CODE,CODE?4N1A:$A($E(CODE,5))*10_$E(CODE,1,4),1:$A(CODE)_$E(CODE,2,5)) . Q:CNEN) S:+INA>0 IN=1 Q:+INA>0 S:CN'EN) OK=1 S X=OK Q X 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