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

LAXSYMU.m

Go to the documentation of this file. 
  1. LAXSYMU ;MLD/ABBOTT/SLC/RAF - AxSYM INTERFACE Utility Routine; 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 serves as general UTILITY routine for the AxSYM
  1.  ; interface.  While not as efficient as all code being in ONE
  1.  ; routine, portability requirements must be met.       /mld
  1.  ;
  1.  Q  ; call line tag
  1.  ;
  1. UPDT ; To LA global ($TR used to remove CTRL chars from LAFRAM)
  1.  L +^LA(INST,"I")
  1.  I '$D(^LA(INST,"I")) X $G(^LAB(62.4,INST,1)) ; runs LAXSYM (LA->LAH)
  1.  S:'$D(^LA(INST,"I"))#2 ^LA(INST,"I")=0,^("I",0)=0
  1.  S CNT=$G(^LA(INST,"I"))+1,^("I")=CNT,^("I",CNT)=$TR(LAFRAM,LANOCTL1)
  1.  K LAFRAM,X
  1.  S LAFRAME="",LARETRY=0,LALINK=0
  1.  L -^LA(INST,"I")
  1.  Q
  1.  ;
  1. CKSUM(S,MOD) ; convert string (S) to decimal num (N) then to 
  1.  ;         hex modulo 16**MOD (def=2=256)
  1.  N I,HX,HXN,DIV,N S N=0,DIV=1 S:'$D(MOD) MOD=2
  1.  F I=1:1:$L(S) S N=N+$A(S,I) ; get ASCII chars in string S
  1.  F I=1:1:MOD S DIV=16*DIV ;    get MOD value (def=16*16)
  1.  S HX=N#DIV,N=""
  1.  F  Q:HX=0  S HXN=HX#16,HX=HX\16,N=$S(HXN>9:$E("ABCDEF",HXN#10+1),1:HXN)_N
  1.  S N="00000000"_N,N=$E(N,$L(N)-MOD+1,$L(N))
  1.  Q N
  1.  ;
  1. SEND(N) ; Send reply msg (ACK, NAK, etc.)
  1.  W $C(N)
  1.  D:DEBUG DEBG(N,"O")
  1.  Q
  1.  ;
  1. DEBG(A,B) ; DEBuG tool - capture all data going in & out.  (Def=OFF)
  1.  ; A=data that went out/came in  B="I"=IN; "O"=OUT
  1.  N MSG,CT
  1.  S MSG=$S(B="I":"IN: ",1:"OUT: ")_A_" %^% "_$H
  1.  S (CT,^LA(DEB,0))=$G(^LA(DEB,0))+1,^LA(DEB,CT)=MSG
  1.  Q
  1.  ;
  1. NAK(M) ; send NAK and retry (M = error 'type', EOT, STX, etc.)
  1.  S ^LA(INST,"ERR",$H,M)=LAFRAME ; capture
  1.  S LAFRAME="",LARETRY=LARETRY+1 ; increment # retries
  1.  I LARETRY=7 D SEND(EOT),@("SET^"_LANM) Q  ; too many NAK's - goto idle
  1.  I 'LALINK S LAFRNM=$S(LAFRNM:LAFRNM-1,1:7) ; LALINK=1 on 1ST frame
  1.  K LAFRAM,X
  1.  D SEND(NAK)
  1.  Q
  1.  ;
  1. LA1INIT ; Init vars only for LAXSYM
  1.  S X="TRAP^"_LANM,@^%ZOSF("TRAP"),I=0,LANOCTL1=""
  1.  S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  1.  F  S I=$O(TC(I)) Q:'I  I $G(TC(I,4)) S LATEST(TC(I,4),TC(I,0))=I
  1.  F I=1:1:31 S LANOCTL1=LANOCTL1_$C(I) ; ctl chars
  1.  Q
  1.  ;
  1.  ; Continuation of LAPORT33 (LANM) due to size req'mts /mld
  1. INIT ; initialize various parameters for the AxSYM
  1.  ;
  1.  S (HOME,T,TSK,INST)=+$E(LANM,7,8),LANOCTL1=""
  1.  S X="TRAP^"_LANM,@^%ZOSF("TRAP"),DUZ=.5,LANOCTL2=""
  1.  S DEB="D"_INST,OUT="",BASE=0,OK=0
  1.  S TOUT=5,U="^",(LADEV,IOP)=$G(^LAB(62.4,INST,.75))
  1.  I $D(^LA(INST,"R")) D  Q:$D(^LA(INST,"R"))
  1.  .S LRCHK=^LA(INST,"R") H 35 S LRCHK1=^LA(INST,"R") D
  1.  ..I LRCHK'=LRCHK1 S ^LA(INST,"ERR",$H)="LAPORT"_INST_" is already running ...aborted" K LRCHK,LRCHK1 Q
  1.  ..I LRCHK=LRCHK1 K LRCHK,LRCHK1,^LA(INST,"R"),^LA("LOCK","D"_INST) Q
  1.  ;
  1.  H 1 ; allows calling routine to close port before opening again
  1.  I LADEV="" D  Q
  1.  .S ^LA(INST,"ERR",$H)="DIRECT DEVICE field is empty!  aborted"
  1. ZIS D ^%ZIS I POP D  Q
  1.  .S ^LA(INST,"ERR",$H)=LADEV_" was busy .... aborted"
  1.  ;
  1.  ; set READ timeout, terminating chars, max character count
  1.  S NUL=0,SOH=1,STX=2,ETX=3,EOT=4,ENQ=5,ACK=6,NAK=21,ETB=23,LF=10,CR=13
  1.  S (CNT,LARETRY,LAFRNM)=0,LATOUT=75,DEBUG=0,OK=1
  1.  S LACRLF=$C(CR)_$C(LF),LACRETX=$C(CR)_$C(ETX)
  1.  F I=3,13,23 S LANOCTL1=LANOCTL1_$C(I) ; to remove ctl chars from LAFRAM
  1.  ; LANOCTL2=restricted chars - 3,4,13,23 (ETX,EOT,CR,ETB) are OK
  1.  F I=1,2,5:1:12,14:1:22,24:1:31 S LANOCTL2=LANOCTL2_$C(I)
  1.  ; start fresh
  1.  K ^LA(INST,"ERR"),^LA(INST,"ERX")
  1.  I $D(^LA(DEB,0)) K ^LA(DEB) S ^LA(DEB,0)=0 ;clean out debug node
  1.  S ^LA(INST,"R")=$H,^LA("LOCK","D"_INST)=$J ; running flag
  1.  Q
  1.  ;
  1. BKGND ; Entry point to start ANY bi-directional background job /mld
  1.  N DIC,DIR,DIRUT,LRDASH,LRJOB,LRJOBIO,LRJOBN,LRJOBNM,T,X,Y,ZTSK
  1.  S IOP=0 D ^%ZIS
  1.  S $P(LRDASH,"-",IOM)=""
  1.  S DIC=62.4,DIC(0)="AEMQ",DIC("S")="I Y<99,$G(^(.75))]""""" D ^DIC K DIC
  1.  I Y<1 W !,"NO JOB SELECTED",! H 1 QUIT
  1.  S LRJOBN=+Y,LRJOBNM=$P(Y,"^",2),LRJOB="LAPORT"_LRJOBN
  1.  S (LRJOBIO,X)=$G(^LAB(62.4,LRJOBN,.75)) ; direct device field
  1.  S IOP=X,%ZIS="" D ^%ZIS
  1.  I POP D  H 1 QUIT
  1.  .D HOME^%ZIS
  1.  .W !!,?3,$C(7),"Unable to open ",LRJOBIO," for instrument ",LRJOBNM,"."
  1.  .W !,?3,"This would indicate that the interface is already running.",!
  1.  D ^%ZISC
  1.  W !!
  1.  S DIR(0)="Y0",DIR("A")="Start the direct connect "_LRJOBNM_" interface now",DIR("B")="NO"
  1.  D ^DIR K DIR Q:Y'=1
  1.  S ZTRTN=LRJOB,ZTIO=LRJOBIO,ZTDTH=$H,ZTDESC="Lab Direct Connect Port"_LRJOBN
  1.  K ^LA("LOCK","D"_LRJOBN)
  1.  D ^%ZTLOAD
  1.  W !,"Lab Direct Connect Interface for ",LRJOBNM,$S($D(ZTSK):"",1:" NOT")," tasked to start",!
  1.  I $G(ZTSK) W "Task #",ZTSK,!
  1.  Q