131 lines
3.8 KiB
Mathematica
131 lines
3.8 KiB
Mathematica
LR7OGO ;SLC/STAFF- Interim report rpc other ;12/12/97 14:22
|
|
;;5.2;LAB SERVICE;**187**;Sep 27, 1994
|
|
;
|
|
ALLTESTS(Y,FROM,DIR) ; from ORWLRR
|
|
N I,IEN,CNT S I=0,CNT=44
|
|
F Q:I'<CNT S FROM=$O(^LAB(60,"B",FROM),DIR) Q:FROM="" D
|
|
.S IEN=0 F S IEN=$O(^LAB(60,"B",FROM,IEN)) Q:'IEN D
|
|
..Q:"BO"'[$P($G(^LAB(60,IEN,0)),U,3)
|
|
..S I=I+1,Y(I)=IEN_U_FROM
|
|
Q
|
|
;
|
|
ATESTS(Y,TEST) ; from ORWLRR
|
|
N CNT,NUM,PANEL K PANEL
|
|
S CNT=0
|
|
I 'TEST Q
|
|
D TEST^LR7OGU(TEST,.PANEL)
|
|
S NUM=0 F S NUM=$O(PANEL(NUM)) Q:NUM<1 D
|
|
.S TEST=+PANEL(NUM)_U_$P($G(^LAB(60,+PANEL(NUM),0)),U)
|
|
.S CNT=CNT+1,Y(CNT)=TEST
|
|
Q
|
|
;
|
|
ATG(Y,TESTGRP,USER) ; from ORWLRR
|
|
N AA,CNT,NUM,TEST
|
|
S AA=+$O(^LRO(68,"B","CHEMISTRY",0))
|
|
Q:'TESTGRP Q:'USER Q:'AA
|
|
S CNT=0
|
|
S NUM=0 F S NUM=$O(^LRO(69.2,AA,7,USER,60,TESTGRP,1,NUM)) Q:NUM<1 S TEST=+$G(^(NUM,0)) I TEST D
|
|
.S TEST=TEST_U_$P(^LAB(60,TEST,0),U)
|
|
.S CNT=CNT+1,Y(CNT)=TEST
|
|
Q
|
|
;
|
|
ATOMICS(Y,FROM,DIR) ; from ORWLRR
|
|
N I,IEN,CNT S I=0,CNT=44
|
|
F Q:I'<CNT S FROM=$O(^LAB(60,"B",FROM),DIR) Q:FROM="" D
|
|
.S IEN=0 F S IEN=$O(^LAB(60,"B",FROM,IEN)) Q:'IEN D
|
|
..Q:'$L($P($G(^LAB(60,IEN,0)),U,5)) Q:"BO"'[$P($G(^(0)),U,3)
|
|
..S I=I+1,Y(I)=IEN_U_FROM
|
|
Q
|
|
;
|
|
CHEMTEST(Y,FROM,DIR) ; from ORWLRR
|
|
N I,IEN,CNT S I=0,CNT=44
|
|
F Q:I'<CNT S FROM=$O(^LAB(60,"B",FROM),DIR) Q:FROM="" D
|
|
.S IEN=0 F S IEN=$O(^LAB(60,"B",FROM,IEN)) Q:'IEN D
|
|
..Q:"BO"'[$P($G(^LAB(60,IEN,0)),U,3)
|
|
..Q:$P($G(^LAB(60,IEN,0)),U,4)'="CH"
|
|
..S I=I+1,Y(I)=IEN_U_FROM
|
|
Q
|
|
;
|
|
PARAM(Y) ; from ORWLRR
|
|
S Y=$G(^LAB(69.9,1,1))
|
|
Q
|
|
;
|
|
SPEC(Y,FROM,DIR) ; from ORWLRR
|
|
N I,IEN,CNT S I=0,CNT=44
|
|
F Q:I'<CNT S FROM=$O(^LAB(61,"B",FROM),DIR) Q:FROM="" D
|
|
.S IEN=0 F S IEN=$O(^LAB(61,"B",FROM,IEN)) Q:'IEN D
|
|
..S I=I+1,Y(I)=IEN_U_FROM
|
|
Q
|
|
;
|
|
TG(Y,USER) ; from ORWLRR
|
|
N AA,CNT,LINE,NAME,NUM,TEST,TESTGRP,TNUM
|
|
S AA=+$O(^LRO(68,"B","CHEMISTRY",0))
|
|
Q:'USER Q:'AA
|
|
S CNT=0
|
|
S NUM=0 F S NUM=$O(^LRO(69.2,AA,7,USER,60,NUM)) Q:NUM<1 S TESTGRP=+$G(^(NUM,0)) I TESTGRP D
|
|
.S LINE=TESTGRP_") "
|
|
.S TNUM=0 F S TNUM=$O(^LRO(69.2,AA,7,USER,60,NUM,1,TNUM)) Q:TNUM<1 S TEST=+$G(^(TNUM,0)) I TEST D
|
|
..S NAME=$P($G(^LAB(60,TEST,.1)),U)
|
|
..I '$L(NAME) S NAME=$P($G(^LAB(60,TEST,0)),U)
|
|
..I $L(NAME) S LINE=LINE_NAME_", "
|
|
.I $E(LINE,$L(LINE)-1,$L(LINE))=", " S LINE=$E(LINE,1,$L(LINE)-2)
|
|
.S CNT=CNT+1,Y(CNT)=NUM_U_LINE
|
|
Q
|
|
;
|
|
USERS(Y,FROM,DIR) ; from ORWLRR
|
|
N AA,CNT,I,IEN
|
|
S AA=+$O(^LRO(68,"B","CHEMISTRY",0))
|
|
Q:'AA
|
|
S I=0,CNT=17
|
|
F Q:I'<CNT S FROM=$O(^VA(200,"B",FROM),DIR) Q:FROM="" D
|
|
.S IEN=0 F S IEN=$O(^VA(200,"B",FROM,IEN)) Q:'IEN D
|
|
..I '$O(^LRO(69.2,AA,7,IEN,60,0)) Q
|
|
..S I=I+1,Y(I)=IEN_U_FROM
|
|
Q
|
|
;
|
|
UTGA(Y,TESTS) ; from ORWLRR
|
|
N AA,CNT,NEWNUM,NUM,TEST
|
|
S AA=$O(^LRO(68,"B","CHEMISTRY",0))
|
|
I 'AA Q
|
|
I '$D(^LRO(69.2,AA,7,DUZ,60,0)) D
|
|
.S ^LRO(69.2,AA,7,DUZ,60,0)="^69.35A^1^1"
|
|
.S NEWNUM=1
|
|
E D
|
|
.S NEWNUM=$P(^LRO(69.2,AA,7,DUZ,60,0),U,3)+1
|
|
.F Q:'$D(^LRO(69.2,AA,7,DUZ,60,NEWNUM)) S NEWNUM=NEWNUM+1
|
|
.S $P(^LRO(69.2,AA,7,DUZ,60,0),U,3,4)=NEWNUM_U_NEWNUM
|
|
S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,0)=NEWNUM
|
|
S NUM=0
|
|
S CNT=0 F S CNT=$O(TESTS(CNT)) Q:CNT<1 S TEST=+TESTS(CNT) I TEST D
|
|
.S NUM=NUM+1
|
|
.S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,NUM,0)=TEST
|
|
S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,0)="^69.36PA^"_NUM_U_NUM
|
|
Q
|
|
;
|
|
UTGD(Y,TGRP) ; from ORWLRR
|
|
N AA,CNT,NEWNUM,NUM,TEST
|
|
S AA=$O(^LRO(68,"B","CHEMISTRY",0))
|
|
I 'AA Q
|
|
S NEWNUM=TGRP
|
|
I '$D(^LRO(69.2,AA,7,DUZ,60,NEWNUM,0)) Q
|
|
K ^LRO(69.2,AA,7,DUZ,60,NEWNUM)
|
|
S NUM=0
|
|
S CNT=0 F S CNT=$O(^LRO(69.2,AA,7,DUZ,60,CNT)) Q:CNT<1 D
|
|
.S NUM=NUM+1
|
|
S ^LRO(69.2,AA,7,DUZ,60,0)="^69.35A^"_NUM_U_NUM
|
|
Q
|
|
;
|
|
UTGR(Y,TESTS,TGRP) ; from ORWLRR
|
|
N AA,CNT,NEWNUM,NUM,TEST
|
|
S AA=$O(^LRO(68,"B","CHEMISTRY",0))
|
|
I 'AA Q
|
|
S NEWNUM=TGRP
|
|
I '$D(^LRO(69.2,AA,7,DUZ,60,NEWNUM,0)) Q
|
|
K ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1)
|
|
S NUM=0
|
|
S CNT=0 F S CNT=$O(TESTS(CNT)) Q:CNT<1 S TEST=+TESTS(CNT) I TEST D
|
|
.S NUM=NUM+1
|
|
.S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,NUM,0)=TEST
|
|
S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,0)="^69.36PA^"_NUM_U_NUM
|
|
Q
|