- LAXSYMHQ ;MLD/ABBOTT/SLC/RAF - ABBOTT AxSYM 'HOST QUERY' PGM ; 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
- ;
- HQSET ; Build hst qry to send to AxSYM (stored in ^LA(INST,"HQ",CNT) nodes)
- ; called from Q^LAXSYM
- N I,FRM,CR,ETX,CKSM,STX,LF,CNT,X,EOT,LATEST
- S X="ERR^LAXSYMHQ",@^%ZOSF("TRAP"),(LRTST,I)=0
- S CNT=0,LF=$C(10),STX=$C(2),ETX=$C(3),CR=$C(13),EOT=4
- ;
- ; 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)
- L +^LA(INST,"HQ")
- 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^LAXSYMBL,I="P":$$P^LAXSYMBL,I="O":$$O,1:$$L^LAXSYMBL)_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(,"HQ" node
- .S CNT=$G(^LA(INST,"HQ"))+1,^LA(INST,"HQ")=CNT,^LA(INST,"TMPHQ",CNT)=FRM
- OUT I $G(HQBAD)=0 D ;positive query response sets
- .M ^LA(INST,"HQ")=^LA(INST,"TMPHQ")
- I $G(HQBAD)=1 D ;negative query response sets
- .S FRM=^LA(INST,"TMPHQ",3),FRM="2Q|"_$P(FRM,"|",2,12)_"|X"_CR_ETX
- .S ^LA(INST,"TMPHQ",2)=STX_FRM_$$CKSUM^LAXSYMU(FRM)_CR_LF
- .S FRM=^LA(INST,"TMPHQ",4),FRM="3L|1"_CR_ETX
- .S ^LA(INST,"TMPHQ",3)=STX_FRM_$$CKSUM^LAXSYMU(FRM)_CR_LF
- .S ^LA(INST,"HQ")=3 K ^LA(INST,"TMPHQ",4)
- .M ^LA(INST,"HQ")=^LA(INST,"TMPHQ")
- K ^LA(INST,"TMPHQ")
- L -^LA(INST,"HQ")
- QUIT
- ;
- O() ; Build Order frame NOTEs:
- ; 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.
- ;
- Q:$G(BAD) IN ; cannot process request - set in Q^LAXSYM
- N O,CNT,DLM,PRI,LRPRI,LRTEST,LRTST
- S (CNT,PRI,LRTEST,HQBAD)=0,LRPRI=9,$P(O,D,5)=""
- F S LRTEST=$O(^LRO(68,WL,1,LADT,1,+LRAN,4,LRTEST)) Q:'LRTEST D
- .Q:$L($P(^LRO(68,WL,1,LADT,1,+LRAN,4,LRTEST,0),U,5))
- .S CNT=CNT+1 S DLM=$S(CNT>1:"\",1:"")
- .S LRTST=$$PNL^LAXSYMBL ; 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,WL,1,LADT,1,+LRAN,4,LRTEST,0)),U,2)
- .I PRI,(PRI<LRPRI) S LRPRI=PRI ; take 'highest' prio
- ;
- ; If no orders can be found, return orig query with 'X'
- I $P(O,D,5)="" S $P(IN,D,13)="X",HQBAD=1 Q IN
- ;
- 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)="Q"
- Q O
- ;
- ERR ; Error Trap
- D ^LABERR
- K ^LA(INST,"HQ") ; remove bad data/incomplete list
- G OUT
- LAXSYMHQ ;MLD/ABBOTT/SLC/RAF - ABBOTT AxSYM 'HOST QUERY' PGM ; 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 ;
- HQSET ; Build hst qry to send to AxSYM (stored in ^LA(INST,"HQ",CNT) nodes)
- +1 ; called from Q^LAXSYM
- +2 NEW I,FRM,CR,ETX,CKSM,STX,LF,CNT,X,EOT,LATEST
- +3 SET X="ERR^LAXSYMHQ"
- SET @^%ZOSF("TRAP")
- SET (LRTST,I)=0
- +4 SET CNT=0
- SET LF=$CHAR(10)
- SET STX=$CHAR(2)
- SET ETX=$CHAR(3)
- SET CR=$CHAR(13)
- SET EOT=4
- +5 ;
- +6 ; LATEST array
- +7 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)
- +8 LOCK +^LA(INST,"HQ")
- +9 ; loop thru frame types
- FOR I="H","P","O","L"
- Begin DoDot:1
- +10 ; increment frame cntr
- SET LRFRM=$GET(LRFRM)+1
- IF (LRFRM=8)
- SET LRFRM=0
- +11 SET FRM=LRFRM_$SELECT(I="H":$$H^LAXSYMBL,I="P":$$P^LAXSYMBL,I="O":$$O,1:$$L^LAXSYMBL)_CR_ETX
- +12 ; CR_ETX is counted in chksum
- SET CKSM=$$CKSUM^LAXSYMU(FRM)
- +13 ; build msg frame: <STX>~|~msg text~|~<CR><ETX>~checksum~<CR><LF>
- +14 SET FRM=STX_FRM_CKSM_CR_LF
- +15 ; set frame to ^LA(,"HQ" node
- +16 SET CNT=$GET(^LA(INST,"HQ"))+1
- SET ^LA(INST,"HQ")=CNT
- SET ^LA(INST,"TMPHQ",CNT)=FRM
- End DoDot:1
- OUT ;positive query response sets
- IF $GET(HQBAD)=0
- Begin DoDot:1
- +1 MERGE ^LA(INST,"HQ")=^LA(INST,"TMPHQ")
- End DoDot:1
- +2 ;negative query response sets
- IF $GET(HQBAD)=1
- Begin DoDot:1
- +3 SET FRM=^LA(INST,"TMPHQ",3)
- SET FRM="2Q|"_$PIECE(FRM,"|",2,12)_"|X"_CR_ETX
- +4 SET ^LA(INST,"TMPHQ",2)=STX_FRM_$$CKSUM^LAXSYMU(FRM)_CR_LF
- +5 SET FRM=^LA(INST,"TMPHQ",4)
- SET FRM="3L|1"_CR_ETX
- +6 SET ^LA(INST,"TMPHQ",3)=STX_FRM_$$CKSUM^LAXSYMU(FRM)_CR_LF
- +7 SET ^LA(INST,"HQ")=3
- KILL ^LA(INST,"TMPHQ",4)
- +8 MERGE ^LA(INST,"HQ")=^LA(INST,"TMPHQ")
- End DoDot:1
- +9 KILL ^LA(INST,"TMPHQ")
- +10 LOCK -^LA(INST,"HQ")
- +11 QUIT
- +12 ;
- O() ; Build Order frame NOTEs:
- +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 to
- +3 ; exceed 247 chars! However, if the AxSYM doesn't offer more than
- +4 ; about 25 tests, this should not be a problem.
- +5 ;
- +6 ; cannot process request - set in Q^LAXSYM
- IF $GET(BAD)
- QUIT IN
- +7 NEW O,CNT,DLM,PRI,LRPRI,LRTEST,LRTST
- +8 SET (CNT,PRI,LRTEST,HQBAD)=0
- SET LRPRI=9
- SET $PIECE(O,D,5)=""
- +9 FOR
- SET LRTEST=$ORDER(^LRO(68,WL,1,LADT,1,+LRAN,4,LRTEST))
- IF 'LRTEST
- QUIT
- Begin DoDot:1
- +10 IF $LENGTH($PIECE(^LRO(68,WL,1,LADT,1,+LRAN,4,LRTEST,0),U,5))
- QUIT
- +11 SET CNT=CNT+1
- SET DLM=$SELECT(CNT>1:"\",1:"")
- +12 ; get AxSYM's internal tst #
- SET LRTST=$$PNL^LAXSYMBL
- +13 IF LRTST=""
- SET CNT=CNT-1
- +14 ; test not in Auto Inst file
- IF LRTST=""
- QUIT
- +15 ; 'repeat' tests use '\'
- SET $PIECE(O,D,5)=$PIECE(O,D,5)_DLM_"^^^"_LRTST
- +16 SET PRI=+$PIECE($GET(^LRO(68,WL,1,LADT,1,+LRAN,4,LRTEST,0)),U,2)
- +17 ; take 'highest' prio
- IF PRI
- IF (PRI<LRPRI)
- SET LRPRI=PRI
- End DoDot:1
- +18 ;
- +19 ; If no orders can be found, return orig query with 'X'
- +20 IF $PIECE(O,D,5)=""
- SET $PIECE(IN,D,13)="X"
- SET HQBAD=1
- QUIT IN
- +21 ;
- +22 SET LRPRI=$EXTRACT($PIECE($GET(^LAB(62.05,LRPRI,0)),U))
- IF LRPRI=""
- SET LRPRI="R"
- +23 ; 2nd pc is (hardcoded) # of 'O' frames. Change if loop is needed
- +24 SET $PIECE(O,D,1,3)="O|1|"_LRAN
- +25 SET $PIECE(O,D,6)=LRPRI
- SET $PIECE(O,D,12)="A"
- SET $PIECE(O,D,26)="Q"
- +26 QUIT O
- +27 ;
- ERR ; Error Trap
- +1 DO ^LABERR
- +2 ; remove bad data/incomplete list
- KILL ^LA(INST,"HQ")
- +3 GOTO OUT
