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

LEXSET.m

Go to the documentation of this file.
  1. LEXSET ;ISL/KER - Setup Appl/User Defaults for Look-up ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**25,80**;Sep 23, 1996;Build 1
  1. ;
  1. ; Global Variables
  1. ; ^TMP("LEXSCH") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$DT^XLFDT ICR 10103
  1. ; $$FMTE^XLFDT ICR 10103
  1. ;
  1. ; Local Variables NEWed or KILLed Elsewhere
  1. ; DIC,x Killed by calling application
  1. ; LEXLL,LEXQ,LEXVDT Killed by Speicial Lookup LEXA1
  1. ; XTLKGBL,XTLKHLP Killed by MTLU
  1. ; XTLKKSCH,XTLKSAY Killed by MTLU
  1. ;
  1. EN ; Namespace/subset are not known
  1. N DTOUT,DUOUT,LEXNS,LEXSS,LEXDS,LEXDW,LEXDR,LEXDP,LEXDA,LEXDB,LEXD0,LEXD,LEXDX
  1. S LEXNS=$$NS^LEXSET4 Q:LEXNS[U!($D(DTOUT))!($D(DUOUT))
  1. S LEXSS=$$SS^LEXSET4(LEXNS) Q:LEXSS[U!($D(DTOUT))!($D(DUOUT))
  1. D CONFIG(LEXNS,LEXSS)
  1. Q
  1. CONFIG(LEXNS,LEXSS,LEXCDT) ; Namespace/subset are known
  1. ;
  1. ; Input
  1. ;
  1. ; LEXNS Namespace from file 757.2 'AN' index
  1. ; LEXSS Subset from file 757.2, 'AA' or 'AB' index
  1. ; LEXCDT Date to used to configure lookp
  1. ;
  1. ; Output
  1. ;
  1. ; ^TMP(LEXSCH,$J)
  1. ;
  1. ; Global array containing the following parameters
  1. ; APP Application (from LEXNS)
  1. ; DIS Display format
  1. ; FIL Filter
  1. ; FLN File Number
  1. ; GBL Global (Fileman DIC)
  1. ; IDX Index used during the search
  1. ; LEN Length of list to display
  1. ; LOC Hospital Location
  1. ; OVR Overwrite User Defaults flag
  1. ; SCT Shortcuts
  1. ; SVC Service
  1. ; UNR Unresolved Narrative flag
  1. ; USR User (DUZ)
  1. ; VDT Versioning Date
  1. ; VOC Vocabulary
  1. ;
  1. N LEXD,LEXSUB,LEXAP,LEXSHOW,LEXSCT,LEXUN,LEXQOK S LEXCDT=$P($G(LEXCDT),".",1)
  1. S:LEXCDT?7N LEXVDT=LEXCDT D VDT^LEXU S LEXCDT=$G(LEXVDT),LEXQOK=$D(LEXQ)
  1. N LEXA,LEXL,LEXS,LEXM,LEXD S LEXNS=$G(LEXNS),LEXSS=$G(LEXSS)
  1. S LEXQ=$S($D(LEXQ):+LEXQ,1:1) S:LEXNS="" LEXNS="LEX" S:LEXSS="" LEXSS="WRD"
  1. S:'$D(^LEXT(757.2,"AN",LEXNS)) LEXNS=$$NS^LEXDFN2(LEXNS)
  1. S:'$D(^LEXT(757.2,"AA",LEXSS))&('$D(^LEXT(757.2,"AB",LEXSS))) LEXSS=$$MD^LEXDFN2(LEXSS)
  1. N LEXUS,LEXO,LEXT
  1. S LEXA=$$NSIEN(LEXNS),LEXS=$$SSIEN(LEXSS)
  1. S LEXM=$$MDIEN(LEXSS),LEXL=$$ASIEN(LEXA)
  1. I +LEXA=0!(+LEXS=0) D DEF G SET
  1. D APP^LEXSET2(LEXA)
  1. I LEXM=0!(LEXM>0&(LEXM=LEXA)) D SUB^LEXSET2(LEXS)
  1. I LEXM>0,LEXM'=LEXA D MOD^LEXSET2(LEXM)
  1. D USR^LEXSET2(LEXA)
  1. D GEN^LEXSET2
  1. I +($G(LEXD("DF","OVR")))>0 D OVER^LEXSET3
  1. I +($G(LEXD("DF","OVR")))=0 D USER^LEXSET3
  1. S:$G(LEXCDT)?7N ^TMP("LEXSCH",$J,"VDT",0)=+($G(LEXCDT))
  1. S:$G(LEXCDT)?7N ^TMP("LEXSCH",$J,"VDT",1)="Version Date Check: "_$$FMTE^XLFDT($G(LEXCDT))
  1. D EN^LEXSET5 S:+($G(LEXQ))=1 ^TMP("LEXSCH",$J,"ADF",0)=1
  1. SET ; Quit Setting Defaults
  1. I LEXQOK'>0 K LEXLL,LEXQ,LEXVDT
  1. Q
  1. DEF ; Defaults if LEXNS or LEXSS are invalid
  1. S LEXD("DF","DIS")="ICD/CPT",LEXD("DF","DSP")="XTLK^LEXPRNT"
  1. S LEXD("DF","FLN")=757.01,LEXD("DF","GBL")="^LEX(757.01,"
  1. S LEXD("DF","LEXAP")=1,LEXD("DF","UNR")=0
  1. S LEXD("DF","HLP")="D XTLK^LEXHLP",LEXD("DF","IDX")="AWRD"
  1. S LEXD("DF","NAM")="Lexicon",LEXD("DF","OVR")=0
  1. S LEXD("DF","SUB")="WRD"
  1. Q
  1. ALTDEF ; Defaults if LEXNS or LEXSS are invalid
  1. S (DIC,XTLKGBL,XTLKKSCH("GBL"))="^LEX(757.01,"
  1. S XTLKKSCH("DSPLY")="XTLK^LEXPRNT",XTLKKSCH("INDEX")="AWRD",XTLKHLP="D XTLK^LEXHLP"
  1. S XTLKSAY=1 S:'$L($G(DIC(0))) DIC(0)="EQM" 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) S:DIC(0)["I" DIC(0)=$P(DIC(0),"I",1)_$P(DIC(0),"L",2)
  1. S LEXAP=1,LEXLL=5,LEXUN=0,LEXSUB="WRD",LEXSHOW="ICD/CPT"
  1. Q
  1. NSIEN(LEX) ; Get IEN for application based on namespace
  1. Q:'$L($G(LEX)) 0 Q:$D(^LEXT(757.2,"AN",LEX)) $O(^LEXT(757.2,"AN",LEX,0)) Q 0
  1. SSIEN(LEX) ; Get IEN for subset based on subset
  1. Q:'$L($G(LEX)) 0
  1. Q:$D(^LEXT(757.2,"AA",LEX)) $O(^LEXT(757.2,"AA",LEX,0))
  1. S:$D(^LEXT(757.2,"AB",LEX)) LEX=$O(^LEXT(757.2,"AB",LEX,0))
  1. I +LEX>0,$D(^LEXT(757.2,LEX,5)) S LEX=$P(^LEXT(757.2,LEX,5),"^",2)
  1. I LEX'="",$D(^LEXT(757.2,"AA",LEX)) Q $O(^LEXT(757.2,"AA",LEX,0))
  1. Q 0
  1. MDIEN(LEX) ; Get IEN for mode based on subset
  1. Q:'$L($G(LEX)) 0
  1. I $D(^LEXT(757.2,"AB",LEX)) S LEX=$O(^LEXT(757.2,"AB",LEX,0)) S LEX=+LEX Q LEX
  1. Q 0
  1. ASIEN(LEX) ; Get IEN for application
  1. Q:+($G(LEX))=0 0
  1. S LEX=+LEX Q:'$L($P($G(^LEXT(757.2,LEX,5)),"^",2))&('$L($P($G(^LEXT(757.2,LEX,0)),"^",2))) 0
  1. S:$L($P($G(^LEXT(757.2,LEX,5)),"^",2)) LEX=$P($G(^LEXT(757.2,LEX,5)),"^",2)
  1. S:$L($P($G(^LEXT(757.2,LEX,0)),"^",2)) LEX=$P($G(^LEXT(757.2,LEX,0)),"^",2)
  1. Q:$D(^LEXT(757.2,"AA",LEX)) $O(^LEXT(757.2,"AA",LEX,0))
  1. Q 0