source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA1103.m@ 1474

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1LA1103 ;SLC/RWF - TO CHECK THE STATUS OF THE LSI-11 INTERFACE ; 8/5/87 21:0 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
3ASK ;from LRJOB
4 I '$D(^LA("Q")) W !,"There are no LAB routines running to check" Q
5 S X=$O(^LAB(62.4,0)) I (X<1)!(X>91) W !,"There are no Interface's in the Auto-instrument file." Q
6 F LR=1:10:91 IF $D(^LAB(62.4,LR,0)) W !,"Checking Interface # ",LR D AS1
7 K I,LR,Q,X,LROLD,LRCNT,LRPCNT,T,LROUT,LRANS Q
8AS1 I '$D(^LA(LR,"I")) W " Routine for this Interface not started." Q
9 S T=LR,X=0,LROUT=1,LROLD=^LA(LR,"I") D OUT K LRPCNT
10AS2 W !,"Interface check ... This may take a minute. "
11 F I=1:1:15 Q:^LA(LR,"I")>LROLD H 2
12 S LRCNT=^LA(LR,"I"),LRANS=^LA(LR,"I",LRCNT)
13 W !,"Interface data line is ",$S(LROLD=LRCNT:"NOT WORKING",1:"OK "_LRANS),!
14 IF LROLD=LRCNT,'$D(LRPCNT) W !,"LET ME TRY ONCE MORE" S LRPCNT=1 G AS2
15 Q
16OUT S LRCNT=^LA(T,"O")+1,^("O")=LRCNT,^("O",LRCNT)=LROUT
17 LOCK ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T LOCK
18 Q
19ACK ;Build and send the ACK triger/responce string
20 F LR=1:10:91 I $D(^LAB(62.4,LR,0)) W:'$D(ACK) !,"Sending string for Interface # ",LR D AC2
21 K I,LR,LROUT,Q,LRCNT,X Q
22AC2 S LROUT="" F I=LR:1:LR+9 S X=$S($D(^LAB(62.4,I,0)):^(0),1:""),LROUT=LROUT_$E(100+$P(X,"^",13),2,3)_$E(100+$P(X,"^",14),2,3)
23 S T=LR D OUT W:'$D(ACK) !?10,"$L(",LROUT,")=",$L(LROUT) Q
Note: See TracBrowser for help on using the repository browser.