source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OGO.m@ 1169

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