source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMITSPE.m@ 1042

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1LRMITSPE ;SLC/STAFF - MICRO TREND PROCESS EXTRACT ;10/28/93 15:17
2 ;;5.2;LAB SERVICE;**96,257,344**;Sep 27, 1994
3 ; from LRMITSP
4 ;Reference to ^SC supported by IA# 10040
5 ;Reference to ^SC C xref supported by IA# 908
6 ;Reference to ^DD supported by IA# 10154
7 ;Reference to ^DPT supported by IA# 10035
8 ;Reference to Y^DIQ supported by IA# 10004
9 ;Reference to $$NS^XUAF4 supported by IA# 2171
10 ;
11 S LRSEQN=0
12 ; if report type is only for specific patients, collect only that data
13 I '$D(LRM("O")),'$D(LRM("S")),'$D(LRM("L")),'$D(LRM("D")),'$D(LRM("C")),'$D(LRM("DIV")),$D(LRM("P","S")) D Q
14 .S DFN=0 F S DFN=$O(LRM("P","S",DFN)) Q:DFN<1 S LRDFN=+$P(LRM("P","S",DFN),U,2) I LRDFN D DATA Q:LREND
15 .D CLEANUP
16 ; otherwise, go thru all patients
17 S LRDFN=0 F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D DATA Q:LREND
18CLEANUP K DFN,LRACC,LRADMD,LRANTIM,LRANTIN,LRANTINM,LRATS,LRCDATE,LRCOLN,LRCOLNM,LRDCHD,LRDFN,LRDN,LRDOCN,LRDOCNM,LRGPN,LRGPNM,LRIDT,LRINTERP,LRLOCN,LRLOCNM
19 K LRMERGEV,LRN1,LRN2,LRN3,LROK,LRORGN,LRORGNM,LRPATN,LRPATNM,LRPLOS,LRR,LRRTYPE,LRSEQN,LRSPECN,LRSPECNM,LRSUBN,LRSUSR,LRSUSS,LRTSAL,LRTB,LRTYPE,LRX,Y
20 K LRX13,LRXN,LRDIV,LRDIVNM,LRSDIV,LRASK
21 K LRAPRT,LRBLIK,LRPX
22 Q
23DATA ; quit if not a valid patient or task is stopped
24 Q:'$D(^LR(LRDFN,0)) Q:$P(^(0),U,2)'=2 S LRPATN=+$P(^(0),U,3) I $$S^%ZTLOAD S (LREND,ZTSTOP)=1 Q
25 ; go thru valid collection dates with available data
26 S LRIDT=LRTSAL F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!((LRIDT\1)>LRATS) S LRX=$G(^(LRIDT,0)) I LRX,$$CHECK(LRDFN,LRIDT,.LROTYPE) D
27 .; get date, los, acc, patient, provider, site/specimen, location, col samp #s and names
28 .S LRCDATE=+LRX
29 .S LRPLOS=$S(LRLOS!LRDETAIL:$$LOS(LRPATN,LRCDATE),1:"") I LRLOS Q:'$L(LRPLOS) Q:LRPLOS<LRLOS
30 .S LRACC=$P(LRX,U,6)
31 .S LRPATNM=$P($G(^DPT(LRPATN,0)),U) I '$L(LRPATNM) S LRPATNM=LRUNK
32 .S LRDOCN=+$P(LRX,U,7),LRDOCNM=$$VALUE(LRDOCN,63.05,.07) I '$L(LRDOCNM) S LRDOCNM=LRUNK
33 .S LRSPECN=+$P(LRX,U,5),LRSPECNM=$P($G(^LAB(61,LRSPECN,0)),U) I '$L(LRSPECNM) S LRSPECNM=LRUNK
34 .S LRLOCNM=$P(LRX,U,8) S:'$L(LRLOCNM) LRLOCNM=LRUNK
35 .S X=LRLOCNM,DIC="^SC(",DIC(0)="",D="C" D IX^DIC
36 .I Y=-1 S LRLOCN=0
37 .E S LRLOCN=+Y ;S LRLOCN=+$O(^SC("C",LRLOCNM,0))
38 .K DIC,Y
39 .;MULTIDIVISIONAL PATCH LR*5.2*257 - 08/04
40 .S LRX13=$P(LRX,U,13),LRXN=$P(LRX13,";")
41 .I LRX13>0,$P(LRX13,";",2)="SC(" S LRLOCNM=$P(^SC(LRXN,0),U),LRDIV=$P(^SC(LRXN,0),U,4)
42 .I LRX13>0,$P(LRX13,";",2)="DIC(4," S LRDIV=LRXN
43 .I '$G(LRDIV) S LRDIV=$P($G(^SC(+LRLOCN,0)),U,4)
44 .I LRDIV S LRDIVNM=$P($$NS^XUAF4(LRDIV),U)
45 .E S LRDIV=0,LRDIVNM="UNKNOWN"
46 .S:LRDIV="" LRDIV=0
47 .S LRCOLN=+$P(LRX,U,11),LRCOLNM=$P($G(^LAB(62,LRCOLN,0)),U) I '$L(LRCOLNM) S LRCOLNM=LRUNK
48 .;MULTIDIVISIONAL PATCH LR*5.2*257 -3/01
49 .;if report is for specific division, collect only that data
50 .I $D(LRM("DIV","S")) D Q
51 ..S LRSDIV=0
52 ..F S LRSDIV=$O(LRM("DIV","S",LRSDIV)) Q:LRSDIV="" D
53 ...I LRSDIV=LRDIV,LRDIV'=0 D ^LRMITSPO
54 ..Q
55 .; get data on organisms
56 .D ^LRMITSPO
57 Q
58CHECK(LRDFN,LRIDT,LROTYPE) ; lab patient, time, organism types -> 1 or 0 if data available
59 I $D(LROTYPE("B")),$D(^LR(LRDFN,"MI",LRIDT,3)) Q 1
60 I $D(LROTYPE("F")),$D(^LR(LRDFN,"MI",LRIDT,8)) Q 1
61 I $D(LROTYPE("M")),$D(^LR(LRDFN,"MI",LRIDT,11)) Q 1
62 I $D(LROTYPE("P")),$D(^LR(LRDFN,"MI",LRIDT,5)) Q 1
63 I $D(LROTYPE("V")),$D(^LR(LRDFN,"MI",LRIDT,16)) Q 1
64 I '$D(LROTYPE("B")),$D(^LR(LRDFN,"MI",LRIDT,3)) Q 1
65 Q 0
66VALUE(Y,FILE,FIELD) ; $$(internal value,file,field) -> external value or ""
67 I 'Y Q ""
68 N C S C=$P(^DD(FILE,FIELD,0),U,2) D Y^DIQ Q Y
69LOS(DFN,CDATE) ; $$(patient,collection date) -> length of stay or ""
70 N ADATE S VAINDT=CDATE D INP^VADPT S ADATE=$P(VAIN(7),U) D KVAR^VADPT I '$L(ADATE) Q ""
71 Q $$FMDIFF^XLFDT(CDATE,ADATE)
Note: See TracBrowser for help on using the repository browser.