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

LEXSET5.m

Go to the documentation of this file.
  1. LEXSET5 ;ISL/KER - Setup Appl/User Defaults for Look-up ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**6,11,80**;Sep 23, 1996;Build 1
  1. ;
  1. ; Global Variables
  1. ; ^DIC(49) ICR 10093
  1. ; ^DISV( ICR 510
  1. ; ^SC( ICR 10040
  1. ; ^TMP("LEXSCH") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$GET1^DIQ ICR 2056
  1. ; ^DIR ICR 10026
  1. ; ^XTLKKWL ICR 10122
  1. ;
  1. EN ; Set variables
  1. D:+($G(LEXQ))=0 MTLU
  1. D:+($G(LEXQ))=1 QUIET
  1. K LEXD
  1. Q
  1. QUIET ;
  1. N LEXMP S LEXMP="" D DIC0
  1. I $L($G(LEXD("DF","LEXAP"))) S ^TMP("LEXSCH",$J,"APP",0)=LEXD("DF","LEXAP"),^TMP("LEXSCH",$J,"APP",1)=$$APPN^LEXDFN(LEXD("DF","LEXAP"))
  1. I $L($G(LEXD("DF","DIS"))) S ^TMP("LEXSCH",$J,"DIS",0)=LEXD("DF","DIS"),^TMP("LEXSCH",$J,"DIS",1)=$$DISN^LEXDFN(LEXD("DF","DIS"))
  1. I $L($G(LEXD("DF","FIL"))) S ^TMP("LEXSCH",$J,"FIL",0)=LEXD("DF","FIL"),^TMP("LEXSCH",$J,"FIL",1)=$$FILN^LEXDFN(LEXD("DF","FIL"))
  1. I $L($G(LEXD("DF","GBL"))) S (DIC,^TMP("LEXSCH",$J,"GBL",0))=LEXD("DF","GBL"),^TMP("LEXSCH",$J,"GBL",1)=$$GBLN^LEXDFN(LEXD("DF","GBL"))
  1. I $L($G(LEXD("DF","IDX"))) S ^TMP("LEXSCH",$J,"IDX",0)=LEXD("DF","IDX"),^TMP("LEXSCH",$J,"IDX",1)=$$IDXN^LEXDFN(LEXD("DF","IDX"))
  1. I $L($G(LEXD("DF","OVR"))) S ^TMP("LEXSCH",$J,"OVR",0)=LEXD("DF","OVR"),^TMP("LEXSCH",$J,"OVR",1)=$$OVRN^LEXDFN(LEXD("DF","OVR"))
  1. I $L($G(LEXD("DF","SCT"))) S ^TMP("LEXSCH",$J,"SCT",0)=LEXD("DF","SCT"),^TMP("LEXSCH",$J,"SCT",1)=$$SCTN^LEXDFN(LEXD("DF","SCT"))
  1. I $L($G(LEXD("DF","UNR"))) S ^TMP("LEXSCH",$J,"UNR",0)=LEXD("DF","UNR"),^TMP("LEXSCH",$J,"UNR",1)=$$UNRN^LEXDFN(LEXD("DF","UNR"))
  1. ; Modifiers PCH 6
  1. I $L($G(LEXD("DF","MOD"))) S ^TMP("LEXSCH",$J,"MOD",0)=LEXD("DF","MOD"),^TMP("LEXSCH",$J,"MOD",1)=$$MODI^LEXDFN(LEXD("DF","MOD"))
  1. I $L($G(LEXD("DF","VOC"))) S ^TMP("LEXSCH",$J,"VOC",0)=LEXD("DF","VOC"),^TMP("LEXSCH",$J,"VOC",1)=$$VOCN^LEXDFN(LEXD("DF","VOC"))
  1. I '$L($G(LEXD("DF","VOC"))),$L($G(LEXD("DF","SUB"))) S ^TMP("LEXSCH",$J,"VOC",0)=LEXD("DF","SUB"),^TMP("LEXSCH",$J,"VOC",1)=$$VOCN^LEXDFN(LEXD("DF","SUB"))
  1. I $L($G(LEXD("DF","FLN"))) S ^TMP("LEXSCH",$J,"FLN",0)=LEXD("DF","FLN"),^TMP("LEXSCH",$J,"FLN",1)="File Number"
  1. I +($G(LEXLL))>0 S ^TMP("LEXSCH",$J,"LEN",0)=+LEXLL
  1. I +($G(LEXLL))'>0 S ^TMP("LEXSCH",$J,"LEN",0)=5
  1. S ^TMP("LEXSCH",$J,"LEN",1)="List Length"
  1. N LEXLOC,LEXSVC S (LEXLOC,LEXSVC)=""
  1. I +($G(DUZ))>0,'$L($$GET1^DIQ(200,+($G(DUZ)),.01)) D
  1. . S LEXLOC="" S:+($G(LEXLOC))=0 LEXLOC=""
  1. . S:$L($G(LEXLOC))&(+($G(LEXLOC))>0) LEXLOC=$P($G(^SC(LEXLOC,0)),U,1)
  1. . S LEXSVC=$$GET1^DIQ(200,+($G(DUZ)),29) S:+($G(LEXSVC))=0 LEXSVC=""
  1. . S:$L($G(LEXSVC))&(+($G(LEXSVC))>0) LEXSVC=$P($G(^DIC(49,LEXSVC,0)),U,1)
  1. S ^TMP("LEXSCH",$J,"LOC",0)=$E(LEXLOC,1,40),^TMP("LEXSCH",$J,"LOC",1)="User Hospital Location"
  1. S ^TMP("LEXSCH",$J,"SVC",0)=$E(LEXSVC,1,40),^TMP("LEXSCH",$J,"SVC",1)="User Service"
  1. S ^TMP("LEXSCH",$J,"USR",0)=+($G(DUZ)),^TMP("LEXSCH",$J,"USR",1)="User"
  1. Q
  1. Q
  1. MTLU ; MTLU Defaults
  1. K LEXSHOW,LEXSUB,XTLKGBL,XTLKKSCH S DIC=""
  1. S:$L($G(LEXD("DF","GBL"))) (DIC,XTLKGBL,XTLKKSCH("GBL"))=LEXD("DF","GBL")
  1. S:$L($G(LEXD("DF","DSP"))) XTLKKSCH("DSPLY")=LEXD("DF","DSP")
  1. S:$L($G(LEXD("DF","IDX"))) XTLKKSCH("INDEX")=LEXD("DF","IDX")
  1. S:$L($G(LEXD("DF","HLP"))) XTLKHLP=LEXD("DF","HLP")
  1. S:$L($G(LEXD("DF","LEXAP"))) LEXAP=LEXD("DF","LEXAP")
  1. S:$L($G(LEXD("DF","UNR"))) LEXUN=LEXD("DF","UNR")
  1. S:$L($G(LEXD("DF","DIS"))) LEXSHOW=LEXD("DF","DIS")
  1. S:$L($G(LEXD("DF","SUB"))) LEXSUB=LEXD("DF","SUB")
  1. S:$L($G(LEXD("DF","FIL"))) DIC("S")=LEXD("DF","FIL")
  1. I DIC=""!('$D(LEXSUB)) D
  1. . S (DIC,XTLKGBL,XTLKKSCH("GBL"))="^LEX(757.01,"
  1. . S XTLKKSCH("INDEX")="AWRD",XTLKKSCH("DSPLY")="XTLK^LEXPRNT"
  1. . S XTLKHLP="D XTLK^LEXHLP",LEXAP=1,LEXLL=5,LEXUN=0
  1. . S:$L($G(^LEXT(757.2,1,200,+($G(DUZ)),1))) DIC("S")=$G(^LEXT(757.2,1,200,+($G(DUZ)),1))
  1. . S LEXSUB="WRD",LEXSHOW="ICD/CPT"
  1. . S:$L($G(^LEXT(757.2,1,200,+($G(DUZ)),2))) LEXSHOW=$G(^LEXT(757.2,1,200,+($G(DUZ)),2))
  1. S XTLKSAY=0 D DIC0 S:$L($G(X)) XTLKX=X
  1. Q
  1. DIC0 S:'$L($G(DIC(0))) DIC(0)="EQM"
  1. S:'$L($G(X))&(DIC(0)'["A") DIC(0)="A"_DIC(0)
  1. S:DIC(0)["L" DIC(0)=$P(DIC(0),"L",1)_$P(DIC(0),"L",2)
  1. S:DIC(0)["I" DIC(0)=$P(DIC(0),"I",1)_$P(DIC(0),"L",2)
  1. Q
  1. XTLK ; MTLU
  1. N LEXQ S LEXQ=0 D MTLU
  1. I '$D(X)!($G(X)[U)!($G(X)="")!($G(X)=" ") S X=$$TERM
  1. Q:X=""!(X["^") S XTLKX=X D ^XTLKKWL
  1. K DIC,LEXAP,LEXLL,LEXSHOW,LEXSUB,LEXUN
  1. K XTLKKSCH,XTLKSAY,XTLKWD2,XTLKX,XTLKHLP S:+Y'>0 X=""
  1. Q
  1. TERM(X) ; Expression
  1. N DIR,Y S DIR("A")="Enter an expression: "
  1. S DIR("?")=" "_$$SQ^LEXHLP ; PCH 11
  1. S DIR("??")="^D TERMHLP^LEXSET5" N Y S DIR(0)="FAO^2:245" D ^DIR
  1. S DIC="^LEX(757.01," S:X[U&(X'["^^") X=U S:X["^^" X="^^" Q:X[U "^"
  1. I X=" ",+($G(^DISV(+($G(DUZ)),DIC)))>0 S X=@(DIC_+($G(^DISV(+($G(DUZ)),DIC)))_",0)") W " ",X
  1. F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
  1. W:$D(DTOUT) !,"Try later.",! S:$D(DTOUT) X=""
  1. S:X[U DUOUT=1 K DIR,DIRUT,DIROUT Q X
  1. TERMHLP ; Help PCH 11
  1. N X S X="" S:$L($G(DIR("?"))) X=$G(DIR("?")) S:'$L(X) X=" "_$$SQ^LEXHLP
  1. W:$L(X) !!,X,!
  1. W !," Best results occur using one to three full or partial words without"
  1. W !," a suffix (i.e., ""DIABETES"",""DIAB MELL"",""DIAB MELL INSUL"") or"
  1. W !," a classification code (ICD, CPT, HCPCS, etc)"
  1. Q