Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LAMIVTLD

LAMIVTLD.m

Go to the documentation of this file.
  1. 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
  1. ;Call with LRLL = load list to build
  1. ;Call with LRINST = Auto Instrument pointer
  1. A ;
  1. ;
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. S:'$D(T) T=LRINST
  1. D:'$D(^LA(LRINST,"O")) SETO^LAB S LREND=""
  1. Q:'$D(^LRO(68.2,LRLL,1,LRTRAY1))
  1. S:'$D(^LA(T,"P3")) ^("P3")=0 S ^("P3")=^("P3")+1
  1. ;
  1. S SZ=$P(^LAB(69.9,1,1),U,7) ;---Download full data
  1. ;
  1. F LRTRAY=LRTRAY1:0 Q:+LRTRAY'>0 D:$D(^LRO(68.2,LRLL,1,LRTRAY)) TRAY D
  1. . S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0
  1. ;
  1. S LRECORD=$C(4)
  1. D SEN
  1. TIK ;
  1. 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
  1. ;
  1. L +^LA("Q"):10 S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L -^LA("Q"):10
  1. D NEW^LASET
  1. ;
  1. 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
  1. ;-----------------------------------------------------------------------
  1. TRAY ;
  1. F LRCUP=0:0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:+LRCUP'>0 D
  1. . S LRECORD=$C(5) D SEN,BLD S LRECORD=$C(4) D SEN
  1. Q
  1. BLD ;
  1. S LRECORD=$C(2)
  1. D SEN
  1. S LRSUM=0,LRECORD=$C(30)_"mtmpr|"
  1. D SAMPLE S LRECORD=$C(3) D SEN
  1. QUIT
  1. ;
  1. ;-----------------------------------------------------------------------
  1. SAMPLE ;
  1. S (LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)=""
  1. S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)
  1. S LRAA=+LRL
  1. S LRAD=$P(LRL,U,2)
  1. S LRAN=$P(LRL,U,3)
  1. D PNM
  1. I LRSSN']"" S LRECORD=LRECORD_"|pi"_LRAN D SUM G M
  1. I 'SZ S LRECORD=LRECORD_"|pi"_LRSSN D SUM G M
  1. S LRECORD=LRECORD_"pn"_$G(PNM)_"|pi"_$G(LRSSN)_"|"
  1. S:DOB]"" LRECORD=LRECORD_"pb"_DOB_"|"
  1. S:SEX]"" LRECORD=LRECORD_"ps"_SEX_"|"
  1. ;
  1. ;
  1. I LRWRD]"" D
  1. . 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)
  1. . S LRECORD=LRECORD_"pl"_$E(LRWRD,1,6)_"|"
  1. ;
  1. ;---------put in chk for setup wild cards-----------
  1. D ^LAMIVTL6
  1. ;S:LRWRD]"" LRECORD=LRECORD_"|w1"_LRWRD_"|"
  1. D:$L(LRECORD)>1 SUM
  1. ;----------------------End Patient section------------------------------
  1. ;
  1. S LRECORD=$C(30)
  1. S:LRS]"" LRECORD=LRECORD_"px"_$G(LRS)_"|"
  1. S:LRADIA]"" LRECORD=LRECORD_"po"_LRADIA_"|"
  1. S:LRADAT]"" LRECORD=LRECORD_"pa"_LRADAT_"|" D:$L(LRECORD)>1 SUM
  1. S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRWARD=$P(X,"^",7) S:LRWARD="" LRWARD="UNK" S LRSERV=$P(X,"^",9)
  1. ;
  1. S LRSERV=$G(VAIN(3))
  1. S LRDOC=$P(X,"^",8)
  1. S:LRDOC]"" LRDOC=$P($G(^VA(200,+LRDOC,0)),U)
  1. S:LRDOC="" LRDOC="UNKNOWN"
  1. S X=^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRDC=$P(X,"^",1)
  1. S LRTC=$P(LRDC,".",2)
  1. S LRTC=$E(LRTC_"0000",1,2)_":"_$E(LRTC_"0000",3,4)
  1. S LRDC=$$Y2K^LRX(LRDC)
  1. S LRRD=$P(X,"^",3)
  1. S LRRT=$P(LRRD,".",2)
  1. S LRRT=$E(LRRT_"0000",1,2)_":"_$E(LRRT_"0000",3,4)
  1. S LRRD=$$Y2K^LRX(LRRD)
  1. S LRCOM=$P(X,"^",6),X=""
  1. M F LRSPEC=0:0 S LRSPEC=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC)) Q:LRSPEC'>0 D T2
  1. ;
  1. Q
  1. PNM ;Get patient name and SSN from an accession.
  1. S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
  1. S X=^LR(+X,0)
  1. S LRPNM="" S LRDPF=$P(X,U,2),DFN=$P(X,"^",3) D PT^LRX
  1. D ^VADPT D INP^VADPT
  1. S:$D(SSN) LRSSN=$E(SSN,1,3)_$E(SSN,5,6)_$E(SSN,8,11)
  1. ;----fileman can do this----------------------------------
  1. S DOB=$$Y2K^LRX(DOB)
  1. S (LRS,LRADIA,LRPMD,LRADAT)=""
  1. QUIT
  1. ;-------------------End patient Look-up--------------------------------
  1. ;
  1. T2 ;
  1. ;-----\/------------------Bashfull ref. must go!
  1. ;
  1. S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC,0))
  1. S LRSP=$P(^LAB(62,$P(X,U,2),0),"^",1)
  1. S LRSI=$P(^LAB(61,+X,0),"^",2)
  1. ;
  1. ;
  1. S LRECORD=$C(30)_"si|ss"_$E(LRSP,1,6)_"|st"_$E(LRSI,1,6)_"|"
  1. S:SZ LRECORD=LRECORD_"sl"_LRWARD_"|sx"_$G(LRSERV)_"|"
  1. ;
  1. D:$L(LRECORD)>1 SUM
  1. 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
  1. ;
  1. S I=0
  1. F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:+I'>0 D
  1. . S LRCTY=$P(^LAB(60,I,0),U,1),LRPRE=$P(^(0),U,21)
  1. . I LRPRE]"" S LRECORD=$C(30)_"ci"_(LRPRE*100000+LRAN)_"|ct"_$E(LRCTY,1,6)_"|" D SUM
  1. ;
  1. S LRECORD=$C(29) D SUM S LRECORD=""
  1. QUIT
  1. ;
  1. SUM ;
  1. I $A($E(LRECORD,1))=30 S LRSUM=LRSUM+13 D
  1. . F J=1:1:$L(LRECORD) S LRSUM=LRSUM+$A($E(LRECORD,J))
  1. 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
  1. SEN S CNT=^LA(LRINST,"O")+1,^("O")=CNT,^("O",CNT)=LRECORD Q