- 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
