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

LEXQHLM.m

Go to the documentation of this file.
  1. LEXQHLM ;ISL/KER - Query History - Extract Misc ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**62,80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^TMP("LEXQHO") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$ROOT^ICDEX ICR 5747
  1. ; $$FMTE^XLFDT ICR 10103
  1. ;
  1. Q
  1. ; Miscellaneous
  1. BL ; Blank Line
  1. D TL(" ")
  1. Q
  1. TL(X) ; Text Line
  1. I $D(LEXTEST) W !,$G(X) Q
  1. N LEXI S LEXI=$O(^TMP("LEXQHO",$J," "),-1)+1,^TMP("LEXQHO",$J,LEXI)=$G(X),^TMP("LEXQHO",$J,0)=LEXI
  1. Q
  1. SD(X) ; Short Date
  1. Q $TR($$FMTE^XLFDT(+($G(X)),"5DZ"),"@"," ")
  1. IA(X) ; Initial Activation
  1. N LEXEF,LEXH,LEXN,LEXS,LEXE,LEXIEN,LEXRT,LEXARY S LEXIEN=+($G(X)),LEXE="" Q:+LEXIEN'>0 ""
  1. S LEXRT=$$ROOT^ICDEX(80.1) M LEXARY=@(LEXRT_+LEXIEN_",66)") Q:'$D(LEXARY(0)) ""
  1. S LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D Q:$G(LEXE)?7N
  1. . S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
  1. . . S LEXN=$G(LEXARY(+LEXH,0)) S:+($P(LEXN,U,2))>0 LEXE=$P(LEXN,U,1) Q:$G(LEXE)?7N
  1. S X="" S:$G(LEXE)?7N X=$G(LEXE)
  1. Q X
  1. MS(X,Y) ; Date Message
  1. Q:$G(X)'>2781001&($G(Y)=0) " (business rule date used)"
  1. Q:$G(X)'>2890101&($G(Y)=1) " (business rule date used)"
  1. Q ""
  1. HD(X) ; Header
  1. Q:+($G(X))=1 "Status" Q:+($G(X))=2 "Operation/Procedure" Q:+($G(X))=3 "Description" Q:+($G(X))=4 "Major Diagnostic Category/DRG Groups"
  1. Q ""
  1. AND(X) ; Substitute 'and'
  1. S X=$G(X) Q:$L(X,", ")'>1 X
  1. S X=$P(X,", ",1,($L(X,", ")-1))_" and "_$P(X,", ",$L(X,", "))
  1. Q X
  1. CS(X) ; Trim Comma/Space
  1. S X=$$TM($G(X),","),X=$$TM($G(X)," "),X=$$TM($G(X),","),X=$$TM($G(X)," ")
  1. Q X
  1. CL ; Clear
  1. K LEXTEST
  1. Q X
  1. TM(X,Y) ; Trim Character Y - Default " "
  1. S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
  1. F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
  1. F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
  1. Q X