BPC7OGC ; IHS/OIT/MJL - Interim report rpc chart 8/1/97 12:12 ;
;;1.5;BPC;;MAY 26, 2005
;;
;;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("BPC7OGX",$J,"OUTPUT"))
K ^TMP("BPC7OG",$J)
D DEMO^BPC7OGU(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^BPC7OGU(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("BPC7OGX",$J,"OUTPUT",OUTCNT)=CDT_U_RESULT
.I '$O(^LR(LRDFN,"CH",IDT,1,0)) Q
.S CNT=CNT+1
.S ^TMP("BPC7OG",$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("BPC7OG",$J,CNT)=LINE
.S CNT=CNT+1,^TMP("BPC7OG",$J,CNT)=""
I RCNT=0 K ^TMP("BPC7OG",$J) S ^TMP("BPC7OGX",$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("BPC7OGX",$J,"OUTPUT",OUTCNT)=" Eval: "_LINE
S OUTCNT=OUTCNT+1
S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=""
S NUM=0 F S NUM=$O(^TMP("BPC7OG",$J,NUM)) Q:NUM<1 S LINE=^(NUM) D
.S OUTCNT=OUTCNT+1
.S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=LINE
K ^TMP("BPC7OG",$J)
D URANGE^BPC7OGU(TESTNUM,ONLYSPEC,AGE,SEX,.UNITS,.RANGE)
S LOW=$P(RANGE," - "),HIGH=$P($P(RANGE," - ",2)," (")
S ^TMP("BPC7OGX",$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("BPC7OG",$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("BPC7OG",$J,CNT)=""
Q
;
NONNUM(CNT,RESULT,CDT) ;
S CNT=CNT+1
S ^TMP("BPC7OG",$J,CNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" -- result '"_RESULT_"' could not be graphed."
S CNT=CNT+1,^TMP("BPC7OG",$J,CNT)=""
Q
BPC7OGC ; IHS/OIT/MJL - Interim report rpc chart 8/1/97 12:12 ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;;
+3 ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
+4 ;
CHART(ROOT,DFN,SDATE,EDATE,ONLYSPEC,TESTNUM) ; from ORWLRR
+1 NEW 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
+2 SET ROOT=$NAME(^TMP("BPC7OGX",$JOB,"OUTPUT"))
+3 KILL ^TMP("BPC7OG",$JOB)
+4 DO DEMO^BPC7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
+5 IF 'DFN
QUIT
IF 'SDATE
QUIT
IF 'EDATE
QUIT
IF 'LRDFN
QUIT
+6 SET OUTCNT=1
SET LRCW=8
SET CNT=0
SET RCNT=0
+7 SET TESTNUM=+TESTNUM
SET TESTZERO=$GET(^LAB(60,TESTNUM,0))
+8 IF '$LENGTH(TESTZERO)
QUIT
+9 SET CHSUB=$PIECE($PIECE(TESTZERO,U,5),";",2)
+10 IF 'CHSUB
QUIT
+11 SET PRNTCODE=$PIECE($GET(^LAB(60,TESTNUM,.1)),U,3)
+12 SET ANY=0
SET FIRSTSP=0
+13 IF ONLYSPEC=0
SET ANY=1
+14 SET EDATE=EDATE\1
+15 SET IDT=9999999-SDATE
SET EDT=9999999-EDATE
+16 FOR
SET IDT=$ORDER(^LR(LRDFN,"CH",IDT))
IF IDT<1
QUIT
IF IDT>EDT
QUIT
Begin DoDot:1
+17 IF '$LENGTH($GET(^LR(LRDFN,"CH",IDT,CHSUB)))
QUIT
+18 SET ZERO=^LR(LRDFN,"CH",IDT,0)
+19 IF '$PIECE(ZERO,U,3)
QUIT
+20 SET CDT=+ZERO
SET SPEC=+$PIECE(ZERO,U,5)
+21 IF ANY
SET (ONLYSPEC,FIRSTSP)=SPEC
+22 SET RESULT=$PIECE(^LR(LRDFN,"CH",IDT,CHSUB),U)
+23 IF $LENGTH(PRNTCODE)
SET X=RESULT
SET @("RESULT="_PRNTCODE)
+24 IF '$TEST
SET RESULT=$JUSTIFY(RESULT,8)
+25 SET RESULT=$$STRIP^BPC7OGU(RESULT)
+26 ; convert numbers like 145. to 145
IF RESULT["."
IF $PIECE(RESULT,".")=+$PIECE(RESULT,".")
IF $EXTRACT(RESULT,$LENGTH(RESULT))="."
IF '$LENGTH($PIECE(RESULT,".",2,99))
SET RESULT=+RESULT
+27 IF FIRSTSP
IF SPEC'=FIRSTSP
DO NONSPEC(.CNT,SPEC,RESULT,CDT)
QUIT
+28 ;*** needs better checking
IF '$$NUMBER(RESULT)
DO NONNUM(.CNT,RESULT,CDT)
QUIT
+29 IF SPEC'=ONLYSPEC
QUIT
+30 SET OUTCNT=OUTCNT+1
+31 SET RCNT=RCNT+1
+32 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=CDT_U_RESULT
+33 IF '$ORDER(^LR(LRDFN,"CH",IDT,1,0))
QUIT
+34 SET CNT=CNT+1
+35 SET ^TMP("BPC7OG",$JOB,CNT)=$PIECE($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:"
+36 SET NUM=0
FOR
SET NUM=$ORDER(^LR(LRDFN,"CH",IDT,1,NUM))
IF NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:2
+37 SET CNT=CNT+1
+38 SET ^TMP("BPC7OG",$JOB,CNT)=LINE
End DoDot:2
+39 SET CNT=CNT+1
SET ^TMP("BPC7OG",$JOB,CNT)=""
End DoDot:1
+40 IF RCNT=0
KILL ^TMP("BPC7OG",$JOB)
SET ^TMP("BPC7OGX",$JOB,"OUTPUT",1)=0
QUIT
+41 SET NUM=0
FOR
SET NUM=$ORDER(^LAB(60,TESTNUM,1,ONLYSPEC,1,NUM))
IF NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+42 SET OUTCNT=OUTCNT+1
+43 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=" Eval: "_LINE
End DoDot:1
+44 SET OUTCNT=OUTCNT+1
+45 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=""
+46 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("BPC7OG",$JOB,NUM))
IF NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:1
+47 SET OUTCNT=OUTCNT+1
+48 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:1
+49 KILL ^TMP("BPC7OG",$JOB)
+50 DO URANGE^BPC7OGU(TESTNUM,ONLYSPEC,AGE,SEX,.UNITS,.RANGE)
+51 SET LOW=$PIECE(RANGE," - ")
SET HIGH=$PIECE($PIECE(RANGE," - ",2)," (")
+52 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",1)=RCNT_U_$PIECE(^LAB(61,ONLYSPEC,0),U)_U_$$FLOAT(HIGH)_U_$$FLOAT(LOW)_U_UNITS
+53 QUIT
+54 ;
FLOAT(VALUE) ; $$(value) -> valid float value else ""
+1 IF VALUE=+VALUE
QUIT VALUE
+2 QUIT ""
+3 ;
NUMBER(VALUE) ; $$(value) -> 1 if number, else 0
+1 IF VALUE=0
QUIT 1
+2 IF VALUE="."
QUIT 0
+3 IF VALUE=+VALUE
QUIT 1
+4 IF $LENGTH($PIECE(VALUE,".",3,99))
QUIT 0
+5 IF $LENGTH($PIECE(VALUE,".",2))
IF $EXTRACT(VALUE,$LENGTH(VALUE))="."
QUIT 0
+6 IF VALUE[".."
QUIT 0
+7 SET P1=$PIECE(VALUE,".")
SET P2=$PIECE(VALUE,".",2)
+8 IF $LENGTH(P1)
IF '((P1="-")!(P1="-0"))
IF P1'=+P1
QUIT 0
+9 IF $LENGTH(P2)
IF P2'?1N.N
QUIT 0
+10 QUIT 1
+11 ;
NONSPEC(CNT,SPEC,RESULT,CDT) ;
+1 SET CNT=CNT+1
+2 SET ^TMP("BPC7OG",$JOB,CNT)=$PIECE($$FMTE^XLFDT(CDT),":",1,2)_" -- for specimen "_$PIECE($GET(^LAB(61,SPEC,0)),U)_" result was "_RESULT
+3 SET CNT=CNT+1
SET ^TMP("BPC7OG",$JOB,CNT)=""
+4 QUIT
+5 ;
NONNUM(CNT,RESULT,CDT) ;
+1 SET CNT=CNT+1
+2 SET ^TMP("BPC7OG",$JOB,CNT)=$PIECE($$FMTE^XLFDT(CDT),":",1,2)_" -- result '"_RESULT_"' could not be graphed."
+3 SET CNT=CNT+1
SET ^TMP("BPC7OG",$JOB,CNT)=""
+4 QUIT
