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

LEXQD.m

Go to the documentation of this file.
  1. LEXQD ;ISL/KER - Query - Defaults ;10/30/2008
  1. ;;2.0;LEXICON UTILITY;**62**;Sep 23, 1996;Build 16
  1. ;
  1. ; Global Variables
  1. ; ^%ZOSF("TEST") ICR 10096
  1. ; ^XTMP( SACC 2.3.2.5.2
  1. ;
  1. ; External References
  1. ; ^DIM ICR 10016
  1. ; $$GET1^DIQ ICR 2056
  1. ; $$DT^XLFDT ICR 10103
  1. ; $$FMADD^XLFDT ICR 10103
  1. ;
  1. ; Save/Retrieve Defaults
  1. ;
  1. ; X Routine Name
  1. ; Y Routine Tag
  1. ; LEXN Number (DUZ)
  1. ; LEXC Comment
  1. ; LEXV Value (default to save)
  1. ; LEXRTN Routine Name (X)
  1. ; LEXTAG Routine Tag (Y)
  1. ; LEXKEY $E(COM,1,13)
  1. ; LEXID LEXRTN_LEXN_LEXKEY
  1. ;
  1. ; ^XTMP(LEXID,0)=FUTURE DATE^TODAY'S DATE^LEXC
  1. ; ^XTMP(LEXID,LEXTAG)=LEXV
  1. ;
  1. SAV(X,Y,LEXN,LEXC,LEXV) ; Save Defaults
  1. N LEXRTN,LEXTAG,LEXUSR,LEXCOM,LEXVAL,LEXNM,LEXID,LEXTD,LEXFD,LEXKEY S LEXRTN=$G(X) Q:+($$ROK(LEXRTN))'>0 S LEXTAG=$G(Y) Q:+($$TAG((LEXTAG_"^"_LEXRTN)))'>0
  1. S LEXUSR=+($G(LEXN)),LEXVAL=$G(LEXV) Q:LEXUSR'>0 Q:'$L(LEXVAL) S LEXCOM=$G(LEXC) Q:'$L(LEXCOM) S LEXKEY=$E(LEXCOM,1,13) F Q:$L(LEXKEY)>12 S LEXKEY=LEXKEY_" "
  1. S LEXNM=$$GET1^DIQ(200,(LEXUSR_","),.01) Q:'$L(LEXNM) S LEXTD=$$DT^XLFDT,LEXFD=$$FMADD^XLFDT(LEXTD,30),LEXID=LEXRTN_" "_LEXUSR_" "_LEXKEY
  1. S ^XTMP(LEXID,0)=LEXFD_"^"_LEXTD_"^"_LEXCOM,^XTMP(LEXID,LEXTAG)=LEXVAL
  1. Q
  1. RET(X,Y,LEXN,LEXC) ; Retrieve Defaults
  1. N LEXRTN,LEXTAG,LEXUSR,LEXCOM,LEXNM,LEXID,LEXTD,LEXFD,LEXKEY S LEXRTN=$G(X) Q:+($$ROK(LEXRTN))'>0 ""
  1. S LEXTAG=$G(Y) Q:+($$TAG((LEXTAG_"^"_LEXRTN)))'>0 "" S LEXUSR=+($G(LEXN)) Q:LEXUSR'>0 ""
  1. S LEXCOM=$G(LEXC) Q:'$L(LEXCOM) "" S LEXKEY=$E(LEXCOM,1,13) F Q:$L(LEXKEY)>12 S LEXKEY=LEXKEY_" "
  1. S LEXNM=$$GET1^DIQ(200,(LEXUSR_","),.01) Q:'$L(LEXNM) "" S LEXTD=$$DT^XLFDT,LEXFD=$$FMADD^XLFDT(LEXTD,30),LEXID=LEXRTN_" "_LEXUSR_" "_LEXKEY
  1. S X=$G(^XTMP(LEXID,LEXTAG))
  1. Q X
  1. ;
  1. ; Miscellaneous
  1. PUR ; Purge Defaults
  1. N LEXID S LEXID="LEXP~" F S LEXID=$O(^XTMP(LEXID)) Q:'$L(LEXID) Q:$E(LEXID,1,4)'="LEXQ" K:$E(LEXID,1,4)="LEXQ" ^XTMP(LEXID)
  1. Q
  1. SDF ; Show Defaults
  1. N LEXN,LEXC S LEXN="^XTMP(""LEXQ"")",LEXC="^XTMP(""LEXQ" F S LEXN=$Q(@LEXN) Q:'$L(LEXN)!(LEXN'[LEXC) W !,LEXN,"=",@LEXN
  1. Q
  1. ROK(X) ; Routine OK
  1. S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
  1. TAG(X) ; Sub-Routine OK
  1. N LEXT,LEXE,LEXL S X=$G(X) Q:'$L(X) 0 Q:X'["^" 0
  1. Q:'$L($P(X,"^",1)) 0 Q:$L($P(X,"^",1))>8 0 Q:$E($P(X,"^",1),1)'?1U 0
  1. Q:'$L($P(X,"^",2)) 0 Q:$L($P(X,"^",2))>8 0 Q:$E($P(X,"^",2),1)'?1U 0
  1. S LEXL=0,LEXT=X,(LEXE,X)="S LEXL=$L($T("_X_"))" D ^DIM X:$D(X) LEXE
  1. S X=$S(LEXL>0:1,1:0)
  1. Q X