source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGO.m@ 1489

Last change on this file since 1489 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1LR7OGO ;SLC/STAFF- Interim report rpc other ;12/12/97 14:22
2 ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
3 ;
4ALLTESTS(Y,FROM,DIR) ; from ORWLRR
5 N I,IEN,CNT S I=0,CNT=44
6 F Q:I'<CNT S FROM=$O(^LAB(60,"B",FROM),DIR) Q:FROM="" D
7 .S IEN=0 F S IEN=$O(^LAB(60,"B",FROM,IEN)) Q:'IEN D
8 ..Q:"BO"'[$P($G(^LAB(60,IEN,0)),U,3)
9 ..S I=I+1,Y(I)=IEN_U_FROM
10 Q
11 ;
12ATESTS(Y,TEST) ; from ORWLRR
13 N CNT,NUM,PANEL K PANEL
14 S CNT=0
15 I 'TEST Q
16 D TEST^LR7OGU(TEST,.PANEL)
17 S NUM=0 F S NUM=$O(PANEL(NUM)) Q:NUM<1 D
18 .S TEST=+PANEL(NUM)_U_$P($G(^LAB(60,+PANEL(NUM),0)),U)
19 .S CNT=CNT+1,Y(CNT)=TEST
20 Q
21 ;
22ATG(Y,TESTGRP,USER) ; from ORWLRR
23 N AA,CNT,NUM,TEST
24 S AA=+$O(^LRO(68,"B","CHEMISTRY",0))
25 Q:'TESTGRP Q:'USER Q:'AA
26 S CNT=0
27 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
28 .S TEST=TEST_U_$P(^LAB(60,TEST,0),U)
29 .S CNT=CNT+1,Y(CNT)=TEST
30 Q
31 ;
32ATOMICS(Y,FROM,DIR) ; from ORWLRR
33 N I,IEN,CNT S I=0,CNT=44
34 F Q:I'<CNT S FROM=$O(^LAB(60,"B",FROM),DIR) Q:FROM="" D
35 .S IEN=0 F S IEN=$O(^LAB(60,"B",FROM,IEN)) Q:'IEN D
36 ..Q:'$L($P($G(^LAB(60,IEN,0)),U,5)) Q:"BO"'[$P($G(^(0)),U,3)
37 ..S I=I+1,Y(I)=IEN_U_FROM
38 Q
39 ;
40CHEMTEST(Y,FROM,DIR) ; from ORWLRR
41 N I,IEN,CNT S I=0,CNT=44
42 F Q:I'<CNT S FROM=$O(^LAB(60,"B",FROM),DIR) Q:FROM="" D
43 .S IEN=0 F S IEN=$O(^LAB(60,"B",FROM,IEN)) Q:'IEN D
44 ..Q:"BO"'[$P($G(^LAB(60,IEN,0)),U,3)
45 ..Q:$P($G(^LAB(60,IEN,0)),U,4)'="CH"
46 ..S I=I+1,Y(I)=IEN_U_FROM
47 Q
48 ;
49PARAM(Y) ; from ORWLRR
50 S Y=$G(^LAB(69.9,1,1))
51 Q
52 ;
53SPEC(Y,FROM,DIR) ; from ORWLRR
54 N I,IEN,CNT S I=0,CNT=44
55 F Q:I'<CNT S FROM=$O(^LAB(61,"B",FROM),DIR) Q:FROM="" D
56 .S IEN=0 F S IEN=$O(^LAB(61,"B",FROM,IEN)) Q:'IEN D
57 ..S I=I+1,Y(I)=IEN_U_FROM
58 Q
59 ;
60TG(Y,USER) ; from ORWLRR
61 N AA,CNT,LINE,NAME,NUM,TEST,TESTGRP,TNUM
62 S AA=+$O(^LRO(68,"B","CHEMISTRY",0))
63 Q:'USER Q:'AA
64 S CNT=0
65 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
66 .S LINE=TESTGRP_") "
67 .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
68 ..S NAME=$P($G(^LAB(60,TEST,.1)),U)
69 ..I '$L(NAME) S NAME=$P($G(^LAB(60,TEST,0)),U)
70 ..I $L(NAME) S LINE=LINE_NAME_", "
71 .I $E(LINE,$L(LINE)-1,$L(LINE))=", " S LINE=$E(LINE,1,$L(LINE)-2)
72 .S CNT=CNT+1,Y(CNT)=NUM_U_LINE
73 Q
74 ;
75USERS(Y,FROM,DIR) ; from ORWLRR
76 N AA,CNT,I,IEN
77 S AA=+$O(^LRO(68,"B","CHEMISTRY",0))
78 Q:'AA
79 S I=0,CNT=17
80 F Q:I'<CNT S FROM=$O(^VA(200,"B",FROM),DIR) Q:FROM="" D
81 .S IEN=0 F S IEN=$O(^VA(200,"B",FROM,IEN)) Q:'IEN D
82 ..I '$O(^LRO(69.2,AA,7,IEN,60,0)) Q
83 ..S I=I+1,Y(I)=IEN_U_FROM
84 Q
85 ;
86UTGA(Y,TESTS) ; from ORWLRR
87 N AA,CNT,NEWNUM,NUM,TEST
88 S AA=$O(^LRO(68,"B","CHEMISTRY",0))
89 I 'AA Q
90 I '$D(^LRO(69.2,AA,7,DUZ,60,0)) D
91 .S ^LRO(69.2,AA,7,DUZ,60,0)="^69.35A^1^1"
92 .S NEWNUM=1
93 E D
94 .S NEWNUM=$P(^LRO(69.2,AA,7,DUZ,60,0),U,3)+1
95 .F Q:'$D(^LRO(69.2,AA,7,DUZ,60,NEWNUM)) S NEWNUM=NEWNUM+1
96 .S $P(^LRO(69.2,AA,7,DUZ,60,0),U,3,4)=NEWNUM_U_NEWNUM
97 S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,0)=NEWNUM
98 S NUM=0
99 S CNT=0 F S CNT=$O(TESTS(CNT)) Q:CNT<1 S TEST=+TESTS(CNT) I TEST D
100 .S NUM=NUM+1
101 .S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,NUM,0)=TEST
102 S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,0)="^69.36PA^"_NUM_U_NUM
103 Q
104 ;
105UTGD(Y,TGRP) ; from ORWLRR
106 N AA,CNT,NEWNUM,NUM,TEST
107 S AA=$O(^LRO(68,"B","CHEMISTRY",0))
108 I 'AA Q
109 S NEWNUM=TGRP
110 I '$D(^LRO(69.2,AA,7,DUZ,60,NEWNUM,0)) Q
111 K ^LRO(69.2,AA,7,DUZ,60,NEWNUM)
112 S NUM=0
113 S CNT=0 F S CNT=$O(^LRO(69.2,AA,7,DUZ,60,CNT)) Q:CNT<1 D
114 .S NUM=NUM+1
115 S ^LRO(69.2,AA,7,DUZ,60,0)="^69.35A^"_NUM_U_NUM
116 Q
117 ;
118UTGR(Y,TESTS,TGRP) ; from ORWLRR
119 N AA,CNT,NEWNUM,NUM,TEST
120 S AA=$O(^LRO(68,"B","CHEMISTRY",0))
121 I 'AA Q
122 S NEWNUM=TGRP
123 I '$D(^LRO(69.2,AA,7,DUZ,60,NEWNUM,0)) Q
124 K ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1)
125 S NUM=0
126 S CNT=0 F S CNT=$O(TESTS(CNT)) Q:CNT<1 S TEST=+TESTS(CNT) I TEST D
127 .S NUM=NUM+1
128 .S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,NUM,0)=TEST
129 S ^LRO(69.2,AA,7,DUZ,60,NEWNUM,1,0)="^69.36PA^"_NUM_U_NUM
130 Q
Note: See TracBrowser for help on using the repository browser.