| 1 | LR7OGU ;SLC/STAFF- Interim report rpc utility ;5/22/97 13:53
|
|---|
| 2 | ;;5.2;LAB SERVICE;**187,242,252**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | DEMO(DFN,LRDFN,PNM,AGE,SEX) ; from LR7OGC, LR7OGG, LR7OGM, LR7OGMU
|
|---|
| 5 | N %,%H,%I,DOB,LRDPF,LREND,LRPRAC,LRRB,LRTREA,LRWRD,SSN,VA,VA200,VADM,VAERR,VAIN K %I,LRWRD,SSN,VA,VADM,VAIN
|
|---|
| 6 | S LRDFN=+$$LRDFN^LR7OR1(DFN)
|
|---|
| 7 | D PT^LRX
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | TESTSGET(TESTS,MICROSUB) ; from LR7OGM
|
|---|
| 11 | N MICROEC,TEST
|
|---|
| 12 | S TEST=0 F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
|
|---|
| 13 | .I $P(^LAB(60,TEST,0),U,4)="CH" D
|
|---|
| 14 | ..N PANEL,SEQ,TESTNUM,TESTSUB,TESTZERO K PANEL
|
|---|
| 15 | ..D TEST(TEST,.PANEL)
|
|---|
| 16 | ..S SEQ=0 F S SEQ=$O(PANEL(SEQ)) Q:SEQ<1 D
|
|---|
| 17 | ...S TESTNUM=+PANEL(SEQ)
|
|---|
| 18 | ...S TESTZERO=^LAB(60,TESTNUM,0)
|
|---|
| 19 | ...S TESTSUB=$P($P(TESTZERO,U,5),";",2)
|
|---|
| 20 | ...S ^TMP("LR7OG",$J,"T",TESTNUM)=TESTZERO
|
|---|
| 21 | ...S ^TMP("LR7OG",$J,"TMP",TESTSUB)=TESTNUM
|
|---|
| 22 | .E D
|
|---|
| 23 | ..S MICROEC=+$P(^LAB(60,TEST,0),U,14)
|
|---|
| 24 | ..S MICROEC=$G(^LAB(62.07,MICROEC,.1))
|
|---|
| 25 | ..I MICROEC["11.5" S MICROSUB(1)=""
|
|---|
| 26 | ..I MICROEC["11.6" S MICROSUB(2)=""
|
|---|
| 27 | ..I MICROEC["15" S MICROSUB(5)=""
|
|---|
| 28 | ..I MICROEC["19" S MICROSUB(8)=""
|
|---|
| 29 | ..I MICROEC["23" S MICROSUB(11)=""
|
|---|
| 30 | ..I MICROEC["34" S MICROSUB(16)=""
|
|---|
| 31 | Q
|
|---|
| 32 | TEST(TEST,PANEL) ; from LR7OGO
|
|---|
| 33 | N CNT,DUP,NEWTEST K PANEL,DUP
|
|---|
| 34 | S CNT=0
|
|---|
| 35 | D TESTS(TEST)
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | TESTS(TEST) ;
|
|---|
| 39 | ; within scope of TEST
|
|---|
| 40 | 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
|
|---|
| 41 | N NUM
|
|---|
| 42 | S NUM=0 F S NUM=$O(^LAB(60,TEST,2,NUM)) Q:NUM<1 D
|
|---|
| 43 | .S NEWTEST=+^LAB(60,TEST,2,NUM,0)
|
|---|
| 44 | .D TESTS(NEWTEST)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | STRIP(VALUE) ; $$(value) -> value with leading spaces removed
|
|---|
| 48 | N I
|
|---|
| 49 | F I=1:1:$L(VALUE) Q:$E(VALUE)'=" " S VALUE=$E(VALUE,2,$L(VALUE))
|
|---|
| 50 | Q VALUE
|
|---|
| 51 | ;
|
|---|
| 52 | URANGE(TEST,SPEC,AGE,SEX,UNITS,RANGE) ; from LR7OGC, LR7OGG, LR7OGMG
|
|---|
| 53 | N HIGH,LOW,LRCW,REFHIGH,REFLOW,TESTSPEC,THER,THERHIGH,THERLOW
|
|---|
| 54 | S (RANGE,UNITS)="",LRCW=8
|
|---|
| 55 | I '$G(SPEC) Q
|
|---|
| 56 | S TESTSPEC=$S($D(^LAB(60,TEST,1,SPEC,0)):^(0),1:"")
|
|---|
| 57 | I '$L(TESTSPEC) Q
|
|---|
| 58 | 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)
|
|---|
| 59 | S THER=$S($L(THERHIGH):1,$L(THERLOW):1,1:0)
|
|---|
| 60 | S LOW=$S(THER:THERLOW,1:REFLOW)
|
|---|
| 61 | S HIGH=$S(THER:THERHIGH,1:REFHIGH)
|
|---|
| 62 | S @("LOW="_$S($L(LOW):LOW,1:""""""))
|
|---|
| 63 | S @("HIGH="_$S($L(HIGH):HIGH,1:""""""))
|
|---|
| 64 | S RANGE=LOW
|
|---|
| 65 | I $L(HIGH) S RANGE=RANGE_" - "_HIGH
|
|---|
| 66 | I THER S RANGE=RANGE_" (Ther. range)"
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | ALLTEST ; test use only
|
|---|
| 70 | N TESTCNT,TESTNUM,TESTS
|
|---|
| 71 | S TESTNUM=0 F S TESTNUM=$O(^LAB(60,TESTNUM)) Q:TESTNUM<1 D
|
|---|
| 72 | .I '$O(^LAB(60,TESTNUM,2,0)) Q
|
|---|
| 73 | .K TESTS
|
|---|
| 74 | .W ! D TEST(TESTNUM,.TESTS)
|
|---|
| 75 | .W !,TESTNUM," ",$P(^LAB(60,TESTNUM,0),U)
|
|---|
| 76 | .S TESTCNT=0 F S TESTCNT=$O(TESTS(TESTCNT)) Q:TESTCNT<1 W !?5,TESTCNT," ",$P(^LAB(60,+TESTS(TESTCNT),0),U)
|
|---|
| 77 | Q
|
|---|
