source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGC.m@ 1651

Last change on this file since 1651 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1LR7OGC ;SLC/STAFF- Interim report rpc chart ;8/1/97 12:12
2 ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
3 ;
4CHART(ROOT,DFN,SDATE,EDATE,ONLYSPEC,TESTNUM) ; from ORWLRR
5 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
6 S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
7 K ^TMP("LR7OG",$J)
8 D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
9 Q:'DFN Q:'SDATE Q:'EDATE Q:'LRDFN
10 S OUTCNT=1,LRCW=8,CNT=0,RCNT=0
11 S TESTNUM=+TESTNUM,TESTZERO=$G(^LAB(60,TESTNUM,0))
12 I '$L(TESTZERO) Q
13 S CHSUB=$P($P(TESTZERO,U,5),";",2)
14 I 'CHSUB Q
15 S PRNTCODE=$P($G(^LAB(60,TESTNUM,.1)),U,3)
16 S ANY=0,FIRSTSP=0
17 I ONLYSPEC=0 S ANY=1
18 S EDATE=EDATE\1
19 S IDT=9999999-SDATE,EDT=9999999-EDATE
20 F S IDT=$O(^LR(LRDFN,"CH",IDT)) Q:IDT<1 Q:IDT>EDT D
21 .I '$L($G(^LR(LRDFN,"CH",IDT,CHSUB))) Q
22 .S ZERO=^LR(LRDFN,"CH",IDT,0)
23 .I '$P(ZERO,U,3) Q
24 .S CDT=+ZERO,SPEC=+$P(ZERO,U,5)
25 .I ANY S (ONLYSPEC,FIRSTSP)=SPEC
26 .S RESULT=$P(^LR(LRDFN,"CH",IDT,CHSUB),U)
27 .I $L(PRNTCODE) S X=RESULT S @("RESULT="_PRNTCODE)
28 .E S RESULT=$J(RESULT,8)
29 .S RESULT=$$STRIP^LR7OGU(RESULT)
30 .I RESULT[".",$P(RESULT,".")=+$P(RESULT,"."),$E(RESULT,$L(RESULT))=".",'$L($P(RESULT,".",2,99)) S RESULT=+RESULT ; convert numbers like 145. to 145
31 .I FIRSTSP,SPEC'=FIRSTSP D NONSPEC(.CNT,SPEC,RESULT,CDT) Q
32 .I '$$NUMBER(RESULT) D NONNUM(.CNT,RESULT,CDT) Q ;*** needs better checking
33 .I SPEC'=ONLYSPEC Q
34 .S OUTCNT=OUTCNT+1
35 .S RCNT=RCNT+1
36 .S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=CDT_U_RESULT
37 .I '$O(^LR(LRDFN,"CH",IDT,1,0)) Q
38 .S CNT=CNT+1
39 .S ^TMP("LR7OG",$J,CNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:"
40 .S NUM=0 F S NUM=$O(^LR(LRDFN,"CH",IDT,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
41 ..S CNT=CNT+1
42 ..S ^TMP("LR7OG",$J,CNT)=LINE
43 .S CNT=CNT+1,^TMP("LR7OG",$J,CNT)=""
44 I RCNT=0 K ^TMP("LR7OG",$J) S ^TMP("LR7OGX",$J,"OUTPUT",1)=0 Q
45 S NUM=0 F S NUM=$O(^LAB(60,TESTNUM,1,ONLYSPEC,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
46 .S OUTCNT=OUTCNT+1
47 .S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" Eval: "_LINE
48 S OUTCNT=OUTCNT+1
49 S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=""
50 S NUM=0 F S NUM=$O(^TMP("LR7OG",$J,NUM)) Q:NUM<1 S LINE=^(NUM) D
51 .S OUTCNT=OUTCNT+1
52 .S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
53 K ^TMP("LR7OG",$J)
54 D URANGE^LR7OGU(TESTNUM,ONLYSPEC,AGE,SEX,.UNITS,.RANGE)
55 S LOW=$P(RANGE," - "),HIGH=$P($P(RANGE," - ",2)," (")
56 S ^TMP("LR7OGX",$J,"OUTPUT",1)=RCNT_U_$P(^LAB(61,ONLYSPEC,0),U)_U_$$FLOAT(HIGH)_U_$$FLOAT(LOW)_U_UNITS
57 Q
58 ;
59FLOAT(VALUE) ; $$(value) -> valid float value else ""
60 I VALUE=+VALUE Q VALUE
61 Q ""
62 ;
63NUMBER(VALUE) ; $$(value) -> 1 if number, else 0
64 I VALUE=0 Q 1
65 I VALUE="." Q 0
66 I VALUE=+VALUE Q 1
67 I $L($P(VALUE,".",3,99)) Q 0
68 I $L($P(VALUE,".",2)),$E(VALUE,$L(VALUE))="." Q 0
69 I VALUE[".." Q 0
70 S P1=$P(VALUE,"."),P2=$P(VALUE,".",2)
71 I $L(P1),'((P1="-")!(P1="-0")),P1'=+P1 Q 0
72 I $L(P2),P2'?1N.N Q 0
73 Q 1
74 ;
75NONSPEC(CNT,SPEC,RESULT,CDT) ;
76 S CNT=CNT+1
77 S ^TMP("LR7OG",$J,CNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" -- for specimen "_$P($G(^LAB(61,SPEC,0)),U)_" result was "_RESULT
78 S CNT=CNT+1,^TMP("LR7OG",$J,CNT)=""
79 Q
80 ;
81NONNUM(CNT,RESULT,CDT) ;
82 S CNT=CNT+1
83 S ^TMP("LR7OG",$J,CNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" -- result '"_RESULT_"' could not be graphed."
84 S CNT=CNT+1,^TMP("LR7OG",$J,CNT)=""
85 Q
Note: See TracBrowser for help on using the repository browser.