close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTLD.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTLD.m@ 1769

Last change on this file since 1769 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
1LAMIVTLD ;SLC/RWF/DAL/DRH-VITEK BUILD DOWNLOAD FILE ;7/18/89 11:51
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,33,42,48**;Sep 27, 1994
3 ;Call with LRLL = load list to build
4 ;Call with LRINST = Auto Instrument pointer
5A ;
6 ;
7 S:$D(ZTQUEUED) ZTREQ="@"
8 S:'$D(T) T=LRINST
9 D:'$D(^LA(LRINST,"O")) SETO^LAB S LREND=""
10 Q:'$D(^LRO(68.2,LRLL,1,LRTRAY1))
11 S:'$D(^LA(T,"P3")) ^("P3")=0 S ^("P3")=^("P3")+1
12 ;
13 S SZ=$P(^LAB(69.9,1,1),U,7) ;---Download full data
14 ;
15 F LRTRAY=LRTRAY1:0 Q:+LRTRAY'>0 D:$D(^LRO(68.2,LRLL,1,LRTRAY)) TRAY D
16 . S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0
17 ;
18 S LRECORD=$C(4)
19 D SEN
20TIK ;
21 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
22 ;
23 L +^LA("Q"):10 S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L -^LA("Q"):10
24 D NEW^LASET
25 ;
26 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
27 ;-----------------------------------------------------------------------
28TRAY ;
29 F LRCUP=0:0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:+LRCUP'>0 D
30 . S LRECORD=$C(5) D SEN,BLD S LRECORD=$C(4) D SEN
31 Q
32BLD ;
33 S LRECORD=$C(2)
34 D SEN
35 S LRSUM=0,LRECORD=$C(30)_"mtmpr|"
36 D SAMPLE S LRECORD=$C(3) D SEN
37 QUIT
38 ;
39 ;-----------------------------------------------------------------------
40SAMPLE ;
41 S (LRSSN,DOB,LRWRD,LRS,LRDIA,LRADAT,LRWARD,LRSERV,LRDC,LRRT,LRRD,LRCOM,LREND)=""
42 S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)
43 S LRAA=+LRL
44 S LRAD=$P(LRL,U,2)
45 S LRAN=$P(LRL,U,3)
46 D PNM
47 I LRSSN']"" S LRECORD=LRECORD_"|pi"_LRAN D SUM G M
48 I 'SZ S LRECORD=LRECORD_"|pi"_LRSSN D SUM G M
49 S LRECORD=LRECORD_"pn"_$G(PNM)_"|pi"_$G(LRSSN)_"|"
50 S:DOB]"" LRECORD=LRECORD_"pb"_DOB_"|"
51 S:SEX]"" LRECORD=LRECORD_"ps"_SEX_"|"
52 ;
53 ;
54 I LRWRD]"" D
55 . 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)
56 . S LRECORD=LRECORD_"pl"_$E(LRWRD,1,6)_"|"
57 ;
58 ;---------put in chk for setup wild cards-----------
59 D ^LAMIVTL6
60 ;S:LRWRD]"" LRECORD=LRECORD_"|w1"_LRWRD_"|"
61 D:$L(LRECORD)>1 SUM
62 ;----------------------End Patient section------------------------------
63 ;
64 S LRECORD=$C(30)
65 S:LRS]"" LRECORD=LRECORD_"px"_$G(LRS)_"|"
66 S:LRADIA]"" LRECORD=LRECORD_"po"_LRADIA_"|"
67 S:LRADAT]"" LRECORD=LRECORD_"pa"_LRADAT_"|" D:$L(LRECORD)>1 SUM
68 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRWARD=$P(X,"^",7) S:LRWARD="" LRWARD="UNK" S LRSERV=$P(X,"^",9)
69 ;
70 S LRSERV=$G(VAIN(3))
71 S LRDOC=$P(X,"^",8)
72 S:LRDOC]"" LRDOC=$P($G(^VA(200,+LRDOC,0)),U)
73 S:LRDOC="" LRDOC="UNKNOWN"
74 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRDC=$P(X,"^",1)
75 S LRTC=$P(LRDC,".",2)
76 S LRTC=$E(LRTC_"0000",1,2)_":"_$E(LRTC_"0000",3,4)
77 S LRDC=$$Y2K^LRX(LRDC)
78 S LRRD=$P(X,"^",3)
79 S LRRT=$P(LRRD,".",2)
80 S LRRT=$E(LRRT_"0000",1,2)_":"_$E(LRRT_"0000",3,4)
81 S LRRD=$$Y2K^LRX(LRRD)
82 S LRCOM=$P(X,"^",6),X=""
83M F LRSPEC=0:0 S LRSPEC=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC)) Q:LRSPEC'>0 D T2
84 ;
85 Q
86PNM ;Get patient name and SSN from an accession.
87 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
88 S X=^LR(+X,0)
89 S LRPNM="" S LRDPF=$P(X,U,2),DFN=$P(X,"^",3) D PT^LRX
90 D ^VADPT D INP^VADPT
91 S:$D(SSN) LRSSN=$E(SSN,1,3)_$E(SSN,5,6)_$E(SSN,8,11)
92 ;----fileman can do this----------------------------------
93 S DOB=$$Y2K^LRX(DOB)
94 S (LRS,LRADIA,LRPMD,LRADAT)=""
95 QUIT
96 ;-------------------End patient Look-up--------------------------------
97 ;
98T2 ;
99 ;-----\/------------------Bashfull ref. must go!
100 ;
101 S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSPEC,0))
102 S LRSP=$P(^LAB(62,$P(X,U,2),0),"^",1)
103 S LRSI=$P(^LAB(61,+X,0),"^",2)
104 ;
105 ;
106 S LRECORD=$C(30)_"si|ss"_$E(LRSP,1,6)_"|st"_$E(LRSI,1,6)_"|"
107 S:SZ LRECORD=LRECORD_"sl"_LRWARD_"|sx"_$G(LRSERV)_"|"
108 ;
109 D:$L(LRECORD)>1 SUM
110 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
111 ;
112 S I=0
113 F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:+I'>0 D
114 . S LRCTY=$P(^LAB(60,I,0),U,1),LRPRE=$P(^(0),U,21)
115 . I LRPRE]"" S LRECORD=$C(30)_"ci"_(LRPRE*100000+LRAN)_"|ct"_$E(LRCTY,1,6)_"|" D SUM
116 ;
117 S LRECORD=$C(29) D SUM S LRECORD=""
118 QUIT
119 ;
120SUM ;
121 I $A($E(LRECORD,1))=30 S LRSUM=LRSUM+13 D
122 . F J=1:1:$L(LRECORD) S LRSUM=LRSUM+$A($E(LRECORD,J))
123 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
124SEN S CNT=^LA(LRINST,"O")+1,^("O")=CNT,^("O",CNT)=LRECORD Q
Note: See TracBrowser for help on using the repository browser.