BPC7OGU ; IHS/OIT/MJL - Interim report rpc utility 5/22/97 13:53 ;
;;1.5;BPC;;MAY 26, 2005
;;
;;5.2;LAB SERVICE;**187**;Sep 27, 1994
;
DEMO(DFN,LRDFN,PNM,AGE,SEX) ; EP from BPC7OGC, BPC7OGG, BPC7OGM, BPC7OGMU
N %,%H,%I,DOB,LRDPF,LREND,LRPRAC,LRRB,LRTREA,LRWRD,SSN,VA,VA200,VADM,VAERR,VAIN K %I,LRWRD,SSN,VA,VADM,VAIN
S LRDFN=+$G(^DPT(DFN,"LR"))
D PT^LRX
Q
;
TESTSGET(TESTS,MICROSUB) ; EP from LR7OGM
N MICROEC,TEST
S TEST=0 F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
.I $P(^LAB(60,TEST,0),U,4)="CH" D
..N PANEL,SEQ,TESTNUM,TESTSUB,TESTZERO K PANEL
..D TEST(TEST,.PANEL)
..S SEQ=0 F S SEQ=$O(PANEL(SEQ)) Q:SEQ<1 D
...S TESTNUM=+PANEL(SEQ)
...S TESTZERO=^LAB(60,TESTNUM,0)
...S TESTSUB=$P($P(TESTZERO,U,5),";",2)
...S ^TMP("BPC7OG",$J,"T",TESTNUM)=TESTZERO
...S ^TMP("BPC7OG",$J,"TMP",TESTSUB)=TESTNUM
.E D
..S MICROEC=+$P(^LAB(60,TEST,0),U,14)
..S MICROEC=$G(^LAB(62.07,MICROEC,.1))
..I MICROEC["11.5" S MICROSUB(1)=""
..I MICROEC["11.6" S MICROSUB(2)=""
..I MICROEC["15" S MICROSUB(5)=""
..I MICROEC["19" S MICROSUB(8)=""
..I MICROEC["23" S MICROSUB(11)=""
..I MICROEC["34" S MICROSUB(16)=""
Q
TEST(TEST,PANEL) ;EP from LR7OGO
N CNT,DUP,NEWTEST K PANEL,DUP
S CNT=0
D TESTS(TEST)
Q
;
TESTS(TEST) ;
; within scope of TEST
I $P(^LAB(60,TEST,0),U,5)]"","BO"[$P(^(0),U,3),'$D(DUP(TEST)) S CNT=CNT+1,PANEL(CNT)=TEST,DUP(TEST)="" Q
N NUM
S NUM=0 F S NUM=$O(^LAB(60,TEST,2,NUM)) Q:NUM<1 D
.S NEWTEST=+^LAB(60,TEST,2,NUM,0)
.D TESTS(NEWTEST)
Q
;
STRIP(VALUE) ;EP $$(value) -> value with leading spaces removed
N I
F I=1:1:$L(VALUE) Q:$E(VALUE)'=" " S VALUE=$E(VALUE,2,$L(VALUE))
Q VALUE
;
URANGE(TEST,SPEC,AGE,SEX,UNITS,RANGE) ;EP from LR7OGC, LR7OGG, LR7OGMG
N HIGH,LOW,LRCW,REFHIGH,REFLOW,TESTSPEC,THER,THERHIGH,THERLOW
S (RANGE,UNITS)="",LRCW=8
I '$G(SPEC) Q
S TESTSPEC=$S($D(^LAB(60,TEST,1,SPEC,0)):^(0),1:"")
I '$L(TESTSPEC) Q
S REFLOW=$P(TESTSPEC,U,2),REFHIGH=$P(TESTSPEC,U,3),THERLOW=$P(TESTSPEC,U,11),THERHIGH=$P(TESTSPEC,U,12),UNITS=$P(TESTSPEC,U,7)
S THER=$S($L(THERHIGH):1,$L(THERLOW):1,1:0)
S LOW=$S(THER:THERLOW,1:REFLOW)
S HIGH=$S(THER:THERHIGH,1:REFHIGH)
S @("LOW="_$S($L(LOW):LOW,1:""""""))
S @("HIGH="_$S($L(HIGH):HIGH,1:""""""))
S RANGE=LOW
I $L(HIGH) S RANGE=RANGE_" - "_HIGH
I THER S RANGE=RANGE_" (Ther. range)"
Q
;
ALLTEST ; test use only
N TESTCNT,TESTNUM,TESTS
S TESTNUM=0 F S TESTNUM=$O(^LAB(60,TESTNUM)) Q:TESTNUM<1 D
.I '$O(^LAB(60,TESTNUM,2,0)) Q
.K TESTS
.W ! D TEST(TESTNUM,.TESTS)
.W !,TESTNUM," ",$P(^LAB(60,TESTNUM,0),U)
.S TESTCNT=0 F S TESTCNT=$O(TESTS(TESTCNT)) Q:TESTCNT<1 W !?5,TESTCNT," ",$P(^LAB(60,+TESTS(TESTCNT),0),U)
Q
BPC7OGU ; IHS/OIT/MJL - Interim report rpc utility 5/22/97 13:53 ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;;
+3 ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
+4 ;
DEMO(DFN,LRDFN,PNM,AGE,SEX) ; EP from BPC7OGC, BPC7OGG, BPC7OGM, BPC7OGMU
+1 NEW %,%H,%I,DOB,LRDPF,LREND,LRPRAC,LRRB,LRTREA,LRWRD,SSN,VA,VA200,VADM,VAERR,VAIN
KILL %I,LRWRD,SSN,VA,VADM,VAIN
+2 SET LRDFN=+$GET(^DPT(DFN,"LR"))
+3 DO PT^LRX
+4 QUIT
+5 ;
TESTSGET(TESTS,MICROSUB) ; EP from LR7OGM
+1 NEW MICROEC,TEST
+2 SET TEST=0
FOR
SET TEST=$ORDER(TESTS(TEST))
IF TEST<1
QUIT
Begin DoDot:1
+3 IF $PIECE(^LAB(60,TEST,0),U,4)="CH"
Begin DoDot:2
+4 NEW PANEL,SEQ,TESTNUM,TESTSUB,TESTZERO
KILL PANEL
+5 DO TEST(TEST,.PANEL)
+6 SET SEQ=0
FOR
SET SEQ=$ORDER(PANEL(SEQ))
IF SEQ<1
QUIT
Begin DoDot:3
+7 SET TESTNUM=+PANEL(SEQ)
+8 SET TESTZERO=^LAB(60,TESTNUM,0)
+9 SET TESTSUB=$PIECE($PIECE(TESTZERO,U,5),";",2)
+10 SET ^TMP("BPC7OG",$JOB,"T",TESTNUM)=TESTZERO
+11 SET ^TMP("BPC7OG",$JOB,"TMP",TESTSUB)=TESTNUM
End DoDot:3
End DoDot:2
+12 IF '$TEST
Begin DoDot:2
+13 SET MICROEC=+$PIECE(^LAB(60,TEST,0),U,14)
+14 SET MICROEC=$GET(^LAB(62.07,MICROEC,.1))
+15 IF MICROEC["11.5"
SET MICROSUB(1)=""
+16 IF MICROEC["11.6"
SET MICROSUB(2)=""
+17 IF MICROEC["15"
SET MICROSUB(5)=""
+18 IF MICROEC["19"
SET MICROSUB(8)=""
+19 IF MICROEC["23"
SET MICROSUB(11)=""
+20 IF MICROEC["34"
SET MICROSUB(16)=""
End DoDot:2
End DoDot:1
+21 QUIT
TEST(TEST,PANEL) ;EP from LR7OGO
+1 NEW CNT,DUP,NEWTEST
KILL PANEL,DUP
+2 SET CNT=0
+3 DO TESTS(TEST)
+4 QUIT
+5 ;
TESTS(TEST) ;
+1 ; within scope of TEST
+2 IF $PIECE(^LAB(60,TEST,0),U,5)]""
IF "BO"[$PIECE(^(0),U,3)
IF '$DATA(DUP(TEST))
SET CNT=CNT+1
SET PANEL(CNT)=TEST
SET DUP(TEST)=""
QUIT
+3 NEW NUM
+4 SET NUM=0
FOR
SET NUM=$ORDER(^LAB(60,TEST,2,NUM))
IF NUM<1
QUIT
Begin DoDot:1
+5 SET NEWTEST=+^LAB(60,TEST,2,NUM,0)
+6 DO TESTS(NEWTEST)
End DoDot:1
+7 QUIT
+8 ;
STRIP(VALUE) ;EP $$(value) -> value with leading spaces removed
+1 NEW I
+2 FOR I=1:1:$LENGTH(VALUE)
IF $EXTRACT(VALUE)'=" "
QUIT
SET VALUE=$EXTRACT(VALUE,2,$LENGTH(VALUE))
+3 QUIT VALUE
+4 ;
URANGE(TEST,SPEC,AGE,SEX,UNITS,RANGE) ;EP from LR7OGC, LR7OGG, LR7OGMG
+1 NEW HIGH,LOW,LRCW,REFHIGH,REFLOW,TESTSPEC,THER,THERHIGH,THERLOW
+2 SET (RANGE,UNITS)=""
SET LRCW=8
+3 IF '$GET(SPEC)
QUIT
+4 SET TESTSPEC=$SELECT($DATA(^LAB(60,TEST,1,SPEC,0)):^(0),1:"")
+5 IF '$LENGTH(TESTSPEC)
QUIT
+6 SET REFLOW=$PIECE(TESTSPEC,U,2)
SET REFHIGH=$PIECE(TESTSPEC,U,3)
SET THERLOW=$PIECE(TESTSPEC,U,11)
SET THERHIGH=$PIECE(TESTSPEC,U,12)
SET UNITS=$PIECE(TESTSPEC,U,7)
+7 SET THER=$SELECT($LENGTH(THERHIGH):1,$LENGTH(THERLOW):1,1:0)
+8 SET LOW=$SELECT(THER:THERLOW,1:REFLOW)
+9 SET HIGH=$SELECT(THER:THERHIGH,1:REFHIGH)
+10 SET @("LOW="_$SELECT($LENGTH(LOW):LOW,1:""""""))
+11 SET @("HIGH="_$SELECT($LENGTH(HIGH):HIGH,1:""""""))
+12 SET RANGE=LOW
+13 IF $LENGTH(HIGH)
SET RANGE=RANGE_" - "_HIGH
+14 IF THER
SET RANGE=RANGE_" (Ther. range)"
+15 QUIT
+16 ;
ALLTEST ; test use only
+1 NEW TESTCNT,TESTNUM,TESTS
+2 SET TESTNUM=0
FOR
SET TESTNUM=$ORDER(^LAB(60,TESTNUM))
IF TESTNUM<1
QUIT
Begin DoDot:1
+3 IF '$ORDER(^LAB(60,TESTNUM,2,0))
QUIT
+4 KILL TESTS
+5 WRITE !
DO TEST(TESTNUM,.TESTS)
+6 WRITE !,TESTNUM," ",$PIECE(^LAB(60,TESTNUM,0),U)
+7 SET TESTCNT=0
FOR
SET TESTCNT=$ORDER(TESTS(TESTCNT))
IF TESTCNT<1
QUIT
WRITE !?5,TESTCNT," ",$PIECE(^LAB(60,+TESTS(TESTCNT),0),U)
End DoDot:1
+8 QUIT
