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 Apr 09, 2024@21:13:21 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
