BPC7OGG ; IHS/OIT/MJL - Interim report rpc grid 6/23/97 15:34 ;
;;1.5;BPC;;MAY 26, 2005
;;
;;5.2;LAB SERVICE;**187**;Sep 27, 1994
;
TEST ; test use only
N CNT,I K ^TMP("BPC7OGX",$J)
S ^TMP("BPC7OGX",$J,"INPUT",1)="25366^3010116^2920202"
S CNT=1
;F I=1:1:10 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("BPC7OGX",$J,"INPUT",CNT)=I
F I=175,7,173,9,1 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("BPC7OGX",$J,"INPUT",CNT)=I
D GRIDDATA
S I=0 F S I=$O(^TMP("BPC7OGX",$J,"OUTPUT",I)) Q:I<1 W !,^(I)
K ^TMP("BPC7OGX",$J)
Q
;
GRID(ROOT,DFN,DATE1,DATE2,SPEC,TESTS) ; from ORWLRR
N CNT,NUM
K ^TMP("BPC7OGX",$J,"INPUT"),^("OUTPUT")
S ROOT=$NA(^TMP("BPC7OGX",$J,"OUTPUT"))
S ^TMP("BPC7OGX",$J,"INPUT",1)=DFN_U_DATE1_U_DATE2_U_+SPEC
S CNT=1,NUM=0 F S NUM=$O(TESTS(NUM)) Q:NUM<1 D
.S CNT=CNT+1
.S ^TMP("BPC7OGX",$J,"INPUT",CNT)=+TESTS(NUM)
D GRIDDATA
Q
;
GRIDDATA ;
; input format
; ^TMP("BPC7OGX",$J,"INPUT",1)=dfn^start date^end date^spec^all tests
; ^TMP("BPC7OGX",$J,"INPUT",#)=test# (tests displayed in this order)
; (these tests should, be atomic, subscript - ch, type - both or output)
;
S ^TMP("BPC7OGX",$J,"OUTPUT",1)="0^0^0^1"
N ABCNT,ABDCNT,ABLINE,ABTCNT,ABTLINE,ADCNT,ADSEQ,AGE,ATCNT,ATSEQ,CDT,CHSUB,COMCNT,COMMENT,DATACNT,DATESEQ,DFN,EDATE,EDT,FLAG,IDT
N LINE,LRCW,LRDFN,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO
K ^TMP("BPC7OG",$J)
S DFN=+^TMP("BPC7OGX",$J,"INPUT",1),SDATE=+$P(^(1),U,2),EDATE=+$P(^(1),U,3),ONLYSPEC=+$P(^(1),U,4)
D DEMO^BPC7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
Q:'DFN Q:'SDATE Q:'EDATE Q:'LRDFN
S OUTCNT=1,(ADCNT,ADSEQ,ATCNT,ATSEQ,COMCNT,DATACNT,DATESEQ,TESTSEQ,TCNT)=0
S NUM=1 F S NUM=$O(^TMP("BPC7OGX",$J,"INPUT",NUM)) Q:NUM<1 S TESTNUM=+^(NUM) D
.S TESTZERO=$G(^LAB(60,TESTNUM,0))
.S CHSUB=$P($P(TESTZERO,U,5),";",2)
.I 'CHSUB Q
.S TESTNAME=$P($G(^LAB(60,TESTNUM,.1)),U),PRNTCODE=$P($G(^(.1)),U,3)
.I TESTNAME="" S TESTNAME=$P(TESTZERO,U)
.S TESTSEQ=TESTSEQ+1
.S LINE=TESTSEQ_U_TESTNUM_U_TESTNAME_U_PRNTCODE
.S ^TMP("BPC7OG",$J,"TEST",CHSUB)=LINE
.S OUTCNT=OUTCNT+1
.S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=LINE
S ^TMP("BPC7OGX",$J,"OUTPUT",1)=TESTSEQ
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
.S ZERO=^LR(LRDFN,"CH",IDT,0)
.I '$P(ZERO,U,3) Q
.S CDT=+ZERO,SPEC=+$P(ZERO,U,5),SPECNAME=$P($G(^LAB(61,SPEC,0)),U),COMMENT=$S($O(^LR(LRDFN,"CH",IDT,1,0)):"**",1:"")
.I ONLYSPEC,SPEC'=ONLYSPEC Q
.S CHSUB=1 F S CHSUB=$O(^LR(LRDFN,"CH",IDT,CHSUB)) Q:CHSUB="" D
..I '$D(^TMP("BPC7OG",$J,"TEST",CHSUB)) Q
..I '$D(^TMP("BPC7OG",$J,"DATE",IDT)) S ^(IDT)="" D
...S DATESEQ=DATESEQ+1
...S OUTCNT=OUTCNT+1
...S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
...I $L(COMMENT) D
....S COMCNT=COMCNT+1
....S ^TMP("BPC7OG",$J,"COMMENT",COMCNT)=$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 COMCNT=COMCNT+1
.....S ^TMP("BPC7OG",$J,"COMMENT",COMCNT)=LINE
....S COMCNT=COMCNT+1
....S ^TMP("BPC7OG",$J,"COMMENT",COMCNT)=""
..S RESULT=$P(^LR(LRDFN,"CH",IDT,CHSUB),U),FLAG=$P(^(CHSUB),U,2)
..S PRNTCODE=$P(^TMP("BPC7OG",$J,"TEST",CHSUB),U,4)
..I $L(PRNTCODE) S X=RESULT,LRCW=8 S @("RESULT="_PRNTCODE)
..E S RESULT=$J(RESULT,8)
..S RESULT=$$STRIP^BPC7OGU(RESULT)
..I $L(FLAG) D
...S ABTLINE=^TMP("BPC7OG",$J,"TEST",CHSUB)
...I '$D(^TMP("BPC7OG",$J,"ABTSEQ",+ABTLINE)) S ^(+ABTLINE)=U_$P(ABTLINE,U,2,3)
...I '$D(^TMP("BPC7OG",$J,"ABDSEQ",IDT)) S ^(IDT)=U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
...S ^TMP("BPC7OG",$J,"ABDATA",IDT,+ABTLINE)=RESULT_U_FLAG
..S TESTSEQ=+^TMP("BPC7OG",$J,"TEST",CHSUB)
..S DATACNT=DATACNT+1
..S ^TMP("BPC7OG",$J,"DATA",DATACNT)=DATESEQ_U_TESTSEQ_U_RESULT_U_FLAG
..D TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX)
S $P(^TMP("BPC7OGX",$J,"OUTPUT",1),U,2,3)=DATESEQ_U_DATACNT
S DATACNT=0 F S DATACNT=$O(^TMP("BPC7OG",$J,"DATA",DATACNT)) Q:DATACNT<1 S LINE=^(DATACNT) D
.S OUTCNT=OUTCNT+1,^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=LINE
S OUTCNT=OUTCNT+1,ABLINE=OUTCNT
S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)="0^0^0"
S (ABTCNT,ATSEQ)=0 F S ATSEQ=$O(^TMP("BPC7OG",$J,"ABTSEQ",ATSEQ)) Q:ATSEQ<1 D
.S ABTCNT=ABTCNT+1
.S $P(^TMP("BPC7OG",$J,"ABTSEQ",ATSEQ),U)=ABTCNT
.S OUTCNT=OUTCNT+1
.S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=^TMP("BPC7OG",$J,"ABTSEQ",ATSEQ)
S (ABDCNT,ADSEQ)=0 F S ADSEQ=$O(^TMP("BPC7OG",$J,"ABDSEQ",ADSEQ)) Q:ADSEQ<1 D
.S ABDCNT=ABDCNT+1
.S $P(^TMP("BPC7OG",$J,"ABDSEQ",ADSEQ),U)=ABDCNT
.S OUTCNT=OUTCNT+1
.S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=^TMP("BPC7OG",$J,"ABDSEQ",ADSEQ)
S (ABCNT,ADSEQ)=0 F S ADSEQ=$O(^TMP("BPC7OG",$J,"ABDATA",ADSEQ)) Q:ADSEQ<1 D
.S ADCNT=+^TMP("BPC7OG",$J,"ABDSEQ",ADSEQ)
.S ATSEQ=0 F S ATSEQ=$O(^TMP("BPC7OG",$J,"ABDATA",ADSEQ,ATSEQ)) Q:ATSEQ<1 D
..S ATCNT=+^TMP("BPC7OG",$J,"ABTSEQ",ATSEQ)
..S ABCNT=ABCNT+1
..S OUTCNT=OUTCNT+1
..S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=ADCNT_U_ATCNT_U_^TMP("BPC7OG",$J,"ABDATA",ADSEQ,ATSEQ)
S ^TMP("BPC7OGX",$J,"OUTPUT",ABLINE)=ABTCNT_U_ABDCNT_U_ABCNT
S $P(^TMP("BPC7OGX",$J,"OUTPUT",1),U,4)=OUTCNT
S TESTSEQ=0 F S TESTSEQ=$O(^TMP("BPC7OG",$J,"TESTSPEC",TESTSEQ)) Q:TESTSEQ<1 D
.S SPEC=0 F S SPEC=$O(^TMP("BPC7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q:SPEC<1 S LINE=^(SPEC) D
..S OUTCNT=OUTCNT+1
..S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=LINE
S $P(^TMP("BPC7OGX",$J,"OUTPUT",1),U,5)=OUTCNT
S NUM=0 F S NUM=$O(^TMP("BPC7OG",$J,"COMMENT",NUM)) Q:NUM<1 S LINE=^(NUM) D
.S OUTCNT=OUTCNT+1
.S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=LINE
K ^TMP("BPC7OG",$J)
Q
;
TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX) ;
N RANGE,TESTNAME,TESTNUM,TESTSEQ,UNITS
S TESTSEQ=+$P(^TMP("BPC7OG",$J,"TEST",CHSUB),U),TESTNUM=+$P(^(CHSUB),U,2),TESTNAME=$P(^(CHSUB),U,3)
I $D(^TMP("BPC7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q
D URANGE^BPC7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
S ^TMP("BPC7OG",$J,"TESTSPEC",TESTSEQ,SPEC)=TESTNUM_U_SPECNAME_U_SPEC_U_UNITS_U_$P(RANGE," - ")_U_$P($P(RANGE," - ",2)," (")
Q
BPC7OGG ; IHS/OIT/MJL - Interim report rpc grid 6/23/97 15:34 ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;;
+3 ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
+4 ;
TEST ; test use only
+1 NEW CNT,I
KILL ^TMP("BPC7OGX",$JOB)
+2 SET ^TMP("BPC7OGX",$JOB,"INPUT",1)="25366^3010116^2920202"
+3 SET CNT=1
+4 ;F I=1:1:10 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("BPC7OGX",$J,"INPUT",CNT)=I
+5 FOR I=175,7,173,9,1
IF $DATA(^LAB(60,I,0))
SET CNT=CNT+1
SET ^TMP("BPC7OGX",$JOB,"INPUT",CNT)=I
+6 DO GRIDDATA
+7 SET I=0
FOR
SET I=$ORDER(^TMP("BPC7OGX",$JOB,"OUTPUT",I))
IF I<1
QUIT
WRITE !,^(I)
+8 KILL ^TMP("BPC7OGX",$JOB)
+9 QUIT
+10 ;
GRID(ROOT,DFN,DATE1,DATE2,SPEC,TESTS) ; from ORWLRR
+1 NEW CNT,NUM
+2 KILL ^TMP("BPC7OGX",$JOB,"INPUT"),^("OUTPUT")
+3 SET ROOT=$NAME(^TMP("BPC7OGX",$JOB,"OUTPUT"))
+4 SET ^TMP("BPC7OGX",$JOB,"INPUT",1)=DFN_U_DATE1_U_DATE2_U_+SPEC
+5 SET CNT=1
SET NUM=0
FOR
SET NUM=$ORDER(TESTS(NUM))
IF NUM<1
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
+7 SET ^TMP("BPC7OGX",$JOB,"INPUT",CNT)=+TESTS(NUM)
End DoDot:1
+8 DO GRIDDATA
+9 QUIT
+10 ;
GRIDDATA ;
+1 ; input format
+2 ; ^TMP("BPC7OGX",$J,"INPUT",1)=dfn^start date^end date^spec^all tests
+3 ; ^TMP("BPC7OGX",$J,"INPUT",#)=test# (tests displayed in this order)
+4 ; (these tests should, be atomic, subscript - ch, type - both or output)
+5 ;
+6 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",1)="0^0^0^1"
+7 NEW ABCNT,ABDCNT,ABLINE,ABTCNT,ABTLINE,ADCNT,ADSEQ,AGE,ATCNT,ATSEQ,CDT,CHSUB,COMCNT,COMMENT,DATACNT,DATESEQ,DFN,EDATE,EDT,FLAG,IDT
+8 NEW LINE,LRCW,LRDFN,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO
+9 KILL ^TMP("BPC7OG",$JOB)
+10 SET DFN=+^TMP("BPC7OGX",$JOB,"INPUT",1)
SET SDATE=+$PIECE(^(1),U,2)
SET EDATE=+$PIECE(^(1),U,3)
SET ONLYSPEC=+$PIECE(^(1),U,4)
+11 DO DEMO^BPC7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
+12 IF 'DFN
QUIT
IF 'SDATE
QUIT
IF 'EDATE
QUIT
IF 'LRDFN
QUIT
+13 SET OUTCNT=1
SET (ADCNT,ADSEQ,ATCNT,ATSEQ,COMCNT,DATACNT,DATESEQ,TESTSEQ,TCNT)=0
+14 SET NUM=1
FOR
SET NUM=$ORDER(^TMP("BPC7OGX",$JOB,"INPUT",NUM))
IF NUM<1
QUIT
SET TESTNUM=+^(NUM)
Begin DoDot:1
+15 SET TESTZERO=$GET(^LAB(60,TESTNUM,0))
+16 SET CHSUB=$PIECE($PIECE(TESTZERO,U,5),";",2)
+17 IF 'CHSUB
QUIT
+18 SET TESTNAME=$PIECE($GET(^LAB(60,TESTNUM,.1)),U)
SET PRNTCODE=$PIECE($GET(^(.1)),U,3)
+19 IF TESTNAME=""
SET TESTNAME=$PIECE(TESTZERO,U)
+20 SET TESTSEQ=TESTSEQ+1
+21 SET LINE=TESTSEQ_U_TESTNUM_U_TESTNAME_U_PRNTCODE
+22 SET ^TMP("BPC7OG",$JOB,"TEST",CHSUB)=LINE
+23 SET OUTCNT=OUTCNT+1
+24 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:1
+25 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",1)=TESTSEQ
+26 SET EDATE=EDATE\1
+27 SET IDT=9999999-SDATE
SET EDT=9999999-EDATE
+28 FOR
SET IDT=$ORDER(^LR(LRDFN,"CH",IDT))
IF IDT<1
QUIT
IF IDT>EDT
QUIT
Begin DoDot:1
+29 SET ZERO=^LR(LRDFN,"CH",IDT,0)
+30 IF '$PIECE(ZERO,U,3)
QUIT
+31 SET CDT=+ZERO
SET SPEC=+$PIECE(ZERO,U,5)
SET SPECNAME=$PIECE($GET(^LAB(61,SPEC,0)),U)
SET COMMENT=$SELECT($ORDER(^LR(LRDFN,"CH",IDT,1,0)):"**",1:"")
+32 IF ONLYSPEC
IF SPEC'=ONLYSPEC
QUIT
+33 SET CHSUB=1
FOR
SET CHSUB=$ORDER(^LR(LRDFN,"CH",IDT,CHSUB))
IF CHSUB=""
QUIT
Begin DoDot:2
+34 IF '$DATA(^TMP("BPC7OG",$JOB,"TEST",CHSUB))
QUIT
+35 IF '$DATA(^TMP("BPC7OG",$JOB,"DATE",IDT))
SET ^(IDT)=""
Begin DoDot:3
+36 SET DATESEQ=DATESEQ+1
+37 SET OUTCNT=OUTCNT+1
+38 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
+39 IF $LENGTH(COMMENT)
Begin DoDot:4
+40 SET COMCNT=COMCNT+1
+41 SET ^TMP("BPC7OG",$JOB,"COMMENT",COMCNT)=$PIECE($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:"
+42 SET NUM=0
FOR
SET NUM=$ORDER(^LR(LRDFN,"CH",IDT,1,NUM))
IF NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:5
+43 SET COMCNT=COMCNT+1
+44 SET ^TMP("BPC7OG",$JOB,"COMMENT",COMCNT)=LINE
End DoDot:5
+45 SET COMCNT=COMCNT+1
+46 SET ^TMP("BPC7OG",$JOB,"COMMENT",COMCNT)=""
End DoDot:4
End DoDot:3
+47 SET RESULT=$PIECE(^LR(LRDFN,"CH",IDT,CHSUB),U)
SET FLAG=$PIECE(^(CHSUB),U,2)
+48 SET PRNTCODE=$PIECE(^TMP("BPC7OG",$JOB,"TEST",CHSUB),U,4)
+49 IF $LENGTH(PRNTCODE)
SET X=RESULT
SET LRCW=8
SET @("RESULT="_PRNTCODE)
+50 IF '$TEST
SET RESULT=$JUSTIFY(RESULT,8)
+51 SET RESULT=$$STRIP^BPC7OGU(RESULT)
+52 IF $LENGTH(FLAG)
Begin DoDot:3
+53 SET ABTLINE=^TMP("BPC7OG",$JOB,"TEST",CHSUB)
+54 IF '$DATA(^TMP("BPC7OG",$JOB,"ABTSEQ",+ABTLINE))
SET ^(+ABTLINE)=U_$PIECE(ABTLINE,U,2,3)
+55 IF '$DATA(^TMP("BPC7OG",$JOB,"ABDSEQ",IDT))
SET ^(IDT)=U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
+56 SET ^TMP("BPC7OG",$JOB,"ABDATA",IDT,+ABTLINE)=RESULT_U_FLAG
End DoDot:3
+57 SET TESTSEQ=+^TMP("BPC7OG",$JOB,"TEST",CHSUB)
+58 SET DATACNT=DATACNT+1
+59 SET ^TMP("BPC7OG",$JOB,"DATA",DATACNT)=DATESEQ_U_TESTSEQ_U_RESULT_U_FLAG
+60 DO TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX)
End DoDot:2
End DoDot:1
+61 SET $PIECE(^TMP("BPC7OGX",$JOB,"OUTPUT",1),U,2,3)=DATESEQ_U_DATACNT
+62 SET DATACNT=0
FOR
SET DATACNT=$ORDER(^TMP("BPC7OG",$JOB,"DATA",DATACNT))
IF DATACNT<1
QUIT
SET LINE=^(DATACNT)
Begin DoDot:1
+63 SET OUTCNT=OUTCNT+1
SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:1
+64 SET OUTCNT=OUTCNT+1
SET ABLINE=OUTCNT
+65 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)="0^0^0"
+66 SET (ABTCNT,ATSEQ)=0
FOR
SET ATSEQ=$ORDER(^TMP("BPC7OG",$JOB,"ABTSEQ",ATSEQ))
IF ATSEQ<1
QUIT
Begin DoDot:1
+67 SET ABTCNT=ABTCNT+1
+68 SET $PIECE(^TMP("BPC7OG",$JOB,"ABTSEQ",ATSEQ),U)=ABTCNT
+69 SET OUTCNT=OUTCNT+1
+70 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=^TMP("BPC7OG",$JOB,"ABTSEQ",ATSEQ)
End DoDot:1
+71 SET (ABDCNT,ADSEQ)=0
FOR
SET ADSEQ=$ORDER(^TMP("BPC7OG",$JOB,"ABDSEQ",ADSEQ))
IF ADSEQ<1
QUIT
Begin DoDot:1
+72 SET ABDCNT=ABDCNT+1
+73 SET $PIECE(^TMP("BPC7OG",$JOB,"ABDSEQ",ADSEQ),U)=ABDCNT
+74 SET OUTCNT=OUTCNT+1
+75 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=^TMP("BPC7OG",$JOB,"ABDSEQ",ADSEQ)
End DoDot:1
+76 SET (ABCNT,ADSEQ)=0
FOR
SET ADSEQ=$ORDER(^TMP("BPC7OG",$JOB,"ABDATA",ADSEQ))
IF ADSEQ<1
QUIT
Begin DoDot:1
+77 SET ADCNT=+^TMP("BPC7OG",$JOB,"ABDSEQ",ADSEQ)
+78 SET ATSEQ=0
FOR
SET ATSEQ=$ORDER(^TMP("BPC7OG",$JOB,"ABDATA",ADSEQ,ATSEQ))
IF ATSEQ<1
QUIT
Begin DoDot:2
+79 SET ATCNT=+^TMP("BPC7OG",$JOB,"ABTSEQ",ATSEQ)
+80 SET ABCNT=ABCNT+1
+81 SET OUTCNT=OUTCNT+1
+82 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=ADCNT_U_ATCNT_U_^TMP("BPC7OG",$JOB,"ABDATA",ADSEQ,ATSEQ)
End DoDot:2
End DoDot:1
+83 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",ABLINE)=ABTCNT_U_ABDCNT_U_ABCNT
+84 SET $PIECE(^TMP("BPC7OGX",$JOB,"OUTPUT",1),U,4)=OUTCNT
+85 SET TESTSEQ=0
FOR
SET TESTSEQ=$ORDER(^TMP("BPC7OG",$JOB,"TESTSPEC",TESTSEQ))
IF TESTSEQ<1
QUIT
Begin DoDot:1
+86 SET SPEC=0
FOR
SET SPEC=$ORDER(^TMP("BPC7OG",$JOB,"TESTSPEC",TESTSEQ,SPEC))
IF SPEC<1
QUIT
SET LINE=^(SPEC)
Begin DoDot:2
+87 SET OUTCNT=OUTCNT+1
+88 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:2
End DoDot:1
+89 SET $PIECE(^TMP("BPC7OGX",$JOB,"OUTPUT",1),U,5)=OUTCNT
+90 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("BPC7OG",$JOB,"COMMENT",NUM))
IF NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:1
+91 SET OUTCNT=OUTCNT+1
+92 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:1
+93 KILL ^TMP("BPC7OG",$JOB)
+94 QUIT
+95 ;
TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX) ;
+1 NEW RANGE,TESTNAME,TESTNUM,TESTSEQ,UNITS
+2 SET TESTSEQ=+$PIECE(^TMP("BPC7OG",$JOB,"TEST",CHSUB),U)
SET TESTNUM=+$PIECE(^(CHSUB),U,2)
SET TESTNAME=$PIECE(^(CHSUB),U,3)
+3 IF $DATA(^TMP("BPC7OG",$JOB,"TESTSPEC",TESTSEQ,SPEC))
QUIT
+4 DO URANGE^BPC7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
+5 SET ^TMP("BPC7OG",$JOB,"TESTSPEC",TESTSEQ,SPEC)=TESTNUM_U_SPECNAME_U_SPEC_U_UNITS_U_$PIECE(RANGE," - ")_U_$PIECE($PIECE(RANGE," - ",2)," (")
+6 QUIT
