- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OGC 3320 printed Feb 18, 2025@23:31 Page 2
- LR7OGC ;SLC/STAFF- Interim report rpc chart ;8/1/97 12:12
- +1 ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
- +2 ;
- 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("LR7OGX",$JOB,"OUTPUT"))
- +3 KILL ^TMP("LR7OG",$JOB)
- +4 DO DEMO^LR7OGU(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^LR7OGU(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("LR7OGX",$JOB,"OUTPUT",OUTCNT)=CDT_U_RESULT
- +33 IF '$ORDER(^LR(LRDFN,"CH",IDT,1,0))
- QUIT
- +34 SET CNT=CNT+1
- +35 SET ^TMP("LR7OG",$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("LR7OG",$JOB,CNT)=LINE
- End DoDot:2
- +39 SET CNT=CNT+1
- SET ^TMP("LR7OG",$JOB,CNT)=""
- End DoDot:1
- +40 IF RCNT=0
- KILL ^TMP("LR7OG",$JOB)
- SET ^TMP("LR7OGX",$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("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" Eval: "_LINE
- End DoDot:1
- +44 SET OUTCNT=OUTCNT+1
- +45 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=""
- +46 SET NUM=0
- FOR
- SET NUM=$ORDER(^TMP("LR7OG",$JOB,NUM))
- if NUM<1
- QUIT
- SET LINE=^(NUM)
- Begin DoDot:1
- +47 SET OUTCNT=OUTCNT+1
- +48 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
- End DoDot:1
- +49 KILL ^TMP("LR7OG",$JOB)
- +50 DO URANGE^LR7OGU(TESTNUM,ONLYSPEC,AGE,SEX,.UNITS,.RANGE)
- +51 SET LOW=$PIECE(RANGE," - ")
- SET HIGH=$PIECE($PIECE(RANGE," - ",2)," (")
- +52 SET ^TMP("LR7OGX",$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("LR7OG",$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("LR7OG",$JOB,CNT)=""
- +4 QUIT
- +5 ;
- NONNUM(CNT,RESULT,CDT) ;
- +1 SET CNT=CNT+1
- +2 SET ^TMP("LR7OG",$JOB,CNT)=$PIECE($$FMTE^XLFDT(CDT),":",1,2)_" -- result '"_RESULT_"' could not be graphed."
- +3 SET CNT=CNT+1
- SET ^TMP("LR7OG",$JOB,CNT)=""
- +4 QUIT
