- 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 Feb 18, 2025@23:34:33 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
