| [613] | 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 | 
|---|