- 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 Jan 18, 2025@02:44:38 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