LEXQCMA ;ISL/KER - Query - CPT Modifiers - Ask ;10/30/2008
;;2.0;LEXICON UTILITY;**62**;Sep 23, 1996;Build 16
;
; Global Variables
; ^DIC(81.3 ICR 4492
;
; External References
; ^DIC ICR 10006
; ^DIR ICR 10026
; $$MOD^ICPTMOD ICR 1996
; $$DT^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
;
; Local Variables NEWed or KILLed Elsewhere
; LEXCDT Code Set Date
; LEXEXIT Exit Flag
; LEXMOD CPT Modifier IEN^Text
;
Q
MOD(X) ; CPT Modifier Code
Q:+($G(LEXEXIT))>0 "^^" N DIC,DTOUT,DUOUT,LEXMD,LEXSO,LEXDTXT,LEXVTXT,LEXVDT,Y,ICPTVDT S:$G(LEXCDT)?7N ICPTVDT=$G(LEXCDT)
S DIC(0)="AEQMZ",DIC="^DIC(81.3,",DIC("A")=" Select a CPT Modifier code: ",DIC("S")="I +($$OK^LEXQCMA(+($G(Y))))>0" W !
D ^DIC S:$G(X)["^^"!($D(DTOUT)) LEXEXIT=1 Q:$G(X)["^^"!(+($G(LEXEXIT))>0) "^^"
Q:$G(X)="^" "^" Q:$G(X)["^^" "^^" Q:$D(DTOUT)!($D(DUOUT)) "^" S LEXSO=$P($G(Y),"^",2) S X="" I +Y>0,$L(LEXSO) D
. S LEXVDT=$G(LEXCDT) S:LEXVDT'?7N LEXVDT=$$DT^XLFDT S X=Y,LEXDTXT=$P($G(Y(0)),"^",2),LEXMD=$$MOD^ICPTMOD(+Y,"I",LEXVDT)
. S:$L($G(LEXDTXT)) LEXDTXT=LEXDTXT_" (Text not Versioned)" S LEXVTXT=$P(LEXMD,"^",3) S:'$L(LEXVTXT) LEXVTXT=LEXDTXT
. S X=+Y_"^"_LEXSO S:$L(LEXVTXT) X=X_"^"_LEXVTXT
S X=$$UP^XLFSTR(X) Q:'$L(X) "^"
Q X
OK(X) ; Screen for Modifier Lookup
N LEXE,LEXH,LEXI,LEXIEN,LEXLA,LEXLAI,LEXLE,LEXLI,LEXM,LEXR,LEXS,LEXX S LEXIEN=+($G(X)),LEXM=$P($G(^DIC(81.3,+LEXIEN,0)),"^",1) Q:'$L(LEXM) 0
N LEXX,LEXI K LEXX S LEXI=0 F S LEXI=$O(^DIC(81.3,"B",LEXM,LEXI)) Q:+LEXI'>0 D
. Q:$P($G(^DIC(81.3,+LEXI,0)),"^",4)="V" N LEXR,LEXH,LEXE,LEXS S LEXR=$S($O(^DIC(81.3,+LEXI,10,0))>0:1,1:0)
. S:'$D(LEXX(+LEXI)) LEXX(0)=+($G(LEXX(0)))+1 S LEXX(+LEXI)=LEXM_"^"_LEXR
. M LEXX(LEXI,60)=^DIC(81.3,+LEXI,60) K LEXX(LEXI,60,"B") S LEXH=0 F S LEXH=$O(LEXX(LEXI,60,LEXH)) Q:+LEXH'>0 D
. . N LEXE,LEXS S LEXE=$G(LEXX(LEXI,60,LEXH,0)),LEXS=$P(LEXE,"^",2),LEXE=$P(LEXE,"^",1) Q:'$L(LEXS) Q:'$L(LEXE)
. . S:+LEXS>0 LEXX("A",LEXE,LEXI)=LEXI,LEXX("S",LEXI,1)="" S:+LEXS'>0 LEXX("I",LEXE,LEXI)=LEXI,LEXX("S",LEXI,0)=""
S LEXE=0 F S LEXE=$O(LEXX("S",LEXE)) Q:+LEXE'>0 S:$D(LEXX("S",LEXE,1))&('$D(LEXX("S",LEXE,0))) LEXX("SA",LEXE)=""
Q:+($G(LEXX(0)))'>1&($D(LEXX(+LEXIEN))) 1 Q:$L($O(LEXX("SA",0)))&($O(LEXX("SA",0))=$O(LEXX("SA"," "),-1))&($D(LEXX("SA",+LEXIEN))) 1
Q:$L($O(LEXX("SA",0)))&($O(LEXX("SA",0))=$O(LEXX("SA"," "),-1))&('$D(LEXX("SA",+LEXIEN))) 0 S LEXLA=$O(LEXX("A"," "),-1)
S LEXLAI=$O(LEXX("A",+LEXLA," "),-1),LEXLI=$O(LEXX("I"," "),-1),LEXLE="" S:LEXLA>0&(LEXLA=LEXLI) LEXLE=$O(LEXX("A",LEXLA," "),-1)
S:LEXLI>0&(LEXLA<LEXLI) LEXLE=$O(LEXX("I",LEXLI," "),-1) S:LEXLA>0&(LEXLA>LEXLI) LEXLE=$O(LEXX("A",LEXLA," "),-1)
Q:+LEXLE'=+LEXIEN 0
Q 1
;
INC(X) ; Include CPT Modifier Ranges
Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQCMA","INC",+($G(DUZ)),"Include Modifier Ranges") S:'$L(DIRB) DIRB="Yes"
S DIR(0)="YAO",DIR("A")=" Include Modifier CPT Code Ranges? (Y/N) " S:"^YES^NO^Yes^No^"[("^"_DIRB_"^") DIR("B")=DIRB
S DIR("PRE")="S:X[""?"" X=""??""" S (DIR("?"),DIR("??"))="^D INCH^LEXQCMA"
W ! D ^DIR S:X["^^"!($D(DIROUT)) LEXEXIT=1 Q:X["^^"!(+($G(LEXEXIT))>0) "^^" Q:$D(DIRUT)!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) "^" S DIRB=$S(Y=1:"Yes",Y=0:"No",X["^":"",1:"")
D:$L(DIRB) SAV^LEXQD("LEXQCMA","INC",+($G(DUZ)),"Include Modifier Ranges",$G(DIRB)) S X=+Y
Q X
INCH ; Include CPT Modifier Ranges Help
I $L($P($G(LEXMOD),"^",2)),$L($G(LEXCDT)) D Q
. W !,?5,"Answer 'Yes' to include the CPT Code Ranges for for CPT"
. W !,?5,"Modifier code ",$P($G(LEXMOD),"^",2),". Answer 'No' to exlcude CPT Code Ranges"
. W !,?5,"from the display."
W !,?5,"Answer 'Yes' to include the CPT Code Ranges for the CPT"
W !,?5,"Modifier. Answer 'No' to exclude CPT Code Ranges from the"
W !,?5,"display."
Q
;
INCI(X) ; Include Inactive CPT Modifier Ranges
Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQCMA","INCI",+($G(DUZ)),"Include Inactive Modifier Ranges") S:'$L(DIRB) DIRB="Yes"
S DIR(0)="YAO",DIR("A")=" Include 'Inactive' Modifier CPT Code Ranges? (Y/N) " S:"^YES^NO^Yes^No^"[("^"_DIRB_"^") DIR("B")=DIRB
S DIR("B")="No" S DIR("PRE")="S:X[""?"" X=""??""" S (DIR("?"),DIR("??"))="^D INCIH^LEXQCMA"
W ! D ^DIR S:X["^^" LEXEXIT=1!($D(DTOUT)) Q:X["^^"!(+($G(LEXEXIT))>0) "^^" Q:$D(DIRUT)!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) "^" S DIRB=$S(Y=1:"Yes",Y=0:"No",X["^":"",1:"")
D:$L(DIRB) SAV^LEXQD("LEXQCMA","INCI",+($G(DUZ)),"Include Inactive Modifier Ranges",$G(DIRB)) S X=+Y
Q X
INCIH ; Include Inactive CPT Modifier Ranges Help
I $L($P($G(LEXMOD),"^",2)),$G(LEXCDT)?7N D Q
. W !,?5,"Answer 'Yes' to include both Active and Inactive CPT Code"
. W !,?5,"Ranges for the CPT Modifier ",$P($G(LEXMOD),"^",2),". Answer 'No' to include"
. W !,?5,"only the Active CPT Code Ranges that were active for the "
. W !,?5,"CPT Modifier ",$P($G(LEXMOD),"^",2)," on ",$$SD($G(LEXCDT)),"."
W !,?5,"Answer 'Yes' to include both Active and Inactive CPT Code "
W !,?5,"Ranges for the selected CPT Modifier. Answer 'No' to "
W !,?5,"include only the Active CPT Code Ranges for the selected"
W !,?5,"CPT Modifier."
Q
;
INCF(X) ; Include Future CPT Modifier Ranges
Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQCMA","INCF",+($G(DUZ)),"Include Future Modifier Ranges") S:'$L(DIRB) DIRB="Yes"
S DIR(0)="YAO",DIR("A")=" Include 'Future Active' Modifier CPT Code Ranges? (Y/N) " S:"^YES^NO^Yes^No^"[("^"_DIRB_"^") DIR("B")=DIRB
S DIR("B")="No" S DIR("PRE")="S:X[""?"" X=""??""" S (DIR("?"),DIR("??"))="^D INCFH^LEXQCMA"
W ! D ^DIR S:X["^^"!($D(DTOUT)) LEXEXIT=1 Q:X["^^"!(+($G(LEXEXIT))>0) "^^" Q:$D(DIRUT)!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) "^" S DIRB=$S(Y=1:"Yes",Y=0:"No",X["^":"",1:"")
D:$L(DIRB) SAV^LEXQD("LEXQCMA","INCF",+($G(DUZ)),"Include Future Modifier Ranges",$G(DIRB)) S X=+Y
Q X
INCFH ; Include Future CPT Modifier Ranges Help
I $G(LEXCDT)?7N D Q
. W !,?5,"Answer 'Yes' to include CPT Code Ranges that become Active"
. W !,?5,"on or after ",$$SD($G(LEXCDT)),". Answer 'No' to exclude CPT Code"
. W !,?5,"Ranges activated in the future."
W !,?5,"Answer 'Yes' to include CPT Code Ranges that become Active"
W !,?5,"in the future. Answer 'No' to to exclude CPT Code Ranges"
W !,?5,"activated in the future."
Q
;
SD(X) ; Short Date
Q $TR($$FMTE^XLFDT(+($G(X)),"5DZ"),"@"," ")
CLR ; Clear
N LEXCDT,LEXEXIT,LEXMOD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXQCMA 6792 printed Dec 13, 2024@02:08:29 Page 2
LEXQCMA ;ISL/KER - Query - CPT Modifiers - Ask ;10/30/2008
+1 ;;2.0;LEXICON UTILITY;**62**;Sep 23, 1996;Build 16
+2 ;
+3 ; Global Variables
+4 ; ^DIC(81.3 ICR 4492
+5 ;
+6 ; External References
+7 ; ^DIC ICR 10006
+8 ; ^DIR ICR 10026
+9 ; $$MOD^ICPTMOD ICR 1996
+10 ; $$DT^XLFDT ICR 10103
+11 ; $$FMTE^XLFDT ICR 10103
+12 ; $$UP^XLFSTR ICR 10104
+13 ;
+14 ; Local Variables NEWed or KILLed Elsewhere
+15 ; LEXCDT Code Set Date
+16 ; LEXEXIT Exit Flag
+17 ; LEXMOD CPT Modifier IEN^Text
+18 ;
+19 QUIT
MOD(X) ; CPT Modifier Code
+1 if +($GET(LEXEXIT))>0
QUIT "^^"
NEW DIC,DTOUT,DUOUT,LEXMD,LEXSO,LEXDTXT,LEXVTXT,LEXVDT,Y,ICPTVDT
if $GET(LEXCDT)?7N
SET ICPTVDT=$GET(LEXCDT)
+2 SET DIC(0)="AEQMZ"
SET DIC="^DIC(81.3,"
SET DIC("A")=" Select a CPT Modifier code: "
SET DIC("S")="I +($$OK^LEXQCMA(+($G(Y))))>0"
WRITE !
+3 DO ^DIC
if $GET(X)["^^"!($DATA(DTOUT))
SET LEXEXIT=1
if $GET(X)["^^"!(+($GET(LEXEXIT))>0)
QUIT "^^"
+4 if $GET(X)="^"
QUIT "^"
if $GET(X)["^^"
QUIT "^^"
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT "^"
SET LEXSO=$PIECE($GET(Y),"^",2)
SET X=""
IF +Y>0
IF $LENGTH(LEXSO)
Begin DoDot:1
+5 SET LEXVDT=$GET(LEXCDT)
if LEXVDT'?7N
SET LEXVDT=$$DT^XLFDT
SET X=Y
SET LEXDTXT=$PIECE($GET(Y(0)),"^",2)
SET LEXMD=$$MOD^ICPTMOD(+Y,"I",LEXVDT)
+6 if $LENGTH($GET(LEXDTXT))
SET LEXDTXT=LEXDTXT_" (Text not Versioned)"
SET LEXVTXT=$PIECE(LEXMD,"^",3)
if '$LENGTH(LEXVTXT)
SET LEXVTXT=LEXDTXT
+7 SET X=+Y_"^"_LEXSO
if $LENGTH(LEXVTXT)
SET X=X_"^"_LEXVTXT
End DoDot:1
+8 SET X=$$UP^XLFSTR(X)
if '$LENGTH(X)
QUIT "^"
+9 QUIT X
OK(X) ; Screen for Modifier Lookup
+1 NEW LEXE,LEXH,LEXI,LEXIEN,LEXLA,LEXLAI,LEXLE,LEXLI,LEXM,LEXR,LEXS,LEXX
SET LEXIEN=+($GET(X))
SET LEXM=$PIECE($GET(^DIC(81.3,+LEXIEN,0)),"^",1)
if '$LENGTH(LEXM)
QUIT 0
+2 NEW LEXX,LEXI
KILL LEXX
SET LEXI=0
FOR
SET LEXI=$ORDER(^DIC(81.3,"B",LEXM,LEXI))
if +LEXI'>0
QUIT
Begin DoDot:1
+3 if $PIECE($GET(^DIC(81.3,+LEXI,0)),"^",4)="V"
QUIT
NEW LEXR,LEXH,LEXE,LEXS
SET LEXR=$SELECT($ORDER(^DIC(81.3,+LEXI,10,0))>0:1,1:0)
+4 if '$DATA(LEXX(+LEXI))
SET LEXX(0)=+($GET(LEXX(0)))+1
SET LEXX(+LEXI)=LEXM_"^"_LEXR
+5 MERGE LEXX(LEXI,60)=^DIC(81.3,+LEXI,60)
KILL LEXX(LEXI,60,"B")
SET LEXH=0
FOR
SET LEXH=$ORDER(LEXX(LEXI,60,LEXH))
if +LEXH'>0
QUIT
Begin DoDot:2
+6 NEW LEXE,LEXS
SET LEXE=$GET(LEXX(LEXI,60,LEXH,0))
SET LEXS=$PIECE(LEXE,"^",2)
SET LEXE=$PIECE(LEXE,"^",1)
if '$LENGTH(LEXS)
QUIT
if '$LENGTH(LEXE)
QUIT
+7 if +LEXS>0
SET LEXX("A",LEXE,LEXI)=LEXI
SET LEXX("S",LEXI,1)=""
if +LEXS'>0
SET LEXX("I",LEXE,LEXI)=LEXI
SET LEXX("S",LEXI,0)=""
End DoDot:2
End DoDot:1
+8 SET LEXE=0
FOR
SET LEXE=$ORDER(LEXX("S",LEXE))
if +LEXE'>0
QUIT
if $DATA(LEXX("S",LEXE,1))&('$DATA(LEXX("S",LEXE,0)))
SET LEXX("SA",LEXE)=""
+9 if +($GET(LEXX(0)))'>1&($DATA(LEXX(+LEXIEN)))
QUIT 1
if $LENGTH($ORDER(LEXX("SA",0)))&($ORDER(LEXX("SA",0))=$ORDER(LEXX("SA"," "),-1))&($DATA(LEXX("SA",+LEXIEN)))
QUIT 1
+10 if $LENGTH($ORDER(LEXX("SA",0)))&($ORDER(LEXX("SA",0))=$ORDER(LEXX("SA"," "),-1))&('$DATA(LEXX("SA",+LEXIEN)))
QUIT 0
SET LEXLA=$ORDER(LEXX("A"," "),-1)
+11 SET LEXLAI=$ORDER(LEXX("A",+LEXLA," "),-1)
SET LEXLI=$ORDER(LEXX("I"," "),-1)
SET LEXLE=""
if LEXLA>0&(LEXLA=LEXLI)
SET LEXLE=$ORDER(LEXX("A",LEXLA," "),-1)
+12 if LEXLI>0&(LEXLA<LEXLI)
SET LEXLE=$ORDER(LEXX("I",LEXLI," "),-1)
if LEXLA>0&(LEXLA>LEXLI)
SET LEXLE=$ORDER(LEXX("A",LEXLA," "),-1)
+13 if +LEXLE'=+LEXIEN
QUIT 0
+14 QUIT 1
+15 ;
INC(X) ; Include CPT Modifier Ranges
+1 if +($GET(LEXEXIT))>0
QUIT "^^"
NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB
SET DIRB=$$RET^LEXQD("LEXQCMA","INC",+($GET(DUZ)),"Include Modifier Ranges")
if '$LENGTH(DIRB)
SET DIRB="Yes"
+2 SET DIR(0)="YAO"
SET DIR("A")=" Include Modifier CPT Code Ranges? (Y/N) "
if "^YES^NO^Yes^No^"[("^"_DIRB_"^")
SET DIR("B")=DIRB
+3 SET DIR("PRE")="S:X[""?"" X=""??"""
SET (DIR("?"),DIR("??"))="^D INCH^LEXQCMA"
+4 WRITE !
DO ^DIR
if X["^^"!($DATA(DIROUT))
SET LEXEXIT=1
if X["^^"!(+($GET(LEXEXIT))>0)
QUIT "^^"
if $DATA(DIRUT)!($DATA(DIROUT))!($DATA(DTOUT))!($DATA(DUOUT))
QUIT "^"
SET DIRB=$SELECT(Y=1:"Yes",Y=0:"No",X["^":"",1:"")
+5 if $LENGTH(DIRB)
DO SAV^LEXQD("LEXQCMA","INC",+($GET(DUZ)),"Include Modifier Ranges",$GET(DIRB))
SET X=+Y
+6 QUIT X
INCH ; Include CPT Modifier Ranges Help
+1 IF $LENGTH($PIECE($GET(LEXMOD),"^",2))
IF $LENGTH($GET(LEXCDT))
Begin DoDot:1
+2 WRITE !,?5,"Answer 'Yes' to include the CPT Code Ranges for for CPT"
+3 WRITE !,?5,"Modifier code ",$PIECE($GET(LEXMOD),"^",2),". Answer 'No' to exlcude CPT Code Ranges"
+4 WRITE !,?5,"from the display."
End DoDot:1
QUIT
+5 WRITE !,?5,"Answer 'Yes' to include the CPT Code Ranges for the CPT"
+6 WRITE !,?5,"Modifier. Answer 'No' to exclude CPT Code Ranges from the"
+7 WRITE !,?5,"display."
+8 QUIT
+9 ;
INCI(X) ; Include Inactive CPT Modifier Ranges
+1 if +($GET(LEXEXIT))>0
QUIT "^^"
NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB
SET DIRB=$$RET^LEXQD("LEXQCMA","INCI",+($GET(DUZ)),"Include Inactive Modifier Ranges")
if '$LENGTH(DIRB)
SET DIRB="Yes"
+2 SET DIR(0)="YAO"
SET DIR("A")=" Include 'Inactive' Modifier CPT Code Ranges? (Y/N) "
if "^YES^NO^Yes^No^"[("^"_DIRB_"^")
SET DIR("B")=DIRB
+3 SET DIR("B")="No"
SET DIR("PRE")="S:X[""?"" X=""??"""
SET (DIR("?"),DIR("??"))="^D INCIH^LEXQCMA"
+4 WRITE !
DO ^DIR
if X["^^"
SET LEXEXIT=1!($DATA(DTOUT))
if X["^^"!(+($GET(LEXEXIT))>0)
QUIT "^^"
if $DATA(DIRUT)!($DATA(DIROUT))!($DATA(DTOUT))!($DATA(DUOUT))
QUIT "^"
SET DIRB=$SELECT(Y=1:"Yes",Y=0:"No",X["^":"",1:"")
+5 if $LENGTH(DIRB)
DO SAV^LEXQD("LEXQCMA","INCI",+($GET(DUZ)),"Include Inactive Modifier Ranges",$GET(DIRB))
SET X=+Y
+6 QUIT X
INCIH ; Include Inactive CPT Modifier Ranges Help
+1 IF $LENGTH($PIECE($GET(LEXMOD),"^",2))
IF $GET(LEXCDT)?7N
Begin DoDot:1
+2 WRITE !,?5,"Answer 'Yes' to include both Active and Inactive CPT Code"
+3 WRITE !,?5,"Ranges for the CPT Modifier ",$PIECE($GET(LEXMOD),"^",2),". Answer 'No' to include"
+4 WRITE !,?5,"only the Active CPT Code Ranges that were active for the "
+5 WRITE !,?5,"CPT Modifier ",$PIECE($GET(LEXMOD),"^",2)," on ",$$SD($GET(LEXCDT)),"."
End DoDot:1
QUIT
+6 WRITE !,?5,"Answer 'Yes' to include both Active and Inactive CPT Code "
+7 WRITE !,?5,"Ranges for the selected CPT Modifier. Answer 'No' to "
+8 WRITE !,?5,"include only the Active CPT Code Ranges for the selected"
+9 WRITE !,?5,"CPT Modifier."
+10 QUIT
+11 ;
INCF(X) ; Include Future CPT Modifier Ranges
+1 if +($GET(LEXEXIT))>0
QUIT "^^"
NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB
SET DIRB=$$RET^LEXQD("LEXQCMA","INCF",+($GET(DUZ)),"Include Future Modifier Ranges")
if '$LENGTH(DIRB)
SET DIRB="Yes"
+2 SET DIR(0)="YAO"
SET DIR("A")=" Include 'Future Active' Modifier CPT Code Ranges? (Y/N) "
if "^YES^NO^Yes^No^"[("^"_DIRB_"^")
SET DIR("B")=DIRB
+3 SET DIR("B")="No"
SET DIR("PRE")="S:X[""?"" X=""??"""
SET (DIR("?"),DIR("??"))="^D INCFH^LEXQCMA"
+4 WRITE !
DO ^DIR
if X["^^"!($DATA(DTOUT))
SET LEXEXIT=1
if X["^^"!(+($GET(LEXEXIT))>0)
QUIT "^^"
if $DATA(DIRUT)!($DATA(DIROUT))!($DATA(DTOUT))!($DATA(DUOUT))
QUIT "^"
SET DIRB=$SELECT(Y=1:"Yes",Y=0:"No",X["^":"",1:"")
+5 if $LENGTH(DIRB)
DO SAV^LEXQD("LEXQCMA","INCF",+($GET(DUZ)),"Include Future Modifier Ranges",$GET(DIRB))
SET X=+Y
+6 QUIT X
INCFH ; Include Future CPT Modifier Ranges Help
+1 IF $GET(LEXCDT)?7N
Begin DoDot:1
+2 WRITE !,?5,"Answer 'Yes' to include CPT Code Ranges that become Active"
+3 WRITE !,?5,"on or after ",$$SD($GET(LEXCDT)),". Answer 'No' to exclude CPT Code"
+4 WRITE !,?5,"Ranges activated in the future."
End DoDot:1
QUIT
+5 WRITE !,?5,"Answer 'Yes' to include CPT Code Ranges that become Active"
+6 WRITE !,?5,"in the future. Answer 'No' to to exclude CPT Code Ranges"
+7 WRITE !,?5,"activated in the future."
+8 QUIT
+9 ;
SD(X) ; Short Date
+1 QUIT $TRANSLATE($$FMTE^XLFDT(+($GET(X)),"5DZ"),"@"," ")
CLR ; Clear
+1 NEW LEXCDT,LEXEXIT,LEXMOD
+2 QUIT
