LEXQHLM ;ISL/KER - Query History - Extract Misc ;04/21/2014
;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^TMP("LEXQHO") SACC 2.3.2.5.1
; ^UTILITY($J ICR 10011
;
; External References
; ^DIWP ICR 10011
; $$ROOT^ICDEX ICR 5747
; $$FMTE^XLFDT ICR 10103
;
Q
; Miscellaneous
BL ; Blank Line
D TL(" ")
Q
TL(X) ; Text Line
I $D(LEXTEST) W !,$G(X) Q
N LEXI S LEXI=$O(^TMP("LEXQHO",$J," "),-1)+1,^TMP("LEXQHO",$J,LEXI)=$G(X),^TMP("LEXQHO",$J,0)=LEXI
Q
SD(X) ; Short Date
Q $TR($$FMTE^XLFDT(+($G(X)),"5DZ"),"@"," ")
IA(X) ; Initial Activation
N LEXEF,LEXH,LEXN,LEXS,LEXE,LEXIEN,LEXRT,LEXARY S LEXIEN=+($G(X)),LEXE="" Q:+LEXIEN'>0 ""
S LEXRT=$$ROOT^ICDEX(80.1) M LEXARY=@(LEXRT_+LEXIEN_",66)") Q:'$D(LEXARY(0)) ""
S LEXEF="" F S LEXEF=$O(LEXARY("B",LEXEF)) Q:'$L(LEXEF) D Q:$G(LEXE)?7N
. S LEXH=0 F S LEXH=$O(LEXARY("B",LEXEF,LEXH)) Q:+LEXH'>0 D
. . S LEXN=$G(LEXARY(+LEXH,0)) S:+($P(LEXN,U,2))>0 LEXE=$P(LEXN,U,1) Q:$G(LEXE)?7N
S X="" S:$G(LEXE)?7N X=$G(LEXE)
Q X
MS(X,Y) ; Date Message
Q:$G(X)'>2781001&($G(Y)=0) " (business rule date used)"
Q:$G(X)'>2890101&($G(Y)=1) " (business rule date used)"
Q ""
PR(LEX,X) ; Parse Array
N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,LEXI,LEXLEN,LEXC K ^UTILITY($J,"W") Q:'$D(LEX)
S LEXLEN=+($G(X)) S:+LEXLEN'>0 LEXLEN=79 S LEXC=+($G(LEX)) S:+($G(LEXC))'>0 LEXC=$O(LEX(" "),-1) Q:+LEXC'>0
S DIWL=1,DIWF="C"_+LEXLEN S LEXI=0 F S LEXI=$O(LEX(LEXI)) Q:+LEXI=0 S X=$G(LEX(LEXI)) D ^DIWP
K LEX S (LEXC,LEXI)=0 F S LEXI=$O(^UTILITY($J,"W",1,LEXI)) Q:+LEXI=0 D
. S LEX(LEXI)=$$TM($G(^UTILITY($J,"W",1,LEXI,0))," "),LEXC=LEXC+1
S:$L(LEXC) LEX=LEXC K ^UTILITY($J,"W")
Q
HD(X) ; Header
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"
Q ""
AND(X) ; Substitute 'and'
S X=$G(X) Q:$L(X,", ")'>1 X
S X=$P(X,", ",1,($L(X,", ")-1))_" and "_$P(X,", ",$L(X,", "))
Q X
CS(X) ; Trim Comma/Space
S X=$$TM($G(X),","),X=$$TM($G(X)," "),X=$$TM($G(X),","),X=$$TM($G(X)," ")
Q X
CL ; Clear
K LEXTEST
Q X
TM(X,Y) ; Trim Character Y - Default " "
S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
LEXQHLM ;ISL/KER - Query History - Extract Misc ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXQHO") SACC 2.3.2.5.1
+5 ; ^UTILITY($J ICR 10011
+6 ;
+7 ; External References
+8 ; ^DIWP ICR 10011
+9 ; $$ROOT^ICDEX ICR 5747
+10 ; $$FMTE^XLFDT ICR 10103
+11 ;
+12 QUIT
+13 ; Miscellaneous
BL ; Blank Line
+1 DO TL(" ")
+2 QUIT
TL(X) ; Text Line
+1 IF $DATA(LEXTEST)
WRITE !,$GET(X)
QUIT
+2 NEW LEXI
SET LEXI=$ORDER(^TMP("LEXQHO",$JOB," "),-1)+1
SET ^TMP("LEXQHO",$JOB,LEXI)=$GET(X)
SET ^TMP("LEXQHO",$JOB,0)=LEXI
+3 QUIT
SD(X) ; Short Date
+1 QUIT $TRANSLATE($$FMTE^XLFDT(+($GET(X)),"5DZ"),"@"," ")
IA(X) ; Initial Activation
+1 NEW LEXEF,LEXH,LEXN,LEXS,LEXE,LEXIEN,LEXRT,LEXARY
SET LEXIEN=+($GET(X))
SET LEXE=""
IF +LEXIEN'>0
QUIT ""
+2 SET LEXRT=$$ROOT^ICDEX(80.1)
MERGE LEXARY=@(LEXRT_+LEXIEN_",66)")
IF '$DATA(LEXARY(0))
QUIT ""
+3 SET LEXEF=""
FOR
SET LEXEF=$ORDER(LEXARY("B",LEXEF))
IF '$LENGTH(LEXEF)
QUIT
Begin DoDot:1
+4 SET LEXH=0
FOR
SET LEXH=$ORDER(LEXARY("B",LEXEF,LEXH))
IF +LEXH'>0
QUIT
Begin DoDot:2
+5 SET LEXN=$GET(LEXARY(+LEXH,0))
IF +($PIECE(LEXN,U,2))>0
SET LEXE=$PIECE(LEXN,U,1)
IF $GET(LEXE)?7N
QUIT
End DoDot:2
End DoDot:1
IF $GET(LEXE)?7N
QUIT
+6 SET X=""
IF $GET(LEXE)?7N
SET X=$GET(LEXE)
+7 QUIT X
MS(X,Y) ; Date Message
+1 IF $GET(X)'>2781001&($GET(Y)=0)
QUIT " (business rule date used)"
+2 IF $GET(X)'>2890101&($GET(Y)=1)
QUIT " (business rule date used)"
+3 QUIT ""
PR(LEX,X) ; Parse Array
+1 NEW DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,LEXI,LEXLEN,LEXC
KILL ^UTILITY($JOB,"W")
IF '$DATA(LEX)
QUIT
+2 SET LEXLEN=+($GET(X))
IF +LEXLEN'>0
SET LEXLEN=79
SET LEXC=+($GET(LEX))
IF +($GET(LEXC))'>0
SET LEXC=$ORDER(LEX(" "),-1)
IF +LEXC'>0
QUIT
+3 SET DIWL=1
SET DIWF="C"_+LEXLEN
SET LEXI=0
FOR
SET LEXI=$ORDER(LEX(LEXI))
IF +LEXI=0
QUIT
SET X=$GET(LEX(LEXI))
DO ^DIWP
+4 KILL LEX
SET (LEXC,LEXI)=0
FOR
SET LEXI=$ORDER(^UTILITY($JOB,"W",1,LEXI))
IF +LEXI=0
QUIT
Begin DoDot:1
+5 SET LEX(LEXI)=$$TM($GET(^UTILITY($JOB,"W",1,LEXI,0))," ")
SET LEXC=LEXC+1
End DoDot:1
+6 IF $LENGTH(LEXC)
SET LEX=LEXC
KILL ^UTILITY($JOB,"W")
+7 QUIT
HD(X) ; Header
+1 IF +($GET(X))=1
QUIT "Status"
IF +($GET(X))=2
QUIT "Operation/Procedure"
IF +($GET(X))=3
QUIT "Description"
IF +($GET(X))=4
QUIT "Major Diagnostic Category/DRG Groups"
+2 QUIT ""
AND(X) ; Substitute 'and'
+1 SET X=$GET(X)
IF $LENGTH(X,", ")'>1
QUIT X
+2 SET X=$PIECE(X,", ",1,($LENGTH(X,", ")-1))_" and "_$PIECE(X,", ",$LENGTH(X,", "))
+3 QUIT X
CS(X) ; Trim Comma/Space
+1 SET X=$$TM($GET(X),",")
SET X=$$TM($GET(X)," ")
SET X=$$TM($GET(X),",")
SET X=$$TM($GET(X)," ")
+2 QUIT X
CL ; Clear
+1 KILL LEXTEST
+2 QUIT X
TM(X,Y) ; Trim Character Y - Default " "
+1 SET X=$GET(X)
IF X=""
QUIT X
SET Y=$GET(Y)
IF '$LENGTH(Y)
SET Y=" "
+2 FOR
IF $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 FOR
IF $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 QUIT X
