Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXQHA

LEXQHA.m

Go to the documentation of this file.
  1. LEXQHA ;ISL/KER - Query History - Ask ;10/30/2008
  1. ;;2.0;LEXICON UTILITY;**62**;Sep 23, 1996;Build 16
  1. ;
  1. ; Global Variables
  1. ; ^DIC(81.3, ICR 4492
  1. ;
  1. ; External References
  1. ; ^DIR ICR 10026
  1. ;
  1. ; Local Variables NEWed or KILLed Elsewhere
  1. ; LEXEXIT Exit Flag
  1. ; LEXIEN IEN for file 81.3
  1. ; LEXMOD CPT Modifier
  1. ; LEXSO Source
  1. ;
  1. Q
  1. RAN(X) ; Include CPT Modifier Ranges
  1. Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQHA","RAN",+($G(DUZ)),"Modifier Ranges")
  1. S:'$L(DIRB) DIRB="Yes"
  1. S DIR(0)="YAO",DIR("A")=" Include Modifier CPT Code Ranges? (Y/N) " S:"^YES^NO^Yes^No^"[("^"_DIRB_"^") DIR("B")=DIRB
  1. S DIR("PRE")="S:X[""?"" X=""??""" S (DIR("?"),DIR("??"))="^D RANH^LEXQHA"
  1. 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:"")
  1. D:$L(DIRB) SAV^LEXQD("LEXQHA","RAN",+($G(DUZ)),"Modifier Ranges",$G(DIRB)) S X=+Y
  1. Q X
  1. RANH ; Include CPT Modifier Ranges Help
  1. 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)
  1. S:'$L(LEXM)&(+($G(LEXIEN))>0)&($D(^DIC(81.3,+($G(LEXIEN)),0))) LEXM=$P($G(^DIC(81.3,+($G(LEXIEN)),0)),U,1)
  1. I $L($G(LEXM)) D Q
  1. . W !,?5,"Answer 'Yes' to include the CPT Code Ranges for for CPT"
  1. . W !,?5,"Modifier code ",$G(LEXM),". Answer 'No' to exlcude CPT Code Ranges"
  1. . W !,?5,"from the display."
  1. W !,?5,"Answer 'Yes' to include the CPT Code Ranges for the CPT"
  1. W !,?5,"Modifier. Answer 'No' to exclude CPT Code Ranges from the"
  1. W !,?5,"display."
  1. Q
  1. ;
  1. DIS(X) ; Display
  1. Q:+($G(LEXEXIT))>0 "^^" N DIR,DIRUT,DIROUT,DTOUT,DUOUT,Y,DIRB S DIRB=$$RET^LEXQD("LEXQHA","DIS",+($G(DUZ)),"Display")
  1. S:'$L(DIRB) DIRB="Yes"
  1. S DIR(0)="SAO^C:Chronological History;S:Subjective History",DIR("A")=" Display Chronological or Subjective History? (C/S) "
  1. S:"^CHRONOLOGICAL^SUBJECTIVE^Chronological^Subjective^"[("^"_DIRB_"^") DIR("B")=DIRB
  1. S DIR("PRE")="S:X[""?"" X=""??""" S (DIR("?"),DIR("??"))="^D DISH^LEXQHA"
  1. W ! D ^DIR S:X["^^"!($D(DTOUT)) LEXEXIT=1 Q:X["^^"!(+($G(LEXEXIT))>0) "^^" Q:$D(DIRUT)!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) "^"
  1. S DIRB=$S(Y="C":"Chronological",Y="S":"Subjective",X["^":"",1:"")
  1. D:$L(DIRB) SAV^LEXQD("LEXQHA","DIS",+($G(DUZ)),"Display",$G(DIRB))
  1. S X=$S(Y="C":"CH",Y="S":"SB",X["^":"",1:"")
  1. Q X
  1. DISH ; Display Help
  1. W !,?5,"C = Chronological"
  1. W ?25,"MM/DD/YYYY Event",!
  1. W ?25," Data",!
  1. W ?25,"MM/DD/YYYY Event",!
  1. W ?25," Data",!
  1. W !,?5,"S = Subjective"
  1. W ?25,"Event",!
  1. W ?25," MM/DD/YYYY Data",!
  1. W ?25," MM/DD/YYYY Data"
  1. Q
  1. ;
  1. ; Miscellaneous
  1. CL ; Clear
  1. K LEXEXIT,LEXIEN,LEXMOD,LEXSO
  1. Q