86 lines
3.2 KiB
Mathematica
86 lines
3.2 KiB
Mathematica
|
LR7OGC ;SLC/STAFF- Interim report rpc chart ;8/1/97 12:12
|
||
|
|
;;5.2;LAB SERVICE;**187**;Sep 27, 1994
|
||
|
|
;
|
||
|
|
CHART(ROOT,DFN,SDATE,EDATE,ONLYSPEC,TESTNUM) ; from ORWLRR
|
||
|
|
N AGE,ANY,CDT,CHSUB,CNT,EDT,FIRSTSP,HIGH,IDT,LINE,LOW,LRCW,LRDFN,NUM,OUTCNT,PNM,PRNTCODE,RANGE,RCNT,RESULT,SEX,SPEC,TESTZERO,UNITS,VALUE,X,ZERO
|
||
|
|
S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
|
||
|
|
K ^TMP("LR7OG",$J)
|
||
|
|
D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
|
||
|
|
Q:'DFN Q:'SDATE Q:'EDATE Q:'LRDFN
|
||
|
|
S OUTCNT=1,LRCW=8,CNT=0,RCNT=0
|
||
|
|
S TESTNUM=+TESTNUM,TESTZERO=$G(^LAB(60,TESTNUM,0))
|
||
|
|
I '$L(TESTZERO) Q
|
||
|
|
S CHSUB=$P($P(TESTZERO,U,5),";",2)
|
||
|
|
I 'CHSUB Q
|
||
|
|
S PRNTCODE=$P($G(^LAB(60,TESTNUM,.1)),U,3)
|
||
|
|
S ANY=0,FIRSTSP=0
|
||
|
|
I ONLYSPEC=0 S ANY=1
|
||
|
|
S EDATE=EDATE\1
|
||
|
|
S IDT=9999999-SDATE,EDT=9999999-EDATE
|
||
|
|
F S IDT=$O(^LR(LRDFN,"CH",IDT)) Q:IDT<1 Q:IDT>EDT D
|
||
|
|
.I '$L($G(^LR(LRDFN,"CH",IDT,CHSUB))) Q
|
||
|
|
.S ZERO=^LR(LRDFN,"CH",IDT,0)
|
||
|
|
.I '$P(ZERO,U,3) Q
|
||
|
|
.S CDT=+ZERO,SPEC=+$P(ZERO,U,5)
|
||
|
|
.I ANY S (ONLYSPEC,FIRSTSP)=SPEC
|
||
|
|
.S RESULT=$P(^LR(LRDFN,"CH",IDT,CHSUB),U)
|
||
|
|
.I $L(PRNTCODE) S X=RESULT S @("RESULT="_PRNTCODE)
|
||
|
|
.E S RESULT=$J(RESULT,8)
|
||
|
|
.S RESULT=$$STRIP^LR7OGU(RESULT)
|
||
|
|
.I RESULT[".",$P(RESULT,".")=+$P(RESULT,"."),$E(RESULT,$L(RESULT))=".",'$L($P(RESULT,".",2,99)) S RESULT=+RESULT ; convert numbers like 145. to 145
|
||
|
|
.I FIRSTSP,SPEC'=FIRSTSP D NONSPEC(.CNT,SPEC,RESULT,CDT) Q
|
||
|
|
.I '$$NUMBER(RESULT) D NONNUM(.CNT,RESULT,CDT) Q ;*** needs better checking
|
||
|
|
.I SPEC'=ONLYSPEC Q
|
||
|
|
.S OUTCNT=OUTCNT+1
|
||
|
|
.S RCNT=RCNT+1
|
||
|
|
.S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=CDT_U_RESULT
|
||
|
|
.I '$O(^LR(LRDFN,"CH",IDT,1,0)) Q
|
||
|
|
.S CNT=CNT+1
|
||
|
|
.S ^TMP("LR7OG",$J,CNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:"
|
||
|
|
.S NUM=0 F S NUM=$O(^LR(LRDFN,"CH",IDT,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
|
||
|
|
..S CNT=CNT+1
|
||
|
|
..S ^TMP("LR7OG",$J,CNT)=LINE
|
||
|
|
.S CNT=CNT+1,^TMP("LR7OG",$J,CNT)=""
|
||
|
|
I RCNT=0 K ^TMP("LR7OG",$J) S ^TMP("LR7OGX",$J,"OUTPUT",1)=0 Q
|
||
|
|
S NUM=0 F S NUM=$O(^LAB(60,TESTNUM,1,ONLYSPEC,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
|
||
|
|
.S OUTCNT=OUTCNT+1
|
||
|
|
.S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" Eval: "_LINE
|
||
|
|
S OUTCNT=OUTCNT+1
|
||
|
|
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=""
|
||
|
|
S NUM=0 F S NUM=$O(^TMP("LR7OG",$J,NUM)) Q:NUM<1 S LINE=^(NUM) D
|
||
|
|
.S OUTCNT=OUTCNT+1
|
||
|
|
.S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
|
||
|
|
K ^TMP("LR7OG",$J)
|
||
|
|
D URANGE^LR7OGU(TESTNUM,ONLYSPEC,AGE,SEX,.UNITS,.RANGE)
|
||
|
|
S LOW=$P(RANGE," - "),HIGH=$P($P(RANGE," - ",2)," (")
|
||
|
|
S ^TMP("LR7OGX",$J,"OUTPUT",1)=RCNT_U_$P(^LAB(61,ONLYSPEC,0),U)_U_$$FLOAT(HIGH)_U_$$FLOAT(LOW)_U_UNITS
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
FLOAT(VALUE) ; $$(value) -> valid float value else ""
|
||
|
|
I VALUE=+VALUE Q VALUE
|
||
|
|
Q ""
|
||
|
|
;
|
||
|
|
NUMBER(VALUE) ; $$(value) -> 1 if number, else 0
|
||
|
|
I VALUE=0 Q 1
|
||
|
|
I VALUE="." Q 0
|
||
|
|
I VALUE=+VALUE Q 1
|
||
|
|
I $L($P(VALUE,".",3,99)) Q 0
|
||
|
|
I $L($P(VALUE,".",2)),$E(VALUE,$L(VALUE))="." Q 0
|
||
|
|
I VALUE[".." Q 0
|
||
|
|
S P1=$P(VALUE,"."),P2=$P(VALUE,".",2)
|
||
|
|
I $L(P1),'((P1="-")!(P1="-0")),P1'=+P1 Q 0
|
||
|
|
I $L(P2),P2'?1N.N Q 0
|
||
|
|
Q 1
|
||
|
|
;
|
||
|
|
NONSPEC(CNT,SPEC,RESULT,CDT) ;
|
||
|
|
S CNT=CNT+1
|
||
|
|
S ^TMP("LR7OG",$J,CNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" -- for specimen "_$P($G(^LAB(61,SPEC,0)),U)_" result was "_RESULT
|
||
|
|
S CNT=CNT+1,^TMP("LR7OG",$J,CNT)=""
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
NONNUM(CNT,RESULT,CDT) ;
|
||
|
|
S CNT=CNT+1
|
||
|
|
S ^TMP("LR7OG",$J,CNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" -- result '"_RESULT_"' could not be graphed."
|
||
|
|
S CNT=CNT+1,^TMP("LR7OG",$J,CNT)=""
|
||
|
|
Q
|