| 1 | LAKERM2 ;SLC/RWF/DLG - BUILD A KERMIT FILE TO SEND THRU LSI ;7/20/90 09:25 ;
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
|---|
| 3 | ;Call with X=data, LAKTYPE=record type, TSK=instrument #
|
|---|
| 4 | ;Files the records in ^LA(TSK,"O",n)
|
|---|
| 5 | Q
|
|---|
| 6 | L1 S:'$D(LAKRM) LAKRM=94,LAKSEQ=0 S:LAKTYPE="S" LAKSEQ=0
|
|---|
| 7 | I LAKTYPE'="S" D POUND:X["#",QCTRL:X?.E1C.E
|
|---|
| 8 | F IX2=0:0 D L2 Q:X']""
|
|---|
| 9 | Q
|
|---|
| 10 | L2 S LAKSPK=$C(LAKSEQ+32)_LAKTYPE_$E(X,1,+LAKRM),X=$E(X,LAKRM+1,299)
|
|---|
| 11 | D SPACK^LAKERMIT S LAKSEQ=LAKSEQ+1#64
|
|---|
| 12 | L ^LA(TSK) S O=^LA(TSK,"O")+1,^("O")=O,^("O",O)=LAKSPK L
|
|---|
| 13 | Q
|
|---|
| 14 | POUND F I=2:1 S I=$F(X,"#",I) Q:I<1 S X=$E(X,1,I-2)_"#"_$E(X,I-1,999)
|
|---|
| 15 | Q
|
|---|
| 16 | QCTRL F I=2:1 Q:I>$L(X) I $A(X,I)<32 S X=$E(X,1,I-1)_"#"_$C($A(X,I)+32)_$E(X,I+1,999)
|
|---|
| 17 | Q
|
|---|
| 18 | START ;A call is made to here once to do setup.
|
|---|
| 19 | S LAKTYPE="S",X="~} @-#N1" D L1
|
|---|
| 20 | Q
|
|---|
| 21 | END ;At the end of data a call is made to here.
|
|---|
| 22 | S LAKTYPE="Z",X="" D L1 S LAKTYPE="B",X="" D L1,SEND L G QUIT
|
|---|
| 23 | Q
|
|---|
| 24 | SEND L ^LA(TSK,"P") Q:$S($D(^LA(TSK,"P")):$P(^("P"),"^",2),1:"QUIT")'="QUIT" Q:'$D(^LA(TSK,"O",0)) Q:^LA(TSK,"O")'>^LA(TSK,"O",0)
|
|---|
| 25 | S ^LA(TSK,"P")="KERMIT^OUT",^("P3")=0,T=TSK L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L
|
|---|
| 26 | Q
|
|---|
| 27 | DATA ;A call is made to here for each record in the load list.
|
|---|
| 28 | S LAKTYPE="D" D L1 Q
|
|---|
| 29 | Q
|
|---|
| 30 | NEXT ;Finish old file start new.
|
|---|
| 31 | I LAKTYPE'="S" S LAKTYPE="Z" D L1
|
|---|
| 32 | S LAKTYPE="F",X="S "_LRFILE D L1
|
|---|
| 33 | Q
|
|---|
| 34 | QUIT K C,CHKSUM,LAKRM,LAKSEQ,LAKSPK,LAKTYPE,X,O
|
|---|
| 35 | Q
|
|---|
