- LR7OGU ;SLC/STAFF- Interim report rpc utility ;5/22/97 13:53
- ;;5.2;LAB SERVICE;**187,242,252**;Sep 27, 1994
- ;
- DEMO(DFN,LRDFN,PNM,AGE,SEX) ; from LR7OGC, LR7OGG, LR7OGM, LR7OGMU
- 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=+$$LRDFN^LR7OR1(DFN)
- D PT^LRX
- Q
- ;
- TESTSGET(TESTS,MICROSUB) ; 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("LR7OG",$J,"T",TESTNUM)=TESTZERO
- ...S ^TMP("LR7OG",$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) ; 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) ; $$(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) ; 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OGU 2666 printed Feb 18, 2025@23:31:08 Page 2
- LR7OGU ;SLC/STAFF- Interim report rpc utility ;5/22/97 13:53
- +1 ;;5.2;LAB SERVICE;**187,242,252**;Sep 27, 1994
- +2 ;
- DEMO(DFN,LRDFN,PNM,AGE,SEX) ; from LR7OGC, LR7OGG, LR7OGM, LR7OGMU
- +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=+$$LRDFN^LR7OR1(DFN)
- +3 DO PT^LRX
- +4 QUIT
- +5 ;
- TESTSGET(TESTS,MICROSUB) ; 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("LR7OG",$JOB,"T",TESTNUM)=TESTZERO
- +11 SET ^TMP("LR7OG",$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) ; 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) ; $$(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) ; 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