Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LREPI

LREPI.m

Go to the documentation of this file.
  1. LREPI ;DALOI/SED - EMERGING PATHOGENS SEARCH ;Aug 20, 2021@09:32
  1. ;;5.2;LAB SERVICE;**132,175,260,281,421,509,552**;Sep 27, 1994;Build 2
  1. ;
  1. ; Reference to ^DGPT supported by IA #418
  1. ; Reference to ^ORD(101 supported by IA #872
  1. ; Reference to PATS^PXRMXX supported by IA #3134
  1. TEST S LRRPS=3000501,LRRPE=3000531,LRRTYPE=1
  1. S LREPI(2)="",LREPI(17)="",LREPI(18)="",LREPI(19)=""
  1. ;S D0=0 F S D0=$O(^LAB(69.5,D0)) Q:+D0'>0 D
  1. ;.Q:$P(^LAB(69.5,D0,0),U,2)="1"
  1. ;.Q:$P(^LAB(69.5,D0,0),U,7)=""
  1. ;.Q:'$D(^ORD(101,$P(^LAB(69.5,D0,0),U,7),0))
  1. ;.S LREPI(D0)=""
  1. S LRBEG=9999999-(LRRPE+.9),LREND=9999999-LRRPS+.999999
  1. EN ;
  1. ;
  1. INIT ;Set up search criteria
  1. ;Fix start and stop date problem CKA 6/2/2002
  1. ;LR*5.2*552: Correction for date range to scan. Added +1 to LRRPE.
  1. S LRBEG=(9999999-(LRRPE+1))_".0000001",LREND=9999999-LRRPS+.999999
  1. ; Determine which Coding to system to activate:
  1. ; If report beginning date and ending date are prior to ICDx effective date
  1. ; report will print patients with ICD diagnosis codes
  1. ; and for summary report, count only ICD codes.
  1. ; If report beginning date and ending date are on or after ICDx effective date
  1. ; report will print patients with ICDx diagnosis codes
  1. ; and for summary report, count only ICDx codes.
  1. ; If report beginning date is prior to ICDx effective date and report ending date is on or after ICDx effective date
  1. ; report will print patients that have either ALL valid diagnosis codes
  1. ; and count both ALL valid diagnosis codes.
  1. ;
  1. N LRBEGSYS,LRENDSYS
  1. S LRBEGSYS=+$$ICDSYS^LREPICD(LRRPS,"D"),LRENDSYS=+$$ICDSYS^LREPICD(LRRPE,"D")
  1. K LREPISYS S:LRBEGSYS=0 LRBEGSYS=9 S:LRENDSYS=0 LRENDSYS=9 F LREPISYS=LRBEGSYS:1:LRENDSYS S LREPISYS(LREPISYS)=""
  1. ;
  1. K ^TMP($J),^TMP("HLS",$J)
  1. S D0=0 F S D0=$O(LREPI(D0)) Q:+D0'>0 D
  1. .S ^TMP($J,$P(^LAB(69.5,D0,0),U,7))=""
  1. .S:$P(^LAB(69.5,D0,0),U,8)=1 ^TMP($J,"LREPI",D0)=""
  1. .S LRPROT=$P(^LAB(69.5,D0,0),U,7)
  1. .Q:LRPROT=""
  1. .S D1=0 F S D1=$O(^LAB(69.5,D0,1,D1)) Q:+D1'>0 D
  1. ..S TST=$P(^LAB(69.5,D0,1,D1,0),U)
  1. ..Q:'$D(^LAB(60,TST,0))
  1. ..Q:$P(^LAB(60,TST,0),U,4)=""
  1. ..I $P(^LAB(60,TST,0),U,4)="CH" D
  1. ...Q:$P(^LAB(60,TST,0),U,5)=""
  1. ...S ^TMP($J,"T",TST,D0)=""
  1. ...S ^TMP($J,"TPROT",TST,LRPROT)=""
  1. ...S LRIND=$P(^LAB(69.5,D0,1,D1,0),U,2,3)
  1. ...S ^TMP($J,$P(^LAB(60,TST,0),U,4),TST)=$P(^LAB(60,TST,0),U,5)_U_LRIND
  1. ..I $P(^LAB(60,TST,0),U,4)="CY" D
  1. ...S ^TMP($J,"T",TST,D0)=""
  1. ...S ^TMP($J,$P(^LAB(60,TST,0),U,4),TST)=""
  1. .S D1=0 F S D1=$O(^LAB(69.5,D0,2,D1)) Q:+D1'>0 S ^TMP($J,"E",$P(^LAB(69.5,D0,2,D1,0),U),D0)=""
  1. .S D1=0 F S D1=$O(^LAB(69.5,D0,9,D1)) Q:+D1'>0 S ^TMP($J,"SNO",$P(^LAB(69.5,D0,9,D1,0),U),D0)=""
  1. .S D1=0 F S D1=$O(^LAB(69.5,D0,3,D1)) Q:+D1'>0 D
  1. ..S LREPISYS=$S(+$P(^LAB(69.5,D0,3,D1,0),U,2)=30:10,1:9)
  1. ..S:$D(LREPISYS(LREPISYS))&($P(^LAB(69.5,D0,3,D1,0),U)]"") ^TMP($J,"ICD",$P(^LAB(69.5,D0,3,D1,0),U),D0)=""
  1. K D0,D1,TST,LRIND
  1. I $D(^TMP($J,"LREPI")) D SEARCH^LREPI4
  1. I $D(^TMP($J,"ICD")) D PTF^LREPI5
  1. LAB63 ;Search file 63 for lab data
  1. K LRIND
  1. S LRDFN=0 F S LRDFN=$O(^LR(LRDFN)) Q:+LRDFN'>0 D
  1. .Q:'$D(^LR(LRDFN,0))
  1. .Q:$P(^LR(LRDFN,0),U,2)'=2
  1. .S LRPAT=$P(^LR(LRDFN,0),U,3)
  1. .I $D(^TMP($J,"CH")) D CH
  1. .I $D(^TMP($J,"CY")) D CYTST^LREPICY
  1. .I $D(^TMP($J,"E")) D MI
  1. .;I '$D(^TMP($J,"ICD"))&($D(^TMP($J,"SNO"))) D CY^LREPICY
  1. .I $D(^TMP($J,"SNO")) D CY^LREPICY
  1. ;Retrieve patient list from Clinical Reminders
  1. S LRPROTX=$O(^ORD(101,"B","LREPI",""))
  1. I LRPROTX]"" S LRSRXX="",LRSRGO=0 F S LRSRXX=$O(LREPI(LRSRXX)) Q:'LRSRXX I $G(^LAB(69.5,LRSRXX,0))["HEPATITIS" D Q
  1. . ;D PATS^PXRMXX(LRRPS,LRRPE,"LREPISRCH") ;LR509: no longer collect Clinical Reminder info for EPI
  1. . S EPISRCH=0 F S EPISRCH=$O(^TMP("LREPISRCH",$J,EPISRCH)) Q:'EPISRCH D
  1. . . S LRENCDT=$P(^TMP("LREPISRCH",$J,EPISRCH),"^") Q:'LRENCDT
  1. . . Q:$D(^TMP($J,LRPROTX,EPISRCH,LRENCDT)) ;Encounter date already exists, don't update
  1. . . S ^TMP($J,LRPROTX,EPISRCH,LRENCDT)=$P(^TMP("LREPISRCH",$J,EPISRCH),"^",2)
  1. I $G(LRREP) D ^LREPI2A
  1. I '$G(LRREP) D ^LREPI2
  1. EXIT ;EXIT
  1. S D0=0
  1. I $G(LRRTYPE)=0 F S D0=$O(LREPI(D0)) Q:+D0'>0 D
  1. .S $P(^LAB(69.5,D0,0),U,4)=DT
  1. K LREPI,DFN,CNT,DA,DIE,DR,DQ,HL,ENTRY,ENDT,ENC,FD,HLECH,HLFS,HLN,HLQ
  1. K DDER,D0,HLRST,HLSAN,LRBEG,LRCNT,LRCS,LRDATE,LRDFN,LREFG,LRENCDT
  1. K LREND,LRETND,LRHL7,LRINV,LRINVD,LRITN,LRND,LRNL,LRNLT,LRNTE,LROBR
  1. K LRPAT,LRPFG,LRPID,LRPROT,LRPV1,LRRPE,LRRPS,LRRTYPE,LRTND,LRTNM,MSG
  1. K MSGCNT,PTF,RR,SEG,SP,STDT,TST,UN,TSTNM,VAERR,X,XCNP,XMDUZ,XMZ,ZTSK
  1. K AF,D,DI,LRENT,LRIND,LRPATH,OV,LRENDT,ADMDT,EPISITE,EPISRCH
  1. K LR31799Z,LRANTI,LRCHK,LRIC,LRIEN,LRIPT,LRMG,LRMGN,LRNX,LRO,LROK
  1. K LROVR,LRPCNT,LRPTOT,LRSI,LRSITE,LRCYSP,LRDIS,LRDISI,LRIC,LRICD
  1. K LRICDI,LRIEN,LRIPT,LRMG,LRMGN,LRMOR,LRMORI,LRMSG,PXRMITEM
  1. K LRSNM,LRSNO,LRSTOP,LRSUB,LRTOP,LRTOPP,LRWKI,LRPRO,LRPROI
  1. K LRNDC,LRNTE1,LRFIND,LRDRUG,LRCODE,LRDRSEQ,HLHDR,HLMTIEN,HLMTIENS
  1. K HLNEXT,HLNODE,HLQUIT,HLRESLT,HLRESLTA,LRANS,LRDRSQ1,LRPROTX,LRPTY
  1. K LRPVVV,LRSRGO,LRSRXX,LRTOLD,LRTRM,LRPREV,LRPRECYC,X1,X2,X3
  1. K LRANTIND,LRANTINV,LRREP,LRPV1NUM,LREPISYS
  1. Q
  1. ENCT ;SET THE ENCOUNTER FOR PV1
  1. S LRPROT=$P(^LAB(69.5,LRPATH,0),U,7)
  1. S LRCHK=0 D ADDCHK^LREPI5 Q:LRCHK
  1. S LRDATE=9999999-LRINV
  1. K VAIN,DFN,VAINDT S DFN=LRPAT,VAINDT=LRDATE D INP^VADPT
  1. S LRENCDT=$S(VAIN(7)'="":$P(VAIN(7),U),1:LRDATE)
  1. I $P(^LAB(69.5,LRPATH,0),U,8)=1 D CHECK^LREPI4
  1. S:'$D(^TMP($J,LRPROT,LRPAT,LRENCDT)) ^TMP($J,LRPROT,LRPAT,LRENCDT)=$S(VAIN(7)'="":"I",1:"O")_U_$G(VAIN(10))
  1. S:$P(^TMP($J,LRPROT,LRPAT,LRENCDT),U)="O" ^(LRENCDT)="O"_U_$S($D(LRPATLOC):LRPATLOC,1:"")
  1. S:'$D(^TMP($J,LRPROT,LRPAT,LRENCDT,LRPATH,LRINV,ND)) ^TMP($J,LRPROT,LRPAT,LRENCDT,LRPATH,LRINV,ND)=""
  1. I $G(LRANTIND)="",$G(LRANTINV)="" Q
  1. S:'$D(^TMP($J,LRPROT,LRPATH,LRENCDT,LRPAT,LRINV,ND,LRANTIND,LRANTINV)) ^TMP($J,LRPROT,LRPAT,LRENCDT,LRPATH,LRINV,ND,LRANTIND,LRANTINV)=""
  1. Q
  1. CH ;Check the 'CH' node
  1. S LRINV=LRBEG
  1. F S LRINV=$O(^LR(LRDFN,"CH",LRINV)) Q:+LRINV'>0!(LRINV>LREND) D
  1. .Q:$P(^LR(LRDFN,"CH",LRINV,0),U,3)=""
  1. .S LRCNT=1,LRTST=0 F S LRTST=$O(^TMP($J,"CH",LRTST)) Q:+LRTST'>0 D
  1. ..S LRND=$P($P(^TMP($J,"CH",LRTST),";",2),U,1) Q:+LRND'>0
  1. ..S LRPC=$P($P(^TMP($J,"CH",LRTST),";",3),U,1) Q:+LRPC'>0
  1. ..S LRRES=$P($G(^LR(LRDFN,"CH",LRINV,LRND)),U,LRPC) Q:LRRES=""
  1. ..S LRPATLOC=$P(^LR(LRDFN,"CH",LRINV,0),U,13)
  1. ..S ^TMP($J,"TST",LRTST)=+$G(^TMP($J,"TST",LRTST))+1
  1. ..S ^TMP($J,"TST",LRTST,LRDFN)=""
  1. ..S LRPATH=0 F S LRPATH=$O(^TMP($J,"T",LRTST,LRPATH)) Q:+LRPATH'>0 D CHKIND
  1. K LRTST,LRND,LRPC,LRRES,LRNO
  1. Q
  1. CHKIND ;Check the results
  1. I '$D(^LAB(69.5,LRPATH,1,"B",LRTST)) Q
  1. S LRITST=0,ND="CH",LRNO=0
  1. F S LRITST=$O(^LAB(69.5,LRPATH,1,"B",LRTST,LRITST)) Q:+LRITST'>0 D D:'LRNO ENCT
  1. .S LRNO=0
  1. .S LRIND=$P(^LAB(69.5,LRPATH,1,LRITST,0),U,2,3)
  1. .Q:$P(LRIND,U,1)=""
  1. .I $P(LRIND,U,1)=1 D Q
  1. ..Q:'LRRES#2
  1. ..S LRSPEC=$P($G(^LR(LRDFN,"CH",LRINV,0)),U,5) Q:LRSPEC=""
  1. ..Q:'$D(^LAB(60,LRTST,1,LRSPEC,0))
  1. ..S LRLOW=$P(^LAB(60,LRTST,1,LRSPEC,0),U,2),LRHIG=$P(^(0),U,3)
  1. ..Q:'LRLOW#2!('LRHIG#2)
  1. ..I LRRES<LRLOW!(LRRES>LRHIG) Q
  1. ..S LRNO=1
  1. .I $P(LRIND,U,2)="" Q
  1. .S LRRES=$$UP^XLFSTR(LRRES),LRIND=$$UP^XLFSTR(LRIND)
  1. .I $P(LRIND,U,1)=2,(LRRES[$P(LRIND,U,2)) Q
  1. .I $P(LRIND,U,1)=3,(LRRES>$P(LRIND,U,2)) Q
  1. .I $P(LRIND,U,1)=4,(LRRES<$P(LRIND,U,2)) Q
  1. .I $P(LRIND,U,1)=5,(LRRES=$P(LRIND,U,2)) Q
  1. .S LRNO=1
  1. K LRITST,LRLOW,LRHIG,LRSPEC
  1. Q
  1. MI ;Check the 'MI' node
  1. S LRINV=LRBEG
  1. F S LRINV=$O(^LR(LRDFN,"MI",LRINV)) Q:+LRINV'>0!(LRINV>LREND) D
  1. .S LRCNT=1
  1. .F LRMIND=3,6,9,12,17 S LRETND=0 F S LRETND=$O(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND)) Q:+LRETND'>0 D
  1. ..I LRMIND=3,$P($G(^LR(LRDFN,"MI",LRINV,1)),U,2)'="F" Q
  1. ..I LRMIND'=3,$P($G(^LR(LRDFN,"MI",LRINV,(LRMIND-1))),U,2)'="F" Q
  1. ..S LRETI=$P($G(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,0)),U)
  1. ..Q:+LRETI'>0
  1. ..Q:'$D(^TMP($J,"E",LRETI))
  1. ..S ^TMP($J,"EPROT",LRETI)=""
  1. ..S ^TMP($J,"ETI",LRETI)=+$G(^TMP($J,"ETI",LRETI))+1
  1. ..S ^TMP($J,"ETI",LRETI,LRDFN)=""
  1. ..S LRPATH=0 F S LRPATH=$O(^TMP($J,"E",LRETI,LRPATH)) Q:+LRPATH'>0 D
  1. ...S ND="MI"
  1. ...D TOP Q:LRTOP
  1. ...I LRMIND=3 D ANTI Q
  1. ...D ENCT
  1. K LRMIND,LRETI
  1. Q
  1. TOP ;CHECK TO SEE IF SCREEN ON SITE
  1. S LRTOP=0
  1. S LRSITE=$P($G(^LR(LRDFN,"MI",LRINV,0)),U,5) Q:+LRSITE'>0
  1. I ($O(^LAB(69.5,LRPATH,5,0))="")&($O(^LAB(69.5,LRPATH,6,0))="") Q
  1. I ($O(^LAB(69.5,LRPATH,5,0))'="")&($O(^LAB(69.5,LRPATH,6,0))'="") Q
  1. I ($O(^LAB(69.5,LRPATH,5,0))'="")&($D(^LAB(69.5,LRPATH,5,"B",LRSITE))) Q
  1. I ($O(^LAB(69.5,LRPATH,6,0))'="")&('$D(^LAB(69.5,LRPATH,6,"B",LRSITE))) Q
  1. S LRTOP=1
  1. Q
  1. ANTI ;LOOK FOR THE ANTIMICROBIAL SUS FOR ORGANISMS
  1. I $O(^LAB(69.5,LRPATH,4,0))="" D ENCT Q
  1. S LRANTI=0 F S LRANTI=$O(^LAB(69.5,LRPATH,4,LRANTI)) Q:+LRANTI'>0 D
  1. .S LRANT=$G(^LAB(69.5,LRPATH,4,LRANTI,0),U),LRANTIND=$P(^(0),U,2),LRANTINV=$P(^(0),U,3) Q:+LRANT'>0
  1. .S LRAND=$P($G(^LAB(62.06,LRANT,0)),U,2) Q:LRAND=""
  1. .Q:'$D(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND))
  1. .Q:$P(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND),U,2)=""
  1. .Q:$$UP^XLFSTR($E($P($G(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND)),U,2),1,1))="S"
  1. .D ENCT
  1. .;CHECK MIC VALUES
  1. .I LRANTIND=""!(LRANTINV="") Q
  1. .S LRRES=$$UP^XLFSTR($E($P($G(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND)),U,2),1,1)),LRANTINV=$$UP^XLFSTR(LRANTINV),LRANTIND=$$UP^XLFSTR(LRANTIND)
  1. .I LRANTIND=1,(LRRES[LRANTINV) D ENCT Q
  1. .I LRANTIND=2,(LRRES>LRANTINV) D ENCT Q
  1. .I LRANTIND=3,(LRRES<LRANTINV) D ENCT Q
  1. .I LRANTIND=4,(LRRES=LRANTINV) D ENCT Q
  1. Q
  1. ;