- 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 Feb 18, 2025@23:43:27 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)
