source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUB.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1LRUB ;AVAMC/REG - GET 62.5 ENTRIES ; 11/12/88 07:45 ;
2 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
4 I $D(L)'=11 S L=80
5 S:'$D(L(1))#2 L(1)="DRXZJT"
6 S L(2)="" F L(6)=1:1 Q:$P(X," ",L(6),99)="" S L(3)=$P(X," ",L(6)),L(5)="" D:L(3)]"" P S L(4)=$L(L(2))+$L(L(3)) S:L(4)'>L L(2)=L(2)_L(3)_" " I L(4)>L W " too long",! G OUT
7 W:X]"" " (",$E(L(2),1,$L(L(2))-1),")" S X=$E(L(2),1,$L(L(2))-1) K L Q
8P F L(5)=0:0 S L(5)=$O(^LAB(62.5,"B",L(3),L(5))) Q:'L(5) I L(1)[$P(^LAB(62.5,L(5),0),U,4) S L(3)=$P(^LAB(62.5,L(5),0),"^",2) Q:'$D(^(9)) S L(5)=$P(X," ",L(6)-1) S:L(5)>1 L(3)=^(9) Q
9 Q
10OUT K L,X Q
11Q ;
12 I $L(L(1))>1,$E(L(1))="J" S L(1)=$E(L(1),2,$L(L(1)))
13 W !!,"CHOOSE FROM:",!
14 S L(2)="A"_L(1),L(3)=0 F L(5)=1:1 S L(3)=$O(^LAB(62.5,L(2),L(3))) Q:L(3)="" S L(4)=$O(^LAB(62.5,L(2),L(3),0)) D W Q:'$D(X)
15 Q
16W Q:'L(4) I '$D(^LAB(62.5,L(4),0)) K ^LAB(62.5,L(2),L(3),L(4)) Q
17 D:L(5)#21=0 ASK Q:'$D(X) S X=^LAB(62.5,L(4),0) W $P(X,"^")," ",$P(X,"^",2),! Q
18 ;
19ASK R "'^' TO STOP: ",X:DTIME W $C(13),$J("",15),$C(13) K:X[U!('$T) X Q
20 ;
21 ;L=length of entry ;L(1)=Screen (set this in input transform/xecutable help)
Note: See TracBrowser for help on using the repository browser.