LRMITSPE ;SLC/STAFF - MICRO TREND PROCESS EXTRACT ;10/28/93 15:17
;;5.2;LAB SERVICE;**96,257,344**;Sep 27, 1994
; from LRMITSP
;Reference to ^SC supported by IA# 10040
;Reference to ^SC C xref supported by IA# 908
;Reference to ^DD supported by IA# 10154
;Reference to ^DPT supported by IA# 10035
;Reference to Y^DIQ supported by IA# 10004
;Reference to $$NS^XUAF4 supported by IA# 2171
;
S LRSEQN=0
; if report type is only for specific patients, collect only that data
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
.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
.D CLEANUP
; otherwise, go thru all patients
S LRDFN=0 F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D DATA Q:LREND
CLEANUP K DFN,LRACC,LRADMD,LRANTIM,LRANTIN,LRANTINM,LRATS,LRCDATE,LRCOLN,LRCOLNM,LRDCHD,LRDFN,LRDN,LRDOCN,LRDOCNM,LRGPN,LRGPNM,LRIDT,LRINTERP,LRLOCN,LRLOCNM
K LRMERGEV,LRN1,LRN2,LRN3,LROK,LRORGN,LRORGNM,LRPATN,LRPATNM,LRPLOS,LRR,LRRTYPE,LRSEQN,LRSPECN,LRSPECNM,LRSUBN,LRSUSR,LRSUSS,LRTSAL,LRTB,LRTYPE,LRX,Y
K LRX13,LRXN,LRDIV,LRDIVNM,LRSDIV,LRASK
K LRAPRT,LRBLIK,LRPX
Q
DATA ; quit if not a valid patient or task is stopped
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
; go thru valid collection dates with available data
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
.; get date, los, acc, patient, provider, site/specimen, location, col samp #s and names
.S LRCDATE=+LRX
.S LRPLOS=$S(LRLOS!LRDETAIL:$$LOS(LRPATN,LRCDATE),1:"") I LRLOS Q:'$L(LRPLOS) Q:LRPLOS<LRLOS
.S LRACC=$P(LRX,U,6)
.S LRPATNM=$P($G(^DPT(LRPATN,0)),U) I '$L(LRPATNM) S LRPATNM=LRUNK
.S LRDOCN=+$P(LRX,U,7),LRDOCNM=$$VALUE(LRDOCN,63.05,.07) I '$L(LRDOCNM) S LRDOCNM=LRUNK
.S LRSPECN=+$P(LRX,U,5),LRSPECNM=$P($G(^LAB(61,LRSPECN,0)),U) I '$L(LRSPECNM) S LRSPECNM=LRUNK
.S LRLOCNM=$P(LRX,U,8) S:'$L(LRLOCNM) LRLOCNM=LRUNK
.S X=LRLOCNM,DIC="^SC(",DIC(0)="",D="C" D IX^DIC
.I Y=-1 S LRLOCN=0
.E S LRLOCN=+Y ;S LRLOCN=+$O(^SC("C",LRLOCNM,0))
.K DIC,Y
.;MULTIDIVISIONAL PATCH LR*5.2*257 - 08/04
.S LRX13=$P(LRX,U,13),LRXN=$P(LRX13,";")
.I LRX13>0,$P(LRX13,";",2)="SC(" S LRLOCNM=$P(^SC(LRXN,0),U),LRDIV=$P(^SC(LRXN,0),U,4)
.I LRX13>0,$P(LRX13,";",2)="DIC(4," S LRDIV=LRXN
.I '$G(LRDIV) S LRDIV=$P($G(^SC(+LRLOCN,0)),U,4)
.I LRDIV S LRDIVNM=$P($$NS^XUAF4(LRDIV),U)
.E S LRDIV=0,LRDIVNM="UNKNOWN"
.S:LRDIV="" LRDIV=0
.S LRCOLN=+$P(LRX,U,11),LRCOLNM=$P($G(^LAB(62,LRCOLN,0)),U) I '$L(LRCOLNM) S LRCOLNM=LRUNK
.;MULTIDIVISIONAL PATCH LR*5.2*257 -3/01
.;if report is for specific division, collect only that data
.I $D(LRM("DIV","S")) D Q
..S LRSDIV=0
..F S LRSDIV=$O(LRM("DIV","S",LRSDIV)) Q:LRSDIV="" D
...I LRSDIV=LRDIV,LRDIV'=0 D ^LRMITSPO
..Q
.; get data on organisms
.D ^LRMITSPO
Q
CHECK(LRDFN,LRIDT,LROTYPE) ; lab patient, time, organism types -> 1 or 0 if data available
I $D(LROTYPE("B")),$D(^LR(LRDFN,"MI",LRIDT,3)) Q 1
I $D(LROTYPE("F")),$D(^LR(LRDFN,"MI",LRIDT,8)) Q 1
I $D(LROTYPE("M")),$D(^LR(LRDFN,"MI",LRIDT,11)) Q 1
I $D(LROTYPE("P")),$D(^LR(LRDFN,"MI",LRIDT,5)) Q 1
I $D(LROTYPE("V")),$D(^LR(LRDFN,"MI",LRIDT,16)) Q 1
I '$D(LROTYPE("B")),$D(^LR(LRDFN,"MI",LRIDT,3)) Q 1
Q 0
VALUE(Y,FILE,FIELD) ; $$(internal value,file,field) -> external value or ""
I 'Y Q ""
N C S C=$P(^DD(FILE,FIELD,0),U,2) D Y^DIQ Q Y
LOS(DFN,CDATE) ; $$(patient,collection date) -> length of stay or ""
N ADATE S VAINDT=CDATE D INP^VADPT S ADATE=$P(VAIN(7),U) D KVAR^VADPT I '$L(ADATE) Q ""
Q $$FMDIFF^XLFDT(CDATE,ADATE)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMITSPE 3753 printed Nov 22, 2024@17:27:38 Page 2
LRMITSPE ;SLC/STAFF - MICRO TREND PROCESS EXTRACT ;10/28/93 15:17
+1 ;;5.2;LAB SERVICE;**96,257,344**;Sep 27, 1994
+2 ; from LRMITSP
+3 ;Reference to ^SC supported by IA# 10040
+4 ;Reference to ^SC C xref supported by IA# 908
+5 ;Reference to ^DD supported by IA# 10154
+6 ;Reference to ^DPT supported by IA# 10035
+7 ;Reference to Y^DIQ supported by IA# 10004
+8 ;Reference to $$NS^XUAF4 supported by IA# 2171
+9 ;
+10 SET LRSEQN=0
+11 ; if report type is only for specific patients, collect only that data
+12 IF '$DATA(LRM("O"))
IF '$DATA(LRM("S"))
IF '$DATA(LRM("L"))
IF '$DATA(LRM("D"))
IF '$DATA(LRM("C"))
IF '$DATA(LRM("DIV"))
IF $DATA(LRM("P","S"))
Begin DoDot:1
+13 SET DFN=0
FOR
SET DFN=$ORDER(LRM("P","S",DFN))
if DFN<1
QUIT
SET LRDFN=+$PIECE(LRM("P","S",DFN),U,2)
IF LRDFN
DO DATA
if LREND
QUIT
+14 DO CLEANUP
End DoDot:1
QUIT
+15 ; otherwise, go thru all patients
+16 SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LR(LRDFN))
if LRDFN<1
QUIT
DO DATA
if LREND
QUIT
CLEANUP KILL DFN,LRACC,LRADMD,LRANTIM,LRANTIN,LRANTINM,LRATS,LRCDATE,LRCOLN,LRCOLNM,LRDCHD,LRDFN,LRDN,LRDOCN,LRDOCNM,LRGPN,LRGPNM,LRIDT,LRINTERP,LRLOCN,LRLOCNM
+1 KILL LRMERGEV,LRN1,LRN2,LRN3,LROK,LRORGN,LRORGNM,LRPATN,LRPATNM,LRPLOS,LRR,LRRTYPE,LRSEQN,LRSPECN,LRSPECNM,LRSUBN,LRSUSR,LRSUSS,LRTSAL,LRTB,LRTYPE,LRX,Y
+2 KILL LRX13,LRXN,LRDIV,LRDIVNM,LRSDIV,LRASK
+3 KILL LRAPRT,LRBLIK,LRPX
+4 QUIT
DATA ; quit if not a valid patient or task is stopped
+1 if '$DATA(^LR(LRDFN,0))
QUIT
if $PIECE(^(0),U,2)'=2
QUIT
SET LRPATN=+$PIECE(^(0),U,3)
IF $$S^%ZTLOAD
SET (LREND,ZTSTOP)=1
QUIT
+2 ; go thru valid collection dates with available data
+3 SET LRIDT=LRTSAL
FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
if LRIDT<1!((LRIDT\1)>LRATS)
QUIT
SET LRX=$GET(^(LRIDT,0))
IF LRX
IF $$CHECK(LRDFN,LRIDT,.LROTYPE)
Begin DoDot:1
+4 ; get date, los, acc, patient, provider, site/specimen, location, col samp #s and names
+5 SET LRCDATE=+LRX
+6 SET LRPLOS=$SELECT(LRLOS!LRDETAIL:$$LOS(LRPATN,LRCDATE),1:"")
IF LRLOS
if '$LENGTH(LRPLOS)
QUIT
if LRPLOS<LRLOS
QUIT
+7 SET LRACC=$PIECE(LRX,U,6)
+8 SET LRPATNM=$PIECE($GET(^DPT(LRPATN,0)),U)
IF '$LENGTH(LRPATNM)
SET LRPATNM=LRUNK
+9 SET LRDOCN=+$PIECE(LRX,U,7)
SET LRDOCNM=$$VALUE(LRDOCN,63.05,.07)
IF '$LENGTH(LRDOCNM)
SET LRDOCNM=LRUNK
+10 SET LRSPECN=+$PIECE(LRX,U,5)
SET LRSPECNM=$PIECE($GET(^LAB(61,LRSPECN,0)),U)
IF '$LENGTH(LRSPECNM)
SET LRSPECNM=LRUNK
+11 SET LRLOCNM=$PIECE(LRX,U,8)
if '$LENGTH(LRLOCNM)
SET LRLOCNM=LRUNK
+12 SET X=LRLOCNM
SET DIC="^SC("
SET DIC(0)=""
SET D="C"
DO IX^DIC
+13 IF Y=-1
SET LRLOCN=0
+14 ;S LRLOCN=+$O(^SC("C",LRLOCNM,0))
IF '$TEST
SET LRLOCN=+Y
+15 KILL DIC,Y
+16 ;MULTIDIVISIONAL PATCH LR*5.2*257 - 08/04
+17 SET LRX13=$PIECE(LRX,U,13)
SET LRXN=$PIECE(LRX13,";")
+18 IF LRX13>0
IF $PIECE(LRX13,";",2)="SC("
SET LRLOCNM=$PIECE(^SC(LRXN,0),U)
SET LRDIV=$PIECE(^SC(LRXN,0),U,4)
+19 IF LRX13>0
IF $PIECE(LRX13,";",2)="DIC(4,"
SET LRDIV=LRXN
+20 IF '$GET(LRDIV)
SET LRDIV=$PIECE($GET(^SC(+LRLOCN,0)),U,4)
+21 IF LRDIV
SET LRDIVNM=$PIECE($$NS^XUAF4(LRDIV),U)
+22 IF '$TEST
SET LRDIV=0
SET LRDIVNM="UNKNOWN"
+23 if LRDIV=""
SET LRDIV=0
+24 SET LRCOLN=+$PIECE(LRX,U,11)
SET LRCOLNM=$PIECE($GET(^LAB(62,LRCOLN,0)),U)
IF '$LENGTH(LRCOLNM)
SET LRCOLNM=LRUNK
+25 ;MULTIDIVISIONAL PATCH LR*5.2*257 -3/01
+26 ;if report is for specific division, collect only that data
+27 IF $DATA(LRM("DIV","S"))
Begin DoDot:2
+28 SET LRSDIV=0
+29 FOR
SET LRSDIV=$ORDER(LRM("DIV","S",LRSDIV))
if LRSDIV=""
QUIT
Begin DoDot:3
+30 IF LRSDIV=LRDIV
IF LRDIV'=0
DO ^LRMITSPO
End DoDot:3
+31 QUIT
End DoDot:2
QUIT
+32 ; get data on organisms
+33 DO ^LRMITSPO
End DoDot:1
+34 QUIT
CHECK(LRDFN,LRIDT,LROTYPE) ; lab patient, time, organism types -> 1 or 0 if data available
+1 IF $DATA(LROTYPE("B"))
IF $DATA(^LR(LRDFN,"MI",LRIDT,3))
QUIT 1
+2 IF $DATA(LROTYPE("F"))
IF $DATA(^LR(LRDFN,"MI",LRIDT,8))
QUIT 1
+3 IF $DATA(LROTYPE("M"))
IF $DATA(^LR(LRDFN,"MI",LRIDT,11))
QUIT 1
+4 IF $DATA(LROTYPE("P"))
IF $DATA(^LR(LRDFN,"MI",LRIDT,5))
QUIT 1
+5 IF $DATA(LROTYPE("V"))
IF $DATA(^LR(LRDFN,"MI",LRIDT,16))
QUIT 1
+6 IF '$DATA(LROTYPE("B"))
IF $DATA(^LR(LRDFN,"MI",LRIDT,3))
QUIT 1
+7 QUIT 0
VALUE(Y,FILE,FIELD) ; $$(internal value,file,field) -> external value or ""
+1 IF 'Y
QUIT ""
+2 NEW C
SET C=$PIECE(^DD(FILE,FIELD,0),U,2)
DO Y^DIQ
QUIT Y
LOS(DFN,CDATE) ; $$(patient,collection date) -> length of stay or ""
+1 NEW ADATE
SET VAINDT=CDATE
DO INP^VADPT
SET ADATE=$PIECE(VAIN(7),U)
DO KVAR^VADPT
IF '$LENGTH(ADATE)
QUIT ""
+2 QUIT $$FMDIFF^XLFDT(CDATE,ADATE)
