source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAPORT33.m@ 1147

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1LAPORT33 ;MLD/ABBOTT/SLC/RAF - AxSYM BIDRECTIONAL INTERFACE ; 6/12/96 0900
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**11,19**;Sep 27, 1994
3 ;
4 ; This routine LOOSELY follows the LAPORTXX template. However, this
5 ; routine works ONLY for Abbott's AxSYM machine, and should comply
6 ; with ASTM communication protocols. This pgm will run continuously
7 ; as a background job until the system is taken down OR ^LA("STOP",INST)
8 ; global flag is set. /mld
9 ;
10 N LARETRY,LATOUT,LATEMP,LAFRAME,LAFRAM,LAEND,LACS,LAFRNUM,LADEV
11 N LAFRNM,LALINK,LACRLF,LACRETX,LANOCTL1,LANOCTL2,LADATA,LANM
12 N I,J,T,X,Y,INST,DEB,HOME,BASE,OUT,TOUT,PAR,TSK,NODE,OK,DEBUG,CNT
13 N NUL,SOH,STX,ETX,EOT,ENQ,ACK,NAK,ETB,LF,CR ; *control chars*
14 ;
15 S LANM=$T(+0),(HOME,T)=+$E(LANM,7,8) Q:+T<1 Q:$D(^LA("LOCK","D"_T))
16 ; init req'd params
17 D INIT^LAXSYMU I 'OK QUIT ; chk ^LA(INST,"ERR",$H) for err msg
18 ;
19PH1 ; PHase1 - idle/establish link (wait for AxSYM to send data)
20 S LADATA=$$GETCH I DEBUG D DEBG^LAXSYMU(LADATA,"I")
21 I LADATA=-1 G @($$CHK) ; idle - chk flags
22 I LADATA'=ENQ G PH1 ; read until ENQ rec'd
23 ; AxSYM ready to send data so init vars, ACK and drop to PH2
24 S LAFRAME="",LARETRY=0,LATOUT=15,LAFRNM=0,LALINK=1
25 D SEND^LAXSYMU(ACK)
26 ;
27PH2 ; PHase2 - transfer data (build frame)
28 S LADATA=$$GETCH
29 I LADATA=-1 D SET G PH1 ; timed out - goto idle
30 S LAFRAME=LAFRAME_$C(LADATA) ; build frame
31 I $L(LAFRAME)>247 D NAK^LAXSYMU("SIZE") G:LARETRY<7 PH2 D SET G PH1
32 I LADATA=LF G PH3 ; LF=complete frame
33 I LADATA=EOT G PH3 ; no more data
34 G PH2
35 ;
36PH3 ; PHase3 (validate frame)
37 D:DEBUG DEBG^LAXSYMU(LAFRAME,"I") ; debug
38 S X=LAFRAME
39 I $F(X,$C(EOT)) D SET G PH1 ; EOT not allowed in txt
40 I $A(X)'=STX D SET G PH1 ; 1st char must be STX
41 ; txt must end w/ ETX or ETB
42 S LAEND=$S($F(X,$C(ETX)):$F(X,$C(ETX)),1:$F(X,$C(ETB)))
43 I 'LAEND D NAK^LAXSYMU("LAEND") G PH2:LARETRY<7 D SET G PH1
44 ;
45 S LAFRAM=$E(X,2,LAEND-1) ; get msg txt
46 ; chk frame numbering sequence
47 S LAFRNUM=+LAFRAM,LAFRNM=$S(LAFRNM<7:LAFRNM+1,1:0)
48 I LAFRNM'=LAFRNUM D NAK^LAXSYMU("NUMSQNC") G PH2:LARETRY<7 D SET G PH1
49 I LAFRNUM'=(LAFRNUM#8) D NAK^LAXSYMU("FRNUM") G PH2:LARETRY<7 D SET G PH1
50 ; chk restricted control chars in txt
51 I LAFRAM'=$TR(LAFRAM,LANOCTL2) D NAK^LAXSYMU("CTL") G PH2:LARETRY<7 D SET G PH1
52 ; sent checksum must = received checksum
53 S LACS=$E(X,LAEND,LAEND+1) ; get passed cksum
54 I LACS'=$$CKSUM^LAXSYMU(LAFRAM) D NAK^LAXSYMU("CKSUM") G PH2:LARETRY<7 D SET G PH1
55 ; chk for CR_LF terminating chars - timeout if NULL, NAK for all others
56 I $P(X,(LACRETX_LACS),2)="" D SET G PH1
57 I $P(X,(LACRETX_LACS),2)'=LACRLF D NAK^LAXSYMU("LACRLF") G PH2
58 ;
59 D UPDT^LAXSYMU,SEND^LAXSYMU(ACK) ; frame OK - save & ACK
60 G PH2 ; get nxt frame
61 ;
62GETCH() ; read 1 char at a time. Returns Ascii value of terminating char
63 S ^LA(INST,"R")=$H
64 R *LATEMP:LATOUT
65 S DEBUG=$D(^LA(DEB,0)) ; debug on? (def=off)
66 Q LATEMP
67 ;
68CHK() ; Chk flags - Returns LINE TAG to branch to
69 S ^LA(INST,"R")=$H,LATOUT=30 ; update run-time flag
70 I $D(^LA(INST,"HQ")) S NODE="HQ" Q "DWNLD^LAXSYMDL" ; host query
71 I $D(^LA(INST,"Q")) S NODE="O" Q "DWNLD^LAXSYMDL" ; d/l l/w list
72 I '$D(^LA("STOP",INST)) Q "PH1" ; continue
73 Q "OUT" ; STOP = shutdown
74 ;
75SET ; Re-init vars
76 H 5 ; allow LAXSYM to catch up
77 K LAFRAM,X,LALINK,LAFRNM
78 S LATOUT=5,LAFRAME=""
79 Q:$$CHK["HQ"
80 H 13 ; force timeout & return to idle
81 Q
82 ;
83OUT ; Main Exit - remove flags, close port
84 K ^LA("STOP",INST),^LA(INST),^LA("LOCK","D"_INST)
85 D ^%ZISC
86 Q
87 ;
88TRAP ; Error Trap
89 D ^LABERR S T=TSK
90 D SET^LAB G PH1
91 Q
92 ;
93DQ ;Entry point to task job
94 S LANM=$T(+0),HOME=$E(LANM,7,8) Q:HOME=""!(HOME>99)
95 I $D(^LAB(62.4,HOME,0)),$L($P(^(0),"^",2)) S ZTIO=$P(^(0),"^",2),ZTRTN=LANM,ZTDTH=$H,ZTDESC="START LAB DIRECT CONNECT PORT "_HOME K ^LA("LOCK","D"_HOME) D ^%ZTLOAD
96 Q
Note: See TracBrowser for help on using the repository browser.