LAMIVTKD ; IHS/DIR/AAB - VITEK BUILD DOWNLOAD FILE. 7/18/89 11:51 ; [ 07/06/1998 9:50 AM ]
;;5.2;LA;**1001,1003**;SEP 01, 1998
;
;;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
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,HRCN,SZ,T Q ;IHS/OIRM TUC/AAB 12/10/97
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 (HRCN,LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)="" ;IHS/OIRM TUC/AAB 12/10/97
;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
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 HRCN']"" S LRECORD=LRECORD_"|pi"_LRAN D SUM G M ;IHS/OIRM TUC/AAB 12/10/97
;I 'SZ S LRECORD=LRECORD_"|pi"_LRSSN D SUM G M
I 'SZ S LRECORD=LRECORD_"|pi"_HRCN D SUM G M ;IHS/OIRM TUC/AAB 12/10/97
S LRECORD=LRECORD_"pn"_PNM_"|pi"_HRCN_"|" S:DOB]"" LRECORD=LRECORD_"pb"_DOB_"|" ;S:SEX]"" LRECORD=LRECORD_"ps"_SEX_"|" ;IHS/OIRM TUC/AAB 12/10/97 disabled SEX
D:$L(LRECORD)>1 SUM ;S LRECORD=$C(30) S:LRWRD]"" LRECORD=LRECORD_"pl"_LRWRD_"|" S:LRS]"" LRECORD=LRECORD_"px"_LRS_"|" ;IHS/OIRM TUC/AAB 12/10/97 disabled LRWRD & LRS
S:LRADIA]"" LRECORD=LRECORD_"po"_LRADIA_"|" ;S:LRPMD]"" LRECORD=LRECORD_"pp"_LRPMD_"|" ;IHS/OIRM TUC/AAB 12/10/97 disabled Diagnosis & MD
;S:LRADAT]"" LRECORD=LRECORD_"pa"_LRADAT_"|" D:$L(LRECORD)>1 SUM ;IHS/OIRM TUC/AAB 12/10/97 disabled Admission Date
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) ;IHS/OIRM TUC/AAB 12/10/97 disabled
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_"|" ;IHS/OIRM TUC/AAB 12/10/97
;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
I SZ S LRECORD=$C(30)_"s1"_LRDC_"|s2"_LRTC_"|s3"_LRRD_"|s4"_LRRT_"|sc"_LRCOM_"|" D:$L(LRECORD)>1 SUM ;IHS/OIRM TUC/AAB 12/10/97 date/time collected
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
LAMIVTKD ; IHS/DIR/AAB - VITEK BUILD DOWNLOAD FILE. 7/18/89 11:51 ; [ 07/06/1998 9:50 AM ]
+1 ;;5.2;LA;**1001,1003**;SEP 01, 1998
+2 ;
+3 ;;5.2;AUTOMATED LAB INSTRUMENTS;**26,42**;Sep 27, 1994
+4 ;Call with LRLL = load list to build
+5 ;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 ;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
+9 ;IHS/OIRM TUC/AAB 12/10/97
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,HRCN,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 ;S (LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)=""
+1 ;IHS/OIRM TUC/AAB 12/10/97
SET (HRCN,LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)=""
+2 ;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
+3 ;IHS/OIRM TUC/AAB 12/10/97
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 HRCN']""
SET LRECORD=LRECORD_"|pi"_LRAN
DO SUM
GOTO M
+4 ;I 'SZ S LRECORD=LRECORD_"|pi"_LRSSN D SUM G M
+5 ;IHS/OIRM TUC/AAB 12/10/97
IF 'SZ
SET LRECORD=LRECORD_"|pi"_HRCN
DO SUM
GOTO M
+6 ;S:SEX]"" LRECORD=LRECORD_"ps"_SEX_"|" ;IHS/OIRM TUC/AAB 12/10/97 disabled SEX
SET LRECORD=LRECORD_"pn"_PNM_"|pi"_HRCN_"|"
IF DOB]""
SET LRECORD=LRECORD_"pb"_DOB_"|"
+7 ;S LRECORD=$C(30) S:LRWRD]"" LRECORD=LRECORD_"pl"_LRWRD_"|" S:LRS]"" LRECORD=LRECORD_"px"_LRS_"|" ;IHS/OIRM TUC/AAB 12/10/97 disabled LRWRD & LRS
IF $LENGTH(LRECORD)>1
DO SUM
+8 ;S:LRPMD]"" LRECORD=LRECORD_"pp"_LRPMD_"|" ;IHS/OIRM TUC/AAB 12/10/97 disabled Diagnosis & MD
IF LRADIA]""
SET LRECORD=LRECORD_"po"_LRADIA_"|"
+9 ;S:LRADAT]"" LRECORD=LRECORD_"pa"_LRADAT_"|" D:$L(LRECORD)>1 SUM ;IHS/OIRM TUC/AAB 12/10/97 disabled Admission Date
+10 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)
+11 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"
+12 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
SET LRDC=$PIECE(X,"^",1)
SET LRTC=$PIECE(LRDC,".",2)
+13 SET LRTC=$EXTRACT(LRTC_"0000",1,2)_":"_$EXTRACT(LRTC_"0000",3,4)
SET LRDC=$$Y2K^LRX(LRDC)
SET LRRD=$PIECE(X,"^",3)
+14 SET LRRT=$PIECE(LRRD,".",2)
SET LRRT=$EXTRACT(LRRT_"0000",1,2)_":"_$EXTRACT(LRRT_"0000",3,4)
+15 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 ;S:$D(SSN) LRSSN=$E(SSN,1,3)_$E(SSN,5,6)_$E(SSN,8,11) ;IHS/OIRM TUC/AAB 12/10/97 disabled
+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 ;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_"|" ;IHS/OIRM TUC/AAB 12/10/97
+2 ;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
+3 ;IHS/OIRM TUC/AAB 12/10/97 date/time collected
IF SZ
SET LRECORD=$CHAR(30)_"s1"_LRDC_"|s2"_LRTC_"|s3"_LRRD_"|s4"_LRRT_"|sc"_LRCOM_"|"
IF $LENGTH(LRECORD)>1
DO SUM
+4 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
+5 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
