LAXSYMBL ;MLD/ABBOTT/SLC/RAF - ABBOTT AxSYM BUILD 'DWNLD' FILE ; 6/12/96 0900; [ 01/12/98 11:20 AM ]
;;5.2;LA;**1001**;DEC 10, 1997
;;5.2;AUTOMATED LAB INSTRUMENTS;**11,19**;Sep 27, 1994
;
Q ; call line tag
;
BLDLST ; Build the worklist in prep for dwnlding to AxSYM
; Called from LADOWN with the following set:
; LRLL = load list pointer
; LRCUP1 = starting cup #
; LRTRAY,LRTRAY1 = starting tray #
; LRINST = Auto Instrument pointer
; LRFORCE = 1 if send tray and cup
;
N I,D,H,P,O,L,X,STX,ETX,CR,LF,CNT,LATEST,LRAN,LRACC,LRAD,LRFRM,SSN
N LRFRAME,LRDFN,LRNAME,INST,LANM,LRTEST
;
L +^LA(LRINST,"O") ; get global 1st!
S D="|",STX=$C(2),ETX=$C(3),LF=$C(10),CR=$C(13),INST=LRINST
S X="ERR^LAXSYMBL",@^%ZOSF("TRAP"),(LRTEST,LRFRAME,I)=0
S LRCUP=LRCUP1-1 ; reset for $ORDER
; LATEST array
F S I=$O(^LAB(62.4,INST,3,I)) Q:'I S X=$G(^(I,0)) S LATEST(+X)=$P(X,U,4)
;
; Main Loop thru Load/Work List file
F S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP)) Q:'LRCUP D GETACCN
;
K LRCUP1,LRCUP2,LRTRAY1 ; not killed in calling routine (LADOWN)
L -^LA(INST,"O") ; release lock
S LREND=1,^LA(INST,"Q")="" ; set dwnld-ready flag
;
QUIT
;
GETACCN ; Get and save work/load list data to downlaod to AxSYM
N LRAA
S LRAA=$G(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP,0)) Q:LRAA=""
S LRAN=$P(LRAA,U,3) Q:LRAN="" ; no accn num
S LRAD=$P(LRAA,U,2) Q:LRAD="" ; no accn date
D PNM Q:LRACC="" ; no accn
S LRAN=$E("0000",$L(LRAN),4)_LRAN ; pad with zeros to 4 digits
D FRAME
Q
;
PNM ; Get patient name and last 4 from an accession.
N DFN,X,PT S (LRACC,DFN,LRNAME)=""
S X=$G(^LRO(68,+LRAA,1,LRAD,1,+LRAN,0)) Q:X="" ; no accn on file
S LRACC=$G(^(.2)),X=^LR(+X,0) ;Q:$P(X,U,2)'=2 ; Naked Ref=^LRO(68,LRAA,1,LRAD,1,+LRAN,.2) & ^LRO(68,LRAA,1,LRAD,1,+LRAN,X,0)
; "patient" could be in one of several files: 2, 62.3, 67, 67.1 etc.
S DFN=$P(X,U,3),PT=$G(^DIC(+$P(X,U,2),0,"GL"))
Q:PT="" ; could not find global ref
S PT=PT_+DFN_",0)",PT=$G(@PT),LRNAME=$P(PT,U),SSN=$P(PT,U,9)
Q
;
FRAME ; Build frame to transmit to AxSYM (stored in ^LA(INST,"O",CNT) nodes)
N I,FRM
F I="H","P","O","L" D ; loop thru frame types
.S LRFRM=$G(LRFRM)+1 S:(LRFRM=8) LRFRM=0 ; increment frame cntr
.S FRM=LRFRM_$S(I="H":$$H,I="P":$$P,I="O":$$O,1:$$L)_CR_ETX
.S CKSM=$$CKSUM^LAXSYMU(FRM) ; CR_ETX is counted in chksum
.; * build msg frame: <STX>~|~msg text~|~<CR><ETX>~checksum~<CR><LF>
.S FRM=STX_FRM_CKSM_CR_LF
.; set frame to ^LA( "O"utput node
.S CNT=$G(^LA(INST,"O"))+1,^LA(INST,"O")=CNT,^LA(INST,"O",CNT)=FRM
;
Q
;
H() ; Build hdr frame
N H S H="H|\^&",$P(H,D,12,13)="P|1"
Q H
;
P() ; Build Patient frame
N P S P="P|1"
; 20 chars is size limit for rev 1.xx 15 will be limit for rev.2!
S $P(P,D,4)=$E(LRACC,1,15)_"^" ; see above re: size limits
S $P(P,D,5)=$G(SSN)
S $P(P,D,6)=$E($P(LRNAME,","),1,20)_U_$E($P($P(LRNAME,",",2)," "),1,20)_U_$E($P(LRNAME," ",2))
Q P
;
O() ; Build Order frame NOTE:
; a. 10 chars is size limit for rev 1.xx 15 will be limit for rev 2
; b. Potential for REPEAT (multiple) tests to cause the Order frame
; to exceed 247 chars! However, if the AxSYM doesn't offer more
; than about 25 tests, this should not be a problem.
;
B N O,CNT,DLM,PRI,LRPRI,LRTEST,LRTST
S (CNT,PRI,LRTEST)=0,LRPRI=9,$P(O,D,5)=""
F S LRTEST=$O(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP,1,LRTEST)) Q:'LRTEST D
.S CNT=CNT+1 S DLM=$S(CNT>1:"\",1:"")
.S LRTST=$$PNL ; get AxSYM's internal tst #
.S:LRTST="" CNT=CNT-1
.Q:LRTST="" ; test not in Auto Inst file
.S $P(O,D,5)=$P(O,D,5)_DLM_"^^^"_LRTST ; 'repeat' tests use '\'
.S PRI=+$P($G(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP,1,LRTEST,0)),U,2)
.I PRI,(PRI<LRPRI) S LRPRI=PRI ; take 'highest' prio
;
S LRPRI=$E($P($G(^LAB(62.05,LRPRI,0)),U)) S:LRPRI="" LRPRI="R"
; 2nd pc is (hardcoded) # of 'O' frames. Change if loop is needed
S $P(O,D,1,3)="O|1|"_LRAN
S $P(O,D,6)=LRPRI,$P(O,D,12)="A",$P(O,D,26)="O"
Q O
;
L() ; Build Last (termination) frame
Q "L|1"
;
PNL() ; Expand panel from load/work list
N CT,I,T,TST,DLM S (CT,I,T)=0,TST=""
Q:$D(LATEST(LRTEST)) LATEST(LRTEST) ; return single test
; expand panel
F S I=$O(^LAB(60,LRTEST,2,I)) Q:'I S T=+$G(^(I,0)) D:T
.S CT=CT+1 S DLM=$S(CT>1:"\^^^",1:"")
.I $D(LATEST(T)) S TST=TST_DLM_LATEST(T)
.I '$D(LATEST(T)) S CT=CT-1
.Q
; Return panel tests that should look like: 321\^^^678\^^^452
Q TST
;
ERR ; Error Trap
D ^LABERR H 1
K ^LA(INST,"O") ; remove incomplete list
L -^LA(INST,"O")
Q
LAXSYMBL ;MLD/ABBOTT/SLC/RAF - ABBOTT AxSYM BUILD 'DWNLD' FILE ; 6/12/96 0900; [ 01/12/98 11:20 AM ]
+1 ;;5.2;LA;**1001**;DEC 10, 1997
+2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**11,19**;Sep 27, 1994
+3 ;
+4 ; call line tag
QUIT
+5 ;
BLDLST ; Build the worklist in prep for dwnlding to AxSYM
+1 ; Called from LADOWN with the following set:
+2 ; LRLL = load list pointer
+3 ; LRCUP1 = starting cup #
+4 ; LRTRAY,LRTRAY1 = starting tray #
+5 ; LRINST = Auto Instrument pointer
+6 ; LRFORCE = 1 if send tray and cup
+7 ;
+8 NEW I,D,H,P,O,L,X,STX,ETX,CR,LF,CNT,LATEST,LRAN,LRACC,LRAD,LRFRM,SSN
+9 NEW LRFRAME,LRDFN,LRNAME,INST,LANM,LRTEST
+10 ;
+11 ; get global 1st!
LOCK +^LA(LRINST,"O")
+12 SET D="|"
SET STX=$CHAR(2)
SET ETX=$CHAR(3)
SET LF=$CHAR(10)
SET CR=$CHAR(13)
SET INST=LRINST
+13 SET X="ERR^LAXSYMBL"
SET @^%ZOSF("TRAP")
SET (LRTEST,LRFRAME,I)=0
+14 ; reset for $ORDER
SET LRCUP=LRCUP1-1
+15 ; LATEST array
+16 FOR
SET I=$ORDER(^LAB(62.4,INST,3,I))
IF 'I
QUIT
SET X=$GET(^(I,0))
SET LATEST(+X)=$PIECE(X,U,4)
+17 ;
+18 ; Main Loop thru Load/Work List file
+19 FOR
SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP))
IF 'LRCUP
QUIT
DO GETACCN
+20 ;
+21 ; not killed in calling routine (LADOWN)
KILL LRCUP1,LRCUP2,LRTRAY1
+22 ; release lock
LOCK -^LA(INST,"O")
+23 ; set dwnld-ready flag
SET LREND=1
SET ^LA(INST,"Q")=""
+24 ;
+25 QUIT
+26 ;
GETACCN ; Get and save work/load list data to downlaod to AxSYM
+1 NEW LRAA
+2 SET LRAA=$GET(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP,0))
IF LRAA=""
QUIT
+3 ; no accn num
SET LRAN=$PIECE(LRAA,U,3)
IF LRAN=""
QUIT
+4 ; no accn date
SET LRAD=$PIECE(LRAA,U,2)
IF LRAD=""
QUIT
+5 ; no accn
DO PNM
IF LRACC=""
QUIT
+6 ; pad with zeros to 4 digits
SET LRAN=$EXTRACT("0000",$LENGTH(LRAN),4)_LRAN
+7 DO FRAME
+8 QUIT
+9 ;
PNM ; Get patient name and last 4 from an accession.
+1 NEW DFN,X,PT
SET (LRACC,DFN,LRNAME)=""
+2 ; no accn on file
SET X=$GET(^LRO(68,+LRAA,1,LRAD,1,+LRAN,0))
IF X=""
QUIT
+3 ;Q:$P(X,U,2)'=2 ; Naked Ref=^LRO(68,LRAA,1,LRAD,1,+LRAN,.2) & ^LRO(68,LRAA,1,LRAD,1,+LRAN,X,0)
SET LRACC=$GET(^(.2))
SET X=^LR(+X,0)
+4 ; "patient" could be in one of several files: 2, 62.3, 67, 67.1 etc.
+5 SET DFN=$PIECE(X,U,3)
SET PT=$GET(^DIC(+$PIECE(X,U,2),0,"GL"))
+6 ; could not find global ref
IF PT=""
QUIT
+7 SET PT=PT_+DFN_",0)"
SET PT=$GET(@PT)
SET LRNAME=$PIECE(PT,U)
SET SSN=$PIECE(PT,U,9)
+8 QUIT
+9 ;
FRAME ; Build frame to transmit to AxSYM (stored in ^LA(INST,"O",CNT) nodes)
+1 NEW I,FRM
+2 ; loop thru frame types
FOR I="H","P","O","L"
Begin DoDot:1
+3 ; increment frame cntr
SET LRFRM=$GET(LRFRM)+1
IF (LRFRM=8)
SET LRFRM=0
+4 SET FRM=LRFRM_$SELECT(I="H":$$H,I="P":$$P,I="O":$$O,1:$$L)_CR_ETX
+5 ; CR_ETX is counted in chksum
SET CKSM=$$CKSUM^LAXSYMU(FRM)
+6 ; * build msg frame: <STX>~|~msg text~|~<CR><ETX>~checksum~<CR><LF>
+7 SET FRM=STX_FRM_CKSM_CR_LF
+8 ; set frame to ^LA( "O"utput node
+9 SET CNT=$GET(^LA(INST,"O"))+1
SET ^LA(INST,"O")=CNT
SET ^LA(INST,"O",CNT)=FRM
End DoDot:1
+10 ;
+11 QUIT
+12 ;
H() ; Build hdr frame
+1 NEW H
SET H="H|\^&"
SET $PIECE(H,D,12,13)="P|1"
+2 QUIT H
+3 ;
P() ; Build Patient frame
+1 NEW P
SET P="P|1"
+2 ; 20 chars is size limit for rev 1.xx 15 will be limit for rev.2!
+3 ; see above re: size limits
SET $PIECE(P,D,4)=$EXTRACT(LRACC,1,15)_"^"
+4 SET $PIECE(P,D,5)=$GET(SSN)
+5 SET $PIECE(P,D,6)=$EXTRACT($PIECE(LRNAME,","),1,20)_U_$EXTRACT($PIECE($PIECE(LRNAME,",",2)," "),1,20)_U_$EXTRACT($PIECE(LRNAME," ",2))
+6 QUIT P
+7 ;
O() ; Build Order frame NOTE:
+1 ; a. 10 chars is size limit for rev 1.xx 15 will be limit for rev 2
+2 ; b. Potential for REPEAT (multiple) tests to cause the Order frame
+3 ; to exceed 247 chars! However, if the AxSYM doesn't offer more
+4 ; than about 25 tests, this should not be a problem.
+5 ;
+6 BREAK
NEW O,CNT,DLM,PRI,LRPRI,LRTEST,LRTST
+7 SET (CNT,PRI,LRTEST)=0
SET LRPRI=9
SET $PIECE(O,D,5)=""
+8 FOR
SET LRTEST=$ORDER(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP,1,LRTEST))
IF 'LRTEST
QUIT
Begin DoDot:1
+9 SET CNT=CNT+1
SET DLM=$SELECT(CNT>1:"\",1:"")
+10 ; get AxSYM's internal tst #
SET LRTST=$$PNL
+11 IF LRTST=""
SET CNT=CNT-1
+12 ; test not in Auto Inst file
IF LRTST=""
QUIT
+13 ; 'repeat' tests use '\'
SET $PIECE(O,D,5)=$PIECE(O,D,5)_DLM_"^^^"_LRTST
+14 SET PRI=+$PIECE($GET(^LRO(68.2,LRLL,1,LRTRAY1,1,LRCUP,1,LRTEST,0)),U,2)
+15 ; take 'highest' prio
IF PRI
IF (PRI<LRPRI)
SET LRPRI=PRI
End DoDot:1
+16 ;
+17 SET LRPRI=$EXTRACT($PIECE($GET(^LAB(62.05,LRPRI,0)),U))
IF LRPRI=""
SET LRPRI="R"
+18 ; 2nd pc is (hardcoded) # of 'O' frames. Change if loop is needed
+19 SET $PIECE(O,D,1,3)="O|1|"_LRAN
+20 SET $PIECE(O,D,6)=LRPRI
SET $PIECE(O,D,12)="A"
SET $PIECE(O,D,26)="O"
+21 QUIT O
+22 ;
L() ; Build Last (termination) frame
+1 QUIT "L|1"
+2 ;
PNL() ; Expand panel from load/work list
+1 NEW CT,I,T,TST,DLM
SET (CT,I,T)=0
SET TST=""
+2 ; return single test
IF $DATA(LATEST(LRTEST))
QUIT LATEST(LRTEST)
+3 ; expand panel
+4 FOR
SET I=$ORDER(^LAB(60,LRTEST,2,I))
IF 'I
QUIT
SET T=+$GET(^(I,0))
IF T
Begin DoDot:1
+5 SET CT=CT+1
SET DLM=$SELECT(CT>1:"\^^^",1:"")
+6 IF $DATA(LATEST(T))
SET TST=TST_DLM_LATEST(T)
+7 IF '$DATA(LATEST(T))
SET CT=CT-1
+8 QUIT
End DoDot:1
+9 ; Return panel tests that should look like: 321\^^^678\^^^452
+10 QUIT TST
+11 ;
ERR ; Error Trap
+1 DO ^LABERR
HANG 1
+2 ; remove incomplete list
KILL ^LA(INST,"O")
+3 LOCK -^LA(INST,"O")
+4 QUIT
