- 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 Feb 18, 2025@23:09:56 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