- LEXQCPA ;ISL/KER - Query - CPT Procedures - Ask ;04/21/2014
- ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; ^DIC ICR 10006
- ; ^DIR ICR 10026
- ; $$CPT^ICPTCOD ICR 1995
- ; $$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
- ; LEXCPT CPT Code IEN^Text
- ;
- Q
- CPT(X) ; CPT Code
- Q:+($G(LEXEXIT))>0 "^^" N DIC,DTOUT,DUOUT,LEXCP,LEXSO,LEXDTXT,LEXVTXT,LEXVDT,Y,ICPTVDT S:$G(LEXCDT)?7N ICPTVDT=$G(LEXCDT)
- S DIC(0)="AEQMZ",DIC="^ICPT(",DIC("A")=" Select a CPT/HCPCS Procedure code: " 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),LEXCP=$$CPT^ICPTCOD(LEXSO,LEXVDT)
- . S:$L($G(LEXDTXT)) LEXDTXT=LEXDTXT_" (Text not Versioned)" S LEXVTXT=$P(LEXCP,"^",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
- INC(X) ; Include CPT Modifiers
- Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQCPA","INC",+($G(DUZ)),"Include Modifiers") S:'$L(DIRB) DIRB="Yes"
- S DIR(0)="YAO",DIR("A")=" Include CPT Modifiers? (Y/N) " S:"^YES^NO^Yes^No^"[("^"_DIRB_"^") DIR("B")=DIRB
- S DIR("PRE")="S:X[""?"" X=""??""" S (DIR("?"),DIR("??"))="^D INCH^LEXQCPA"
- 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("LEXQCPA","INC",+($G(DUZ)),"Include Modifiers",$G(DIRB)) S X=+Y
- Q X
- INCH ; Include Help
- I $L($P($G(LEXCPT),"^",2)),$G(LEXCDT)?7N D Q
- . W !,?5,"Answer 'Yes' to include active CPT Modifiers that are appropriate for"
- . W !,?5,"CPT code ",$P($G(LEXCPT),"^",2)," on ",$$SD($G(LEXCDT))
- W !,?5,"Answer 'Yes' to include active CPT Modifiers that are appropriate"
- W !,?5,"for the CPT code, 'No' to exclude CPT Modifiers from the display"
- Q
- SD(X) ; Short Date
- Q $TR($$FMTE^XLFDT(+($G(X)),"5DZ"),"@"," ")
- CLR ; Clear
- N LEXCDT,LEXCPT,LEXEXIT
- Q
- LEXQCPA ;ISL/KER - Query - CPT Procedures - Ask ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; None
- +5 ;
- +6 ; External References
- +7 ; ^DIC ICR 10006
- +8 ; ^DIR ICR 10026
- +9 ; $$CPT^ICPTCOD ICR 1995
- +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 ; LEXCPT CPT Code IEN^Text
- +18 ;
- +19 QUIT
- CPT(X) ; CPT Code
- +1 IF +($GET(LEXEXIT))>0
- QUIT "^^"
- NEW DIC,DTOUT,DUOUT,LEXCP,LEXSO,LEXDTXT,LEXVTXT,LEXVDT,Y,ICPTVDT
- IF $GET(LEXCDT)?7N
- SET ICPTVDT=$GET(LEXCDT)
- +2 SET DIC(0)="AEQMZ"
- SET DIC="^ICPT("
- SET DIC("A")=" Select a CPT/HCPCS Procedure code: "
- 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 LEXCP=$$CPT^ICPTCOD(LEXSO,LEXVDT)
- +6 IF $LENGTH($GET(LEXDTXT))
- SET LEXDTXT=LEXDTXT_" (Text not Versioned)"
- SET LEXVTXT=$PIECE(LEXCP,"^",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
- INC(X) ; Include CPT Modifiers
- +1 IF +($GET(LEXEXIT))>0
- QUIT "^^"
- NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB
- SET DIRB=$$RET^LEXQD("LEXQCPA","INC",+($GET(DUZ)),"Include Modifiers")
- IF '$LENGTH(DIRB)
- SET DIRB="Yes"
- +2 SET DIR(0)="YAO"
- SET DIR("A")=" Include CPT Modifiers? (Y/N) "
- IF "^YES^NO^Yes^No^"[("^"_DIRB_"^")
- SET DIR("B")=DIRB
- +3 SET DIR("PRE")="S:X[""?"" X=""??"""
- SET (DIR("?"),DIR("??"))="^D INCH^LEXQCPA"
- +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("LEXQCPA","INC",+($GET(DUZ)),"Include Modifiers",$GET(DIRB))
- SET X=+Y
- +6 QUIT X
- INCH ; Include Help
- +1 IF $LENGTH($PIECE($GET(LEXCPT),"^",2))
- IF $GET(LEXCDT)?7N
- Begin DoDot:1
- +2 WRITE !,?5,"Answer 'Yes' to include active CPT Modifiers that are appropriate for"
- +3 WRITE !,?5,"CPT code ",$PIECE($GET(LEXCPT),"^",2)," on ",$$SD($GET(LEXCDT))
- End DoDot:1
- QUIT
- +4 WRITE !,?5,"Answer 'Yes' to include active CPT Modifiers that are appropriate"
- +5 WRITE !,?5,"for the CPT code, 'No' to exclude CPT Modifiers from the display"
- +6 QUIT
- SD(X) ; Short Date
- +1 QUIT $TRANSLATE($$FMTE^XLFDT(+($GET(X)),"5DZ"),"@"," ")
- CLR ; Clear
- +1 NEW LEXCDT,LEXCPT,LEXEXIT
- +2 QUIT
