Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LAPORT33

LAPORT33.m

Go to the documentation of this file. 
  1. LAPORT33 ;MLD/ABBOTT/SLC/RAF - AxSYM BIDRECTIONAL INTERFACE ; 6/12/96 0900 [ 01/12/98  11:20 AM ]
  1.  ;;5.2;LA;**1001**;DEC 10, 1997
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**11,19**;Sep 27, 1994
  1.  ;
  1.  ; This routine LOOSELY follows the LAPORTXX template.  However, this
  1.  ; routine works ONLY for Abbott's AxSYM machine, and should comply
  1.  ; with ASTM communication protocols.  This pgm will run continuously
  1.  ; as a background job until the system is taken down OR ^LA("STOP",INST)
  1.  ; global flag is set.  /mld
  1.  ;
  1.  N LARETRY,LATOUT,LATEMP,LAFRAME,LAFRAM,LAEND,LACS,LAFRNUM,LADEV
  1.  N LAFRNM,LALINK,LACRLF,LACRETX,LANOCTL1,LANOCTL2,LADATA,LANM
  1.  N I,J,T,X,Y,INST,DEB,HOME,BASE,OUT,TOUT,PAR,TSK,NODE,OK,DEBUG,CNT
  1.  N NUL,SOH,STX,ETX,EOT,ENQ,ACK,NAK,ETB,LF,CR ; *control chars*
  1.  ;
  1.  S LANM=$T(+0),(HOME,T)=+$E(LANM,7,8) Q:+T<1  Q:$D(^LA("LOCK","D"_T))
  1.  ; init req'd params
  1.  D INIT^LAXSYMU I 'OK QUIT  ; chk ^LA(INST,"ERR",$H) for err msg
  1.  ;
  1. PH1 ; PHase1 - idle/establish link (wait for AxSYM to send data)
  1.  S LADATA=$$GETCH I DEBUG D DEBG^LAXSYMU(LADATA,"I")
  1.  I LADATA=-1 G @($$CHK) ; idle - chk flags
  1.  I LADATA'=ENQ G PH1 ; read until ENQ rec'd
  1.  ; AxSYM ready to send data so init vars, ACK and drop to PH2
  1.  S LAFRAME="",LARETRY=0,LATOUT=15,LAFRNM=0,LALINK=1
  1.  D SEND^LAXSYMU(ACK)
  1.  ;
  1. PH2 ; PHase2 - transfer data (build frame)
  1.  S LADATA=$$GETCH
  1.  I LADATA=-1 D SET G PH1 ; timed out - goto idle
  1.  S LAFRAME=LAFRAME_$C(LADATA) ; build frame
  1.  I $L(LAFRAME)>247 D NAK^LAXSYMU("SIZE") G:LARETRY<7 PH2 D SET G PH1
  1.  I LADATA=LF G PH3 ; LF=complete frame
  1.  I LADATA=EOT G PH3 ; no more data
  1.  G PH2
  1.  ;
  1. PH3 ; PHase3 (validate frame)
  1.  D:DEBUG DEBG^LAXSYMU(LAFRAME,"I") ; debug
  1.  S X=LAFRAME
  1.  I $F(X,$C(EOT)) D SET G PH1 ; EOT not allowed in txt
  1.  I $A(X)'=STX D SET G PH1 ; 1st char must be STX
  1.  ; txt must end w/ ETX or ETB
  1.  S LAEND=$S($F(X,$C(ETX)):$F(X,$C(ETX)),1:$F(X,$C(ETB)))
  1.  I 'LAEND D NAK^LAXSYMU("LAEND") G PH2:LARETRY<7 D SET G PH1
  1.  ;
  1.  S LAFRAM=$E(X,2,LAEND-1) ; get msg txt
  1.  ; chk frame numbering sequence
  1.  S LAFRNUM=+LAFRAM,LAFRNM=$S(LAFRNM<7:LAFRNM+1,1:0)
  1.  I LAFRNM'=LAFRNUM D NAK^LAXSYMU("NUMSQNC") G PH2:LARETRY<7 D SET G PH1
  1.  I LAFRNUM'=(LAFRNUM#8) D NAK^LAXSYMU("FRNUM") G PH2:LARETRY<7 D SET G PH1
  1.  ; chk restricted control chars in txt
  1.  I LAFRAM'=$TR(LAFRAM,LANOCTL2) D NAK^LAXSYMU("CTL") G PH2:LARETRY<7 D SET G PH1
  1.  ; sent checksum must = received checksum
  1.  S LACS=$E(X,LAEND,LAEND+1) ; get passed cksum
  1.  I LACS'=$$CKSUM^LAXSYMU(LAFRAM) D NAK^LAXSYMU("CKSUM") G PH2:LARETRY<7 D SET G PH1
  1.  ; chk for CR_LF terminating chars - timeout if NULL, NAK for all others
  1.  I $P(X,(LACRETX_LACS),2)="" D SET G PH1
  1.  I $P(X,(LACRETX_LACS),2)'=LACRLF D NAK^LAXSYMU("LACRLF") G PH2
  1.  ;
  1.  D UPDT^LAXSYMU,SEND^LAXSYMU(ACK) ; frame OK - save & ACK
  1.  G PH2 ; get nxt frame
  1.  ;
  1. GETCH() ; read 1 char at a time. Returns Ascii value of terminating char
  1.  S ^LA(INST,"R")=$H
  1.  R *LATEMP:LATOUT
  1.  S DEBUG=$D(^LA(DEB,0)) ; debug on? (def=off)
  1.  Q LATEMP
  1.  ;
  1. CHK() ; Chk flags - Returns LINE TAG to branch to
  1.  S ^LA(INST,"R")=$H,LATOUT=30 ; update run-time flag
  1.  I $D(^LA(INST,"HQ")) S NODE="HQ" Q "DWNLD^LAXSYMDL" ; host query
  1.  I $D(^LA(INST,"Q")) S NODE="O" Q "DWNLD^LAXSYMDL" ; d/l l/w list
  1.  I '$D(^LA("STOP",INST)) Q "PH1" ; continue
  1.  Q "OUT" ; STOP = shutdown
  1.  ;
  1. SET ; Re-init vars
  1.  H 5 ; allow LAXSYM to catch up
  1.  K LAFRAM,X,LALINK,LAFRNM
  1.  S LATOUT=5,LAFRAME=""
  1.  Q:$$CHK["HQ"
  1.  H 13 ; force timeout & return to idle
  1.  Q
  1.  ;
  1. OUT ; Main Exit - remove flags, close port
  1.  K ^LA("STOP",INST),^LA(INST),^LA("LOCK","D"_INST)
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. TRAP ; Error Trap
  1.  D ^LABERR S T=TSK
  1.  D SET^LAB G PH1
  1.  Q
  1.  ;
  1. DQ ;Entry point to task job
  1.  S LANM=$T(+0),HOME=$E(LANM,7,8) Q:HOME=""!(HOME>99)
  1.  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
  1.  Q