- LEXQHA ;ISL/KER - Query History - Ask ;10/30/2008
- ;;2.0;LEXICON UTILITY;**62**;Sep 23, 1996;Build 16
- ;
- ; Global Variables
- ; ^DIC(81.3, ICR 4492
- ;
- ; External References
- ; ^DIR ICR 10026
- ;
- ; Local Variables NEWed or KILLed Elsewhere
- ; LEXEXIT Exit Flag
- ; LEXIEN IEN for file 81.3
- ; LEXMOD CPT Modifier
- ; LEXSO Source
- ;
- Q
- RAN(X) ; Include CPT Modifier Ranges
- Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQHA","RAN",+($G(DUZ)),"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 RANH^LEXQHA"
- 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("LEXQHA","RAN",+($G(DUZ)),"Modifier Ranges",$G(DIRB)) S X=+Y
- Q X
- RANH ; Include CPT Modifier Ranges Help
- N LEXM S LEXM=$P($G(LEXMOD),U,2) S:'$L(LEXM)&($L($G(LEXSO))) LEXM=$P($G(LEXSO),U,4) S:'$L(LEXM)&($L($G(LEXSO))) LEXM=$G(LEXSO)
- S:'$L(LEXM)&(+($G(LEXIEN))>0)&($D(^DIC(81.3,+($G(LEXIEN)),0))) LEXM=$P($G(^DIC(81.3,+($G(LEXIEN)),0)),U,1)
- I $L($G(LEXM)) D Q
- . W !,?5,"Answer 'Yes' to include the CPT Code Ranges for for CPT"
- . W !,?5,"Modifier code ",$G(LEXM),". 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
- ;
- DIS(X) ; Display
- Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQHA","DIS",+($G(DUZ)),"Display")
- S:'$L(DIRB) DIRB="Yes"
- S DIR(0)="SAO^C:Chronological History;S:Subjective History",DIR("A")=" Display Chronological or Subjective History? (C/S) "
- S:"^CHRONOLOGICAL^SUBJECTIVE^Chronological^Subjective^"[("^"_DIRB_"^") DIR("B")=DIRB
- S DIR("PRE")="S:X[""?"" X=""??""" S (DIR("?"),DIR("??"))="^D DISH^LEXQHA"
- 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="C":"Chronological",Y="S":"Subjective",X["^":"",1:"")
- D:$L(DIRB) SAV^LEXQD("LEXQHA","DIS",+($G(DUZ)),"Display",$G(DIRB))
- S X=$S(Y="C":"CH",Y="S":"SB",X["^":"",1:"")
- Q X
- DISH ; Display Help
- W !,?5,"C = Chronological"
- W ?25,"MM/DD/YYYY Event",!
- W ?25," Data",!
- W ?25,"MM/DD/YYYY Event",!
- W ?25," Data",!
- W !,?5,"S = Subjective"
- W ?25,"Event",!
- W ?25," MM/DD/YYYY Data",!
- W ?25," MM/DD/YYYY Data"
- Q
- ;
- ; Miscellaneous
- CL ; Clear
- K LEXEXIT,LEXIEN,LEXMOD,LEXSO
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXQHA 2954 printed Feb 18, 2025@23:34:43 Page 2
- LEXQHA ;ISL/KER - Query History - 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 ; ^DIR ICR 10026
- +8 ;
- +9 ; Local Variables NEWed or KILLed Elsewhere
- +10 ; LEXEXIT Exit Flag
- +11 ; LEXIEN IEN for file 81.3
- +12 ; LEXMOD CPT Modifier
- +13 ; LEXSO Source
- +14 ;
- +15 QUIT
- RAN(X) ; Include CPT Modifier Ranges
- +1 if +($GET(LEXEXIT))>0
- QUIT "^^"
- NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB
- SET DIRB=$$RET^LEXQD("LEXQHA","RAN",+($GET(DUZ)),"Modifier Ranges")
- +2 if '$LENGTH(DIRB)
- SET DIRB="Yes"
- +3 SET DIR(0)="YAO"
- SET DIR("A")=" Include Modifier CPT Code Ranges? (Y/N) "
- if "^YES^NO^Yes^No^"[("^"_DIRB_"^")
- SET DIR("B")=DIRB
- +4 SET DIR("PRE")="S:X[""?"" X=""??"""
- SET (DIR("?"),DIR("??"))="^D RANH^LEXQHA"
- +5 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:"")
- +6 if $LENGTH(DIRB)
- DO SAV^LEXQD("LEXQHA","RAN",+($GET(DUZ)),"Modifier Ranges",$GET(DIRB))
- SET X=+Y
- +7 QUIT X
- RANH ; Include CPT Modifier Ranges Help
- +1 NEW LEXM
- SET LEXM=$PIECE($GET(LEXMOD),U,2)
- if '$LENGTH(LEXM)&($LENGTH($GET(LEXSO)))
- SET LEXM=$PIECE($GET(LEXSO),U,4)
- if '$LENGTH(LEXM)&($LENGTH($GET(LEXSO)))
- SET LEXM=$GET(LEXSO)
- +2 if '$LENGTH(LEXM)&(+($GET(LEXIEN))>0)&($DATA(^DIC(81.3,+($GET(LEXIEN)),0)))
- SET LEXM=$PIECE($GET(^DIC(81.3,+($GET(LEXIEN)),0)),U,1)
- +3 IF $LENGTH($GET(LEXM))
- Begin DoDot:1
- +4 WRITE !,?5,"Answer 'Yes' to include the CPT Code Ranges for for CPT"
- +5 WRITE !,?5,"Modifier code ",$GET(LEXM),". Answer 'No' to exlcude CPT Code Ranges"
- +6 WRITE !,?5,"from the display."
- End DoDot:1
- QUIT
- +7 WRITE !,?5,"Answer 'Yes' to include the CPT Code Ranges for the CPT"
- +8 WRITE !,?5,"Modifier. Answer 'No' to exclude CPT Code Ranges from the"
- +9 WRITE !,?5,"display."
- +10 QUIT
- +11 ;
- DIS(X) ; Display
- +1 if +($GET(LEXEXIT))>0
- QUIT "^^"
- NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB
- SET DIRB=$$RET^LEXQD("LEXQHA","DIS",+($GET(DUZ)),"Display")
- +2 if '$LENGTH(DIRB)
- SET DIRB="Yes"
- +3 SET DIR(0)="SAO^C:Chronological History;S:Subjective History"
- SET DIR("A")=" Display Chronological or Subjective History? (C/S) "
- +4 if "^CHRONOLOGICAL^SUBJECTIVE^Chronological^Subjective^"[("^"_DIRB_"^")
- SET DIR("B")=DIRB
- +5 SET DIR("PRE")="S:X[""?"" X=""??"""
- SET (DIR("?"),DIR("??"))="^D DISH^LEXQHA"
- +6 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 "^"
- +7 SET DIRB=$SELECT(Y="C":"Chronological",Y="S":"Subjective",X["^":"",1:"")
- +8 if $LENGTH(DIRB)
- DO SAV^LEXQD("LEXQHA","DIS",+($GET(DUZ)),"Display",$GET(DIRB))
- +9 SET X=$SELECT(Y="C":"CH",Y="S":"SB",X["^":"",1:"")
- +10 QUIT X
- DISH ; Display Help
- +1 WRITE !,?5,"C = Chronological"
- +2 WRITE ?25,"MM/DD/YYYY Event",!
- +3 WRITE ?25," Data",!
- +4 WRITE ?25,"MM/DD/YYYY Event",!
- +5 WRITE ?25," Data",!
- +6 WRITE !,?5,"S = Subjective"
- +7 WRITE ?25,"Event",!
- +8 WRITE ?25," MM/DD/YYYY Data",!
- +9 WRITE ?25," MM/DD/YYYY Data"
- +10 QUIT
- +11 ;
- +12 ; Miscellaneous
- CL ; Clear
- +1 KILL LEXEXIT,LEXIEN,LEXMOD,LEXSO
- +2 QUIT