LAMIVTKD ;SLC/RWF - VITEK BUILD DOWNLOAD FILE. ;7/18/89 11:51 ;
;;5.2;AUTOMATED LAB INSTRUMENTS;**26,42**;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)
F LRTRAY=LRTRAY1:0 D:$D(^LRO(68.2,LRLL,1,LRTRAY)) TRAY S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0
S LRECORD=$C(4) D SEN I $D(^LA("TP")) L ^LA("TP") S C=1+^LA("TP",0),^(0)=C,^LA("TP",C)=T_"^Sent:~E"
L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L
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 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 Q
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),LRAA=+LRL,LRAD=$P(LRL,"^",2) S LRAN=$P(LRL,"^",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"_PNM_"|pi"_LRSSN_"|" S:DOB]"" LRECORD=LRECORD_"pb"_DOB_"|" S:SEX]"" LRECORD=LRECORD_"ps"_SEX_"|"
D:$L(LRECORD)>1 SUM S LRECORD=$C(30) S:LRWRD]"" LRECORD=LRECORD_"pl"_LRWRD_"|" S:LRS]"" LRECORD=LRECORD_"px"_LRS_"|"
S:LRADIA]"" LRECORD=LRECORD_"po"_LRADIA_"|" ;S:LRPMD]"" LRECORD=LRECORD_"pp"_LRPMD_"|"
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=$S(LRSERV]"":$P(^DIC(45.7,LRSERV,0),"^",1),1:"UNK"),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),LRTC=$P(LRDC,".",2)
S LRTC=$E(LRTC_"0000",1,2)_":"_$E(LRTC_"0000",3,4),LRDC=$$Y2K^LRX(LRDC),LRRD=$P(X,"^",3)
S LRRT=$P(LRRD,".",2),LRRT=$E(LRRT_"0000",1,2)_":"_$E(LRRT_"0000",3,4)
S LRRD=$$Y2K^LRX(LRRD),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),X=^LR(+X,0),LRPNM="" I $P(X,"^",2)=2 S LRDPF=2,DFN=$P(X,"^",3) D PT^LRX
S:$D(SSN) LRSSN=$E(SSN,1,3)_$E(SSN,5,6)_$E(SSN,8,11)
S DOB=$$Y2K^LRX(DOB) S (LRS,LRADIA,LRPMD,LRADAT)="" Q
S LRNDA=$P($G(^DPT(DFN,"DA",0)),U,3) Q:LRNDA<1 S X=^DPT(DFN,"DA",LRNDA,0),LRADIA=$P(X,U,6),LRADAT=+X,LRS=$P(X,U,9) ;,LRPRMD=$P(X,U,7)
S:LRS]"" LRS=$P(^DIC(42,LRS,0),U)
S LRADAT=$$Y2K^LRX(LRADAT) Q
T2 S X=^(LRSPEC,0),LRSP=$P(^LAB(62,$P(X,U,2),0),"^",1),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"_LRSERV_"|"_"w2"_LRDOC_"|"
D:$L(LRECORD)>1 SUM I SZ S LRECORD=$C(30)_"s1"_LRDC_"|s2"_LRTC_"|s3"_LRRD_"|s4"_LRRT_"|sc"_LRCOM_"|" D:$L(LRECORD)>1 SUM
F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I'>0 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="" Q
SUM I $A($E(LRECORD,1))=30 S LRSUM=LRSUM+13 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[HLAMIVTKD 3773 printed Dec 13, 2024@01:43:24 Page 2
LAMIVTKD ;SLC/RWF - VITEK BUILD DOWNLOAD FILE. ;7/18/89 11:51 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**26,42**;Sep 27, 1994
+2 ;Call with LRLL = load list to build
+3 ;Call with LRINST = Auto Instrument pointer
A if $DATA(ZTQUEUED)
SET ZTREQ="@"
if '$DATA(T)
SET T=LRINST
if '$DATA(^LA(LRINST,"O"))
DO SETO^LAB
SET LREND=""
+1 if '$DATA(^LRO(68.2,LRLL,1,LRTRAY1))
QUIT
+2 if '$DATA(^LA(T,"P3"))
SET ^("P3")=0
SET ^("P3")=^("P3")+1
+3 SET SZ=$PIECE(^LAB(69.9,1,1),U,7)
+4 FOR LRTRAY=LRTRAY1:0
if $DATA(^LRO(68.2,LRLL,1,LRTRAY))
DO TRAY
SET LRTRAY=$ORDER(^LRO(68.2,LRLL,1,LRTRAY))
if LRTRAY'>0
QUIT
+5 SET LRECORD=$CHAR(4)
DO SEN
IF $DATA(^LA("TP"))
LOCK ^LA("TP")
SET C=1+^LA("TP",0)
SET ^(0)=C
SET ^LA("TP",C)=T_"^Sent:~E"
+6 LOCK ^LA("Q")
SET Q=^LA("Q")+1
SET ^("Q")=Q
SET ^("Q",Q)=T
LOCK
+7 DO NEW^LASET
+8 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
TRAY FOR LRCUP=0:0
SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))
if LRCUP'>0
QUIT
SET LRECORD=$CHAR(5)
DO SEN
DO BLD
SET LRECORD=$CHAR(4)
DO SEN
+1 QUIT
BLD SET LRECORD=$CHAR(2)
DO SEN
SET LRSUM=0
SET LRECORD=$CHAR(30)_"mtmpr|"
DO SAMPLE
SET LRECORD=$CHAR(3)
DO SEN
QUIT
SAMPLE SET (LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)=""
+1 SET LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)
SET LRAA=+LRL
SET LRAD=$PIECE(LRL,"^",2)
SET LRAN=$PIECE(LRL,"^",3)
DO PNM
IF LRSSN']""
SET LRECORD=LRECORD_"|pi"_LRAN
DO SUM
GOTO M
+2 IF 'SZ
SET LRECORD=LRECORD_"|pi"_LRSSN
DO SUM
GOTO M
+3 SET LRECORD=LRECORD_"pn"_PNM_"|pi"_LRSSN_"|"
if DOB]""
SET LRECORD=LRECORD_"pb"_DOB_"|"
if SEX]""
SET LRECORD=LRECORD_"ps"_SEX_"|"
+4 if $LENGTH(LRECORD)>1
DO SUM
SET LRECORD=$CHAR(30)
if LRWRD]""
SET LRECORD=LRECORD_"pl"_LRWRD_"|"
if LRS]""
SET LRECORD=LRECORD_"px"_LRS_"|"
+5 ;S:LRPMD]"" LRECORD=LRECORD_"pp"_LRPMD_"|"
if LRADIA]""
SET LRECORD=LRECORD_"po"_LRADIA_"|"
+6 if LRADAT]""
SET LRECORD=LRECORD_"pa"_LRADAT_"|"
if $LENGTH(LRECORD)>1
DO SUM
+7 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)
+8 SET LRSERV=$SELECT(LRSERV]"":$PIECE(^DIC(45.7,LRSERV,0),"^",1),1:"UNK")
SET LRDOC=$PIECE(X,"^",8)
if LRDOC]""
SET LRDOC=$PIECE($GET(VA(200,+LRDOC,0)),U)
if LRDOC=""
SET LRDOC="UNKNOWN"
+9 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
SET LRDC=$PIECE(X,"^",1)
SET LRTC=$PIECE(LRDC,".",2)
+10 SET LRTC=$EXTRACT(LRTC_"0000",1,2)_":"_$EXTRACT(LRTC_"0000",3,4)
SET LRDC=$$Y2K^LRX(LRDC)
SET LRRD=$PIECE(X,"^",3)
+11 SET LRRT=$PIECE(LRRD,".",2)
SET LRRT=$EXTRACT(LRRT_"0000",1,2)_":"_$EXTRACT(LRRT_"0000",3,4)
+12 SET LRRD=$$Y2K^LRX(LRRD)
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 QUIT
PNM ;Get patient name and SSN from an accession.
+1 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET X=^LR(+X,0)
SET LRPNM=""
IF $PIECE(X,"^",2)=2
SET LRDPF=2
SET DFN=$PIECE(X,"^",3)
DO PT^LRX
+2 if $DATA(SSN)
SET LRSSN=$EXTRACT(SSN,1,3)_$EXTRACT(SSN,5,6)_$EXTRACT(SSN,8,11)
+3 SET DOB=$$Y2K^LRX(DOB)
SET (LRS,LRADIA,LRPMD,LRADAT)=""
QUIT
+4 ;,LRPRMD=$P(X,U,7)
SET LRNDA=$PIECE($GET(^DPT(DFN,"DA",0)),U,3)
if LRNDA<1
QUIT
SET X=^DPT(DFN,"DA",LRNDA,0)
SET LRADIA=$PIECE(X,U,6)
SET LRADAT=+X
SET LRS=$PIECE(X,U,9)
+5 if LRS]""
SET LRS=$PIECE(^DIC(42,LRS,0),U)
+6 SET LRADAT=$$Y2K^LRX(LRADAT)
QUIT
T2 SET X=^(LRSPEC,0)
SET LRSP=$PIECE(^LAB(62,$PIECE(X,U,2),0),"^",1)
SET LRSI=$PIECE(^LAB(61,+X,0),"^",2)
+1 SET LRECORD=$CHAR(30)_"si|ss"_$EXTRACT(LRSP,1,6)_"|st"_$EXTRACT(LRSI,1,6)_"|"
if SZ
SET LRECORD=LRECORD_"sl"_LRWARD_"|sx"_LRSERV_"|"_"w2"_LRDOC_"|"
+2 if $LENGTH(LRECORD)>1
DO SUM
IF SZ
SET LRECORD=$CHAR(30)_"s1"_LRDC_"|s2"_LRTC_"|s3"_LRRD_"|s4"_LRRT_"|sc"_LRCOM_"|"
if $LENGTH(LRECORD)>1
DO SUM
+3 FOR I=0:0
SET I=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I))
if I'>0
QUIT
SET LRCTY=$PIECE(^LAB(60,I,0),U,1)
SET LRPRE=$PIECE(^(0),U,21)
IF LRPRE]""
SET LRECORD=$CHAR(30)_"ci"_(LRPRE*100000+LRAN)_"|ct"_$EXTRACT(LRCTY,1,6)_"|"
DO SUM
+4 SET LRECORD=$CHAR(29)
DO SUM
SET LRECORD=""
QUIT
SUM IF $ASCII($EXTRACT(LRECORD,1))=30
SET LRSUM=LRSUM+13
FOR J=1:1:$LENGTH(LRECORD)
SET LRSUM=LRSUM+$ASCII($EXTRACT(LRECORD,J))
+1 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
