source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTKD.m@ 1328

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