Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR7OGU

LR7OGU.m

Go to the documentation of this file.
  1. LR7OGU ;SLC/STAFF- Interim report rpc utility ;5/22/97 13:53
  1. ;;5.2;LAB SERVICE;**187,242,252**;Sep 27, 1994
  1. ;
  1. DEMO(DFN,LRDFN,PNM,AGE,SEX) ; from LR7OGC, LR7OGG, LR7OGM, LR7OGMU
  1. N %,%H,%I,DOB,LRDPF,LREND,LRPRAC,LRRB,LRTREA,LRWRD,SSN,VA,VA200,VADM,VAERR,VAIN K %I,LRWRD,SSN,VA,VADM,VAIN
  1. S LRDFN=+$$LRDFN^LR7OR1(DFN)
  1. D PT^LRX
  1. Q
  1. ;
  1. TESTSGET(TESTS,MICROSUB) ; from LR7OGM
  1. N MICROEC,TEST
  1. S TEST=0 F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
  1. .I $P(^LAB(60,TEST,0),U,4)="CH" D
  1. ..N PANEL,SEQ,TESTNUM,TESTSUB,TESTZERO K PANEL
  1. ..D TEST(TEST,.PANEL)
  1. ..S SEQ=0 F S SEQ=$O(PANEL(SEQ)) Q:SEQ<1 D
  1. ...S TESTNUM=+PANEL(SEQ)
  1. ...S TESTZERO=^LAB(60,TESTNUM,0)
  1. ...S TESTSUB=$P($P(TESTZERO,U,5),";",2)
  1. ...S ^TMP("LR7OG",$J,"T",TESTNUM)=TESTZERO
  1. ...S ^TMP("LR7OG",$J,"TMP",TESTSUB)=TESTNUM
  1. .E D
  1. ..S MICROEC=+$P(^LAB(60,TEST,0),U,14)
  1. ..S MICROEC=$G(^LAB(62.07,MICROEC,.1))
  1. ..I MICROEC["11.5" S MICROSUB(1)=""
  1. ..I MICROEC["11.6" S MICROSUB(2)=""
  1. ..I MICROEC["15" S MICROSUB(5)=""
  1. ..I MICROEC["19" S MICROSUB(8)=""
  1. ..I MICROEC["23" S MICROSUB(11)=""
  1. ..I MICROEC["34" S MICROSUB(16)=""
  1. Q
  1. TEST(TEST,PANEL) ; from LR7OGO
  1. N CNT,DUP,NEWTEST K PANEL,DUP
  1. S CNT=0
  1. D TESTS(TEST)
  1. Q
  1. ;
  1. TESTS(TEST) ;
  1. ; within scope of TEST
  1. 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
  1. N NUM
  1. S NUM=0 F S NUM=$O(^LAB(60,TEST,2,NUM)) Q:NUM<1 D
  1. .S NEWTEST=+^LAB(60,TEST,2,NUM,0)
  1. .D TESTS(NEWTEST)
  1. Q
  1. ;
  1. STRIP(VALUE) ; $$(value) -> value with leading spaces removed
  1. N I
  1. F I=1:1:$L(VALUE) Q:$E(VALUE)'=" " S VALUE=$E(VALUE,2,$L(VALUE))
  1. Q VALUE
  1. ;
  1. URANGE(TEST,SPEC,AGE,SEX,UNITS,RANGE) ; from LR7OGC, LR7OGG, LR7OGMG
  1. N HIGH,LOW,LRCW,REFHIGH,REFLOW,TESTSPEC,THER,THERHIGH,THERLOW
  1. S (RANGE,UNITS)="",LRCW=8
  1. I '$G(SPEC) Q
  1. S TESTSPEC=$S($D(^LAB(60,TEST,1,SPEC,0)):^(0),1:"")
  1. I '$L(TESTSPEC) Q
  1. 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)
  1. S THER=$S($L(THERHIGH):1,$L(THERLOW):1,1:0)
  1. S LOW=$S(THER:THERLOW,1:REFLOW)
  1. S HIGH=$S(THER:THERHIGH,1:REFHIGH)
  1. S @("LOW="_$S($L(LOW):LOW,1:""""""))
  1. S @("HIGH="_$S($L(HIGH):HIGH,1:""""""))
  1. S RANGE=LOW
  1. I $L(HIGH) S RANGE=RANGE_" - "_HIGH
  1. I THER S RANGE=RANGE_" (Ther. range)"
  1. Q
  1. ;
  1. ALLTEST ; test use only
  1. N TESTCNT,TESTNUM,TESTS
  1. S TESTNUM=0 F S TESTNUM=$O(^LAB(60,TESTNUM)) Q:TESTNUM<1 D
  1. .I '$O(^LAB(60,TESTNUM,2,0)) Q
  1. .K TESTS
  1. .W ! D TEST(TESTNUM,.TESTS)
  1. .W !,TESTNUM," ",$P(^LAB(60,TESTNUM,0),U)
  1. .S TESTCNT=0 F S TESTCNT=$O(TESTS(TESTCNT)) Q:TESTCNT<1 W !?5,TESTCNT," ",$P(^LAB(60,+TESTS(TESTCNT),0),U)
  1. Q