LAMIVTLD ;SLC/RWF/DAL/DRH-VITEK BUILD DOWNLOAD FILE ;7/18/89 11:51
;;5.2;AUTOMATED LAB INSTRUMENTS;**12,33,42,48**;Sep 27, 1994
;Call with LRLL = load list to build
;Call with LRINST = Auto Instrument pointer
A ;
;
S:$D(ZTQUEUED) ZTREQ="@"
S:'$D(T) T=LRINST
D:'$D(^LA(LRINST,"O")) SETO^LAB S LREND=""
Q:'$D(^LRO(68.2,LRLL,1,LRTRAY1))
S:'$D(^LA(T,"P3")) ^("P3")=0 S ^("P3")=^("P3")+1
;
S SZ=$P(^LAB(69.9,1,1),U,7) ;---Download full data
;
F LRTRAY=LRTRAY1:0 Q:+LRTRAY'>0 D:$D(^LRO(68.2,LRLL,1,LRTRAY)) TRAY D
. S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0
;
S LRECORD=$C(4)
D SEN
TIK ;
I $D(^LA("TP")) L +^LA("TP"):10 S C=1+^LA("TP",0),^(0)=C,^LA("TP",C)=T_"^Sent:~E" L -^LA("TP"):10
;
L +^LA("Q"):10 S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L -^LA("Q"):10
D NEW^LASET
;
K C,CNT,DOB,I,J,LRAA,LRAD,LRADAT,LRADIA,LRAN,LRCOM,LRCTY,LRCUP,LRDC,LRDPF,LRECORD,LRNDA,LRPMD,PRPNM,LRPRE,LRRD,LRRT,LRS,LRSERV,LRSI,LRSP,LRSPEC,LRSSN,LRSUM,LRTC,LRWARD,LRWRD,PNM,Q,SEX,SSN,SZ,T Q
;-----------------------------------------------------------------------
TRAY ;
F LRCUP=0:0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:+LRCUP'>0 D
. S LRECORD=$C(5) D SEN,BLD S LRECORD=$C(4) D SEN
Q
BLD ;
S LRECORD=$C(2)
D SEN
S LRSUM=0,LRECORD=$C(30)_"mtmpr|"
D SAMPLE S LRECORD=$C(3) D SEN
QUIT
;
;-----------------------------------------------------------------------
SAMPLE ;
S (LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)=""
S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)
S LRAA=+LRL
S LRAD=$P(LRL,U,2)
S LRAN=$P(LRL,U,3)
D PNM
I LRSSN']"" S LRECORD=LRECORD_"|pi"_LRAN D SUM G M
I 'SZ S LRECORD=LRECORD_"|pi"_LRSSN D SUM G M
S LRECORD=LRECORD_"pn"_$G(PNM)_"|pi"_$G(LRSSN)_"|"
S:DOB]"" LRECORD=LRECORD_"pb"_DOB_"|"
S:SEX]"" LRECORD=LRECORD_"ps"_SEX_"|"
;
;
I LRWRD]"" D
. S LRWRD=$S($L($P(LRWRD," ",1)_" "_$P(LRWRD," ",2))<7:$P(LRWRD," ",1)_" "_$P(LRWRD," ",2),1:$P(LRWRD," ",1)),LRWRD=$E(LRWRD,1,6)
. S LRECORD=LRECORD_"pl"_$E(LRWRD,1,6)_"|"
;
;---------put in chk for setup wild cards-----------
D ^LAMIVTL6
;S:LRWRD]"" LRECORD=LRECORD_"|w1"_LRWRD_"|"
D:$L(LRECORD)>1 SUM
;----------------------End Patient section------------------------------
;
S LRECORD=$C(30)
S:LRS]"" LRECORD=LRECORD_"px"_$G(LRS)_"|"
S:LRADIA]"" LRECORD=LRECORD_"po"_LRADIA_"|"
S:LRADAT]"" LRECORD=LRECORD_"pa"_LRADAT_"|" D:$L(LRECORD)>1 SUM
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRWARD=$P(X,"^",7) S:LRWARD="" LRWARD="UNK" S LRSERV=$P(X,"^",9)
;
S LRSERV=$G(VAIN(3))
S LRDOC=$P(X,"^",8)
S:LRDOC]"" LRDOC=$P($G(^VA(200,+LRDOC,0)),U)
S:LRDOC="" LRDOC="UNKNOWN"
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRDC=$P(X,"^",1)
S LRTC=$P(LRDC,".",2)
S LRTC=$E(LRTC_"0000",1,2)_":"_$E(LRTC_"0000",3,4)
S LRDC=$$Y2K^LRX(LRDC)
S LRRD=$P(X,"^",3)
S LRRT=$P(LRRD,".",2)
S LRRT=$E(LRRT_"0000",1,2)_":"_$E(LRRT_"0000",3,4)
S LRRD=$$Y2K^LRX(LRRD)
S LRCOM=$P(X,"^",6),X=""
M F LRSPEC=0:0 S LRSPEC=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC)) Q:LRSPEC'>0 D T2
;
Q
PNM ;Get patient name and SSN from an accession.
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
S X=^LR(+X,0)
S LRPNM="" S LRDPF=$P(X,U,2),DFN=$P(X,"^",3) D PT^LRX
D ^VADPT D INP^VADPT
S:$D(SSN) LRSSN=$E(SSN,1,3)_$E(SSN,5,6)_$E(SSN,8,11)
;----fileman can do this----------------------------------
S DOB=$$Y2K^LRX(DOB)
S (LRS,LRADIA,LRPMD,LRADAT)=""
QUIT
;-------------------End patient Look-up--------------------------------
;
T2 ;
;-----\/------------------Bashfull ref. must go!
;
S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC,0))
S LRSP=$P(^LAB(62,$P(X,U,2),0),"^",1)
S LRSI=$P(^LAB(61,+X,0),"^",2)
;
;
S LRECORD=$C(30)_"si|ss"_$E(LRSP,1,6)_"|st"_$E(LRSI,1,6)_"|"
S:SZ LRECORD=LRECORD_"sl"_LRWARD_"|sx"_$G(LRSERV)_"|"
;
D:$L(LRECORD)>1 SUM
I SZ S LRECORD=$C(30)_"s1"_$P($G(LRDC),"@")_"|s2"_LRTC_"|s3"_$P($G(LRRD),"@")_"|s4"_LRRT_"|sc"_LRCOM_"|" D:$L(LRECORD)>1 SUM
;
S I=0
F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:+I'>0 D
. S LRCTY=$P(^LAB(60,I,0),U,1),LRPRE=$P(^(0),U,21)
. I LRPRE]"" S LRECORD=$C(30)_"ci"_(LRPRE*100000+LRAN)_"|ct"_$E(LRCTY,1,6)_"|" D SUM
;
S LRECORD=$C(29) D SUM S LRECORD=""
QUIT
;
SUM ;
I $A($E(LRECORD,1))=30 S LRSUM=LRSUM+13 D
. F J=1:1:$L(LRECORD) S LRSUM=LRSUM+$A($E(LRECORD,J))
S:$A($E(LRECORD,1))=29 LRSUM=LRSUM+29,LRSUM=LRSUM#256,LRSUM=$E("0123456789abcdef",(LRSUM\16+1))_$E("0123456789abcdef",(LRSUM#16+1)),LRECORD=LRECORD_LRSUM,LRSUM=0
SEN S CNT=^LA(LRINST,"O")+1,^("O")=CNT,^("O",CNT)=LRECORD Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMIVTLD 4567 printed Apr 09, 2024@20:43:58 Page 2
LAMIVTLD ;SLC/RWF/DAL/DRH-VITEK BUILD DOWNLOAD FILE ;7/18/89 11:51
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,33,42,48**;Sep 27, 1994
+2 ;Call with LRLL = load list to build
+3 ;Call with LRINST = Auto Instrument pointer
A ;
+1 ;
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 if '$DATA(T)
SET T=LRINST
+4 if '$DATA(^LA(LRINST,"O"))
DO SETO^LAB
SET LREND=""
+5 if '$DATA(^LRO(68.2,LRLL,1,LRTRAY1))
QUIT
+6 if '$DATA(^LA(T,"P3"))
SET ^("P3")=0
SET ^("P3")=^("P3")+1
+7 ;
+8 ;---Download full data
SET SZ=$PIECE(^LAB(69.9,1,1),U,7)
+9 ;
+10 FOR LRTRAY=LRTRAY1:0
if +LRTRAY'>0
QUIT
if $DATA(^LRO(68.2,LRLL,1,LRTRAY))
DO TRAY
Begin DoDot:1
+11 SET LRTRAY=$ORDER(^LRO(68.2,LRLL,1,LRTRAY))
if LRTRAY'>0
QUIT
End DoDot:1
+12 ;
+13 SET LRECORD=$CHAR(4)
+14 DO SEN
TIK ;
+1 IF $DATA(^LA("TP"))
LOCK +^LA("TP"):10
SET C=1+^LA("TP",0)
SET ^(0)=C
SET ^LA("TP",C)=T_"^Sent:~E"
LOCK -^LA("TP"):10
+2 ;
+3 LOCK +^LA("Q"):10
SET Q=^LA("Q")+1
SET ^("Q")=Q
SET ^("Q",Q)=T
LOCK -^LA("Q"):10
+4 DO NEW^LASET
+5 ;
+6 KILL C,CNT,DOB,I,J,LRAA,LRAD,LRADAT,LRADIA,LRAN,LRCOM,LRCTY,LRCUP,LRDC,LRDPF,LRECORD,LRNDA,LRPMD,PRPNM,LRPRE,LRRD,LRRT,LRS,LRSERV,LRSI,LRSP,LRSPEC,LRSSN,LRSUM,LRTC,LRWARD,LRWRD,PNM,Q,SEX,SSN,SZ,T
QUIT
+7 ;-----------------------------------------------------------------------
TRAY ;
+1 FOR LRCUP=0:0
SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))
if +LRCUP'>0
QUIT
Begin DoDot:1
+2 SET LRECORD=$CHAR(5)
DO SEN
DO BLD
SET LRECORD=$CHAR(4)
DO SEN
End DoDot:1
+3 QUIT
BLD ;
+1 SET LRECORD=$CHAR(2)
+2 DO SEN
+3 SET LRSUM=0
SET LRECORD=$CHAR(30)_"mtmpr|"
+4 DO SAMPLE
SET LRECORD=$CHAR(3)
DO SEN
+5 QUIT
+6 ;
+7 ;-----------------------------------------------------------------------
SAMPLE ;
+1 SET (LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)=""
+2 SET LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)
+3 SET LRAA=+LRL
+4 SET LRAD=$PIECE(LRL,U,2)
+5 SET LRAN=$PIECE(LRL,U,3)
+6 DO PNM
+7 IF LRSSN']""
SET LRECORD=LRECORD_"|pi"_LRAN
DO SUM
GOTO M
+8 IF 'SZ
SET LRECORD=LRECORD_"|pi"_LRSSN
DO SUM
GOTO M
+9 SET LRECORD=LRECORD_"pn"_$GET(PNM)_"|pi"_$GET(LRSSN)_"|"
+10 if DOB]""
SET LRECORD=LRECORD_"pb"_DOB_"|"
+11 if SEX]""
SET LRECORD=LRECORD_"ps"_SEX_"|"
+12 ;
+13 ;
+14 IF LRWRD]""
Begin DoDot:1
+15 SET LRWRD=$SELECT($LENGTH($PIECE(LRWRD," ",1)_" "_$PIECE(LRWRD," ",2))<7:$PIECE(LRWRD," ",1)_" "_$PIECE(LRWRD," ",2),1:$PIECE(LRWRD," ",1))
SET LRWRD=$EXTRACT(LRWRD,1,6)
+16 SET LRECORD=LRECORD_"pl"_$EXTRACT(LRWRD,1,6)_"|"
End DoDot:1
+17 ;
+18 ;---------put in chk for setup wild cards-----------
+19 DO ^LAMIVTL6
+20 ;S:LRWRD]"" LRECORD=LRECORD_"|w1"_LRWRD_"|"
+21 if $LENGTH(LRECORD)>1
DO SUM
+22 ;----------------------End Patient section------------------------------
+23 ;
+24 SET LRECORD=$CHAR(30)
+25 if LRS]""
SET LRECORD=LRECORD_"px"_$GET(LRS)_"|"
+26 if LRADIA]""
SET LRECORD=LRECORD_"po"_LRADIA_"|"
+27 if LRADAT]""
SET LRECORD=LRECORD_"pa"_LRADAT_"|"
if $LENGTH(LRECORD)>1
DO SUM
+28 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRWARD=$PIECE(X,"^",7)
if LRWARD=""
SET LRWARD="UNK"
SET LRSERV=$PIECE(X,"^",9)
+29 ;
+30 SET LRSERV=$GET(VAIN(3))
+31 SET LRDOC=$PIECE(X,"^",8)
+32 if LRDOC]""
SET LRDOC=$PIECE($GET(^VA(200,+LRDOC,0)),U)
+33 if LRDOC=""
SET LRDOC="UNKNOWN"
+34 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
SET LRDC=$PIECE(X,"^",1)
+35 SET LRTC=$PIECE(LRDC,".",2)
+36 SET LRTC=$EXTRACT(LRTC_"0000",1,2)_":"_$EXTRACT(LRTC_"0000",3,4)
+37 SET LRDC=$$Y2K^LRX(LRDC)
+38 SET LRRD=$PIECE(X,"^",3)
+39 SET LRRT=$PIECE(LRRD,".",2)
+40 SET LRRT=$EXTRACT(LRRT_"0000",1,2)_":"_$EXTRACT(LRRT_"0000",3,4)
+41 SET LRRD=$$Y2K^LRX(LRRD)
+42 SET LRCOM=$PIECE(X,"^",6)
SET X=""
M FOR LRSPEC=0:0
SET LRSPEC=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC))
if LRSPEC'>0
QUIT
DO T2
+1 ;
+2 QUIT
PNM ;Get patient name and SSN from an accession.
+1 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
+2 SET X=^LR(+X,0)
+3 SET LRPNM=""
SET LRDPF=$PIECE(X,U,2)
SET DFN=$PIECE(X,"^",3)
DO PT^LRX
+4 DO ^VADPT
DO INP^VADPT
+5 if $DATA(SSN)
SET LRSSN=$EXTRACT(SSN,1,3)_$EXTRACT(SSN,5,6)_$EXTRACT(SSN,8,11)
+6 ;----fileman can do this----------------------------------
+7 SET DOB=$$Y2K^LRX(DOB)
+8 SET (LRS,LRADIA,LRPMD,LRADAT)=""
+9 QUIT
+10 ;-------------------End patient Look-up--------------------------------
+11 ;
T2 ;
+1 ;-----\/------------------Bashfull ref. must go!
+2 ;
+3 SET X=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC,0))
+4 SET LRSP=$PIECE(^LAB(62,$PIECE(X,U,2),0),"^",1)
+5 SET LRSI=$PIECE(^LAB(61,+X,0),"^",2)
+6 ;
+7 ;
+8 SET LRECORD=$CHAR(30)_"si|ss"_$EXTRACT(LRSP,1,6)_"|st"_$EXTRACT(LRSI,1,6)_"|"
+9 if SZ
SET LRECORD=LRECORD_"sl"_LRWARD_"|sx"_$GET(LRSERV)_"|"
+10 ;
+11 if $LENGTH(LRECORD)>1
DO SUM
+12 IF SZ
SET LRECORD=$CHAR(30)_"s1"_$PIECE($GET(LRDC),"@")_"|s2"_LRTC_"|s3"_$PIECE($GET(LRRD),"@")_"|s4"_LRRT_"|sc"_LRCOM_"|"
if $LENGTH(LRECORD)>1
DO SUM
+13 ;
+14 SET I=0
+15 FOR
SET I=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I))
if +I'>0
QUIT
Begin DoDot:1
+16 SET LRCTY=$PIECE(^LAB(60,I,0),U,1)
SET LRPRE=$PIECE(^(0),U,21)
+17 IF LRPRE]""
SET LRECORD=$CHAR(30)_"ci"_(LRPRE*100000+LRAN)_"|ct"_$EXTRACT(LRCTY,1,6)_"|"
DO SUM
End DoDot:1
+18 ;
+19 SET LRECORD=$CHAR(29)
DO SUM
SET LRECORD=""
+20 QUIT
+21 ;
SUM ;
+1 IF $ASCII($EXTRACT(LRECORD,1))=30
SET LRSUM=LRSUM+13
Begin DoDot:1
+2 FOR J=1:1:$LENGTH(LRECORD)
SET LRSUM=LRSUM+$ASCII($EXTRACT(LRECORD,J))
End DoDot:1
+3 if $ASCII($EXTRACT(LRECORD,1))=29
SET LRSUM=LRSUM+29
SET LRSUM=LRSUM#256
SET LRSUM=$EXTRACT("0123456789abcdef",(LRSUM\16+1))_$EXTRACT("0123456789abcdef",(LRSUM#16+1))
SET LRECORD=LRECORD_LRSUM
SET LRSUM=0
SEN SET CNT=^LA(LRINST,"O")+1
SET ^("O")=CNT
SET ^("O",CNT)=LRECORD
QUIT
