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

BLRTNM.m

Go to the documentation of this file. 
  1. BLRTNM ; IHS/HQT/MJL - SET IHS LAB TRANSACTION LOG - MICRO ;MAY 06, 2009 9:58 AM
  1.  ;;5.2;IHS LABORATORY;**1011,1014,1015,1025,1026,1030**;NOV 01, 1997
  1.  ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ^BLRTNM")
  1.  S BLRLRDFN=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRDFN"))
  1.  S BLRIDT=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRIDT"))
  1.  S (BLRTEST,BLRCULT)=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"BLRTEST"))
  1.  S (BLRCMPD,BLRCOLSP,BLRRES,BLRTESTN,BLRANTI,BLRANTN,BLRANTP,BLRSTGN,BLRORG,BLRSTG,BLRCMTS)=""
  1.  ;
  1.  I 'BLRTEST D KILL Q
  1.  ;
  1.  ;
  1.  S BLREXEC=$P($G(^LAB(60,BLRTEST,0)),U,14)  ;'EDIT CODE'
  1.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 MODIFICATIONS
  1.  ;            Check to make sure Edit code exists.
  1.  ;            If not, set error message and quit because it's
  1.  ;            not possible to process the transaction.
  1.  I +$G(BLREXEC)<1  D  Q
  1.  . S BLRERR=1
  1.  . S BLRERROR(1)="Null/Zero Edit code for Lab Test IEN:"_BLRTEST_".  Invalid."
  1.  ; ----- END ISH/OIT/MKK LR*5.2*1025 MODICATIONS
  1.  ;
  1.  ;GET FIRST FIELD # IN THE EXECUTE CODE???
  1.  ; S BLRGBL=$P($P($P($G(^LAB(62.07,BLREXEC,.1)),"/"),"=",2),"""",2)
  1.  S BLRGBL=+$P($P($P($G(^LAB(62.07,BLREXEC,.1)),"/"),"=",2),"""",2)   ; IHS/OIT/MKK - LR*5.2*1030 -- Cow Creek Correction
  1.  ;
  1.  ;LOOK AT 'MICROBIOLOGY SUB-FIELD'
  1.  ; S BLRGBL=$P($P($G(^DD(63.05,BLRGBL,0)),U,4),";",1)  ;GET THE SUBSCRIPT
  1.  S BLRGBL=+$P($P($G(^DD(63.05,BLRGBL,0)),U,4),";",1)  ;GET THE SUBSCRIPT  ; IHS/OIT/MKK - LR*5.2*1030 -- Cow Creek Correction
  1.  ;GET THAT SUBSCRIPT LEVEL'S VALUE
  1.  S BLRVAL=$G(^LR(BLRLRDFN,"MI",BLRIDT,BLRGBL))
  1.  S BLRACCN=$G(^LR(BLRLRDFN,"MI",BLRIDT,0))
  1.  Q:$G(BLRACCN)=""  ;IHS/ITSC/TPF 06/06/02 CAN'T PROCESS IF NO ACCESSION
  1.  ;                  DUE TO A DELETION
  1.  S BLRCOLSP=$P(BLRACCN,U,11),BLRACCN=$P(BLRACCN,U,6),BLR60F=1,BLRSETP=0,BLRERFS=""
  1.  Q:(BLRVAL=""!($P(BLRVAL,U,2)'="F"))
  1.  S BLRAA=$G(^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRAA")),BLRAD=$G(^("LRAD")),BLRAN=$G(^("LRAN")),BLRSS=$G(^("LRSS")),BLRODT=$G(^("LRODT")),BLRSEQ=$G(^("LRSN")),BLRSPEC=$G(^("LRSPEC"))
  1.  S:+BLRTEST BLRCMPD=$P($G(^LRO(68,BLRAA,1,BLRAD,1,BLRAN,4,BLRTEST,0)),U,5)
  1.  I BLRTEST'="",$D(^BLRTXLOG("AAT",BLRACCN,BLRTEST)) D
  1.  .I BLRGBL=1 D BACT Q
  1.  .I BLRGBL=5 D PARAS Q
  1.  .I BLRGBL=8 D MYCOL Q
  1.  .I BLRGBL=11 D TB Q
  1.  .I BLRGBL=16 D VIROL Q
  1.  D KILL
  1.  Q
  1.  ;
  1. BACT ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BACT^BLRTNM")
  1.  S BLRRES="NEGATIVE"
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,25)) D GETRES(25) D BLDMSTR Q
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,2)) D GETRES(2) S BLRTESTN="GRAM STAIN",BLRTEST=$O(^LAB(60,"B",BLRTESTN,"")) D:BLRCULT=BLRTEST BLDMSTR Q:BLRCULT=BLRTEST  D LOOKTST
  1.  S BLRTESTN="",BLRRES="NEGATIVE",BLRTEST=BLRCULT
  1.  I '$D(^LR(BLRLRDFN,"MI",BLRIDT,3)) D BLDMSTR Q
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,3)),$P(^LR(BLRLRDFN,"MI",BLRIDT,3,0),U,3)="" D BLDMSTR Q
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,3)),$P(^LR(BLRLRDFN,"MI",BLRIDT,3,0),U,4)=0 D BLDMSTR Q  ;organism deleted
  1.  S BLRRES="POSITIVE",BLRTEST=^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"BLRTEST") D BLDMSTR S BLRSPT=3 D ORG Q
  1.  Q
  1.  ;
  1. PARAS ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER PARAS^BLRTNM")
  1.  S BLRRES="NEGATIVE"
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,24)) D GETRES(24),BLDMSTR Q
  1.  I '$D(^LR(BLRLRDFN,"MI",BLRIDT,6)) D BLDMSTR Q
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,6)),$P(^LR(BLRLRDFN,"MI",BLRIDT,6,0),U,3)="" D BLDMSTR Q
  1.  S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=6 D PARAS1 Q
  1.  Q
  1.  ;
  1. PARAS1 ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER PARAS1^BLRTNM")
  1.  S (BLRORGX,BLR60F)=0 F  S BLRORGX=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX)) Q:(BLRORGX'?.N!(BLRORGX=""))  S BLRORG=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0),BLRRES="",BLRORG=+BLRORG D LOOKORG,PARAS2
  1.  Q
  1. PARAS2 ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER PARAS2^BLRTNM")
  1.  S BLRPAR=$O(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
  1.  S BLRSTG=0 F  S BLRSTG=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG)) Q:(BLRSTG=""!(BLRSTG'?.N))  D
  1.  .S BLRSTGN=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,1,BLRSTG,0)
  1.  .S BLRRES=$P(BLRSTGN,U,2),BLRSTGN=$P(BLRSTGN,U,1)
  1.  .D LOOKSTG S BLRSTGN="" Q
  1.  S BLRSTG=""
  1.  Q
  1.  ;
  1. MYCOL ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER MYCOL^BLRTNM")
  1.  S BLRRES="NEGATIVE"
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,15)) D GETRES(15) D BLDMSTR Q
  1.  I '$D(^LR(BLRLRDFN,"MI",BLRIDT,9)) D BLDMSTR Q
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,9)),$P(^LR(BLRLRDFN,"MI",BLRIDT,9,0),U,3)="" D BLDMSTR Q
  1.  S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=9 D ORG Q
  1.  Q
  1.  ;
  1. TB ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER TB^BLRTNM")
  1.  I ($P(BLRVAL,U,3)'=""!($P(BLRVAL,U,4)'="")) D GETFSTAI
  1.  I BLRCULT=BLRTEST,BLRRES'="" Q
  1.  S BLRTEST=BLRCULT,BLRTESTN=""
  1.  I '$D(^LR(BLRLRDFN,"MI",BLRIDT,12)) S BLRRES="NEGATIVE" D BLDMSTR Q
  1.  D:'$D(^UTILITY("TB",$J)) BLDTB
  1.  S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=12 D ORG Q
  1.  Q
  1.  ;
  1. BLDTB ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BLDTB^BLRTNM")
  1.  S BLRPX=1 F  S BLRPX=$O(^DD(63.39,"GL",BLRPX)) Q:BLRPX=""  S BLRFLD=$O(^DD(63.39,"GL",BLRPX,1,"")),^UTILITY("TB",$J,BLRPX)=$P(^DD(63.39,BLRFLD,0),U,1)
  1.  K BLRFLD,BLRPX
  1.  Q
  1. GETFSTAI ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETFSTAI^BLRTNM")
  1.  S BLRTESTN="ACID FAST STAIN" S BLRTEST=$O(^LAB(60,"B",BLRTESTN,"")) I BLRTEST="" S BLRTESTN="AFB SMEAR" S BLRTEST=$O(^LAB(60,"B",BLRTESTN,""))
  1.  S BLRRES=$P(BLRVAL,U,3) I BLRRES'="",$P(BLRVAL,U,4)'="" S BLRRES=BLRRES_";"_$P(BLRVAL,U,4)
  1.  S:BLRRES="" BLRRES=$P(BLRVAL,U,4)
  1.  D LOOKTST
  1.  Q
  1. VIROL ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VIROL^BLRTNM")
  1.  S BLRRES="NEGATIVE"
  1.  I '$D(^LR(BLRLRDFN,"MI",BLRIDT,17)) D BLDMSTR Q
  1.  I $D(^LR(BLRLRDFN,"MI",BLRIDT,17)),$P(^LR(BLRLRDFN,"MI",BLRIDT,17,0),U,3)="" D BLDMSTR Q
  1.  S BLRRES="POSITIVE" D BLDMSTR S BLRSPT=17 D ORG Q
  1.  Q
  1.  ;
  1. ORG ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ORG^BLRTNM")
  1.  S (BLRORGX,BLR60F)=0 F  S BLRORGX=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX)) Q:(BLRORGX'?.N!(BLRORGX=""))  S BLRORG=^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,0) S BLRRES=$P(BLRORG,U,2),BLRORG=+BLRORG D LOOKORG D:BLRSPT'=17 ANTIB
  1.  Q
  1.  ;
  1. ANTIB ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER ANTIB^BLRTNM")
  1.  S BLRPAR=$O(^BLRTXLOG("AOG",BLRACCN,BLRORG,""))
  1.  ; S BLRANTI=1 F  S BLRANTI=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)) Q:(BLRANTI=""!($L(BLRANTI)=1))  S BLRRES=$P(^(BLRANTI),U,1) S:BLRGBL'=11 BLRANTP=$O(^LAB(62.06,"AD",BLRANTI,"")) D:BLRGBL=11 GETANAME D LOOKDRG S BLRERFS="" K BLRERF
  1.  ; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 -- Need to bypass non-existent Drug Nodes in the ANTIMICROBIAL SUSCEPTIBILITY dictionary
  1.  S BLRANTI=1
  1.  F  S BLRANTI=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)) Q:(BLRANTI=""!($L(BLRANTI)=1))  D
  1.  . S BLRRES=$P($G(^LR(BLRLRDFN,"MI",BLRIDT,BLRSPT,BLRORGX,BLRANTI)),U,1)
  1.  . S:BLRGBL'=11 BLRANTP=$O(^LAB(62.06,"AD",BLRANTI,""))
  1.  . D:BLRGBL=11 GETANAME
  1.  . D:$G(BLRANTP)'="" LOOKDRG
  1.  . S BLRERFS=""
  1.  . K BLRERF
  1.  ; ----- END IHS/OIT/MKK LR*5.2*1025 -- Need to bypass non-existent Antibiotics
  1.  S (BLRANTI,BLRANTP)=""
  1.  Q
  1. GETANAME ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETANAME^BLRTNM")
  1.  S BLRANTP=BLRANTI
  1.  S BLRANTN=^UTILITY("TB",$J,BLRANTP)
  1.  S X=BLRANTN,DIC=62.06,DIC(0)="MX" D ^DIC
  1.  I Y'=-1 S BLRANTP=$P(Y,U,1) Q
  1.  S BLRERFS="Field 1302 of file 9009022 not a valid antibiotic ien",BLRERF=1
  1.  Q
  1.  ;
  1. LOOKTST ;
  1.  ; ----- BEGIN IHS/OIT/MKK LR*5.2*1026 - Make sure BLRTEST variable exists
  1.  I +$G(BLRTEST)<1  Q
  1.  ; ----- BEGIN IHS/OIT/MKK LR*5.2*1026 MODIFICATIONS 
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKTST^BLRTNM")
  1.  S BLRSETP=1
  1.  I '$D(^BLRTXLOG("AAT",BLRACCN,BLRTEST)) S BLRPAR=$O(^BLRTXLOG("AAT",BLRACCN,BLRCULT,"")) D ^BLRTNM1 Q
  1.  D BLDMSTR
  1.  Q
  1. LOOKORG ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKORG^BLRTNM")
  1.  I '$D(^BLRTXLOG("AOG",BLRACCN,BLRORG)) S BLRPAR=$O(^BLRTXLOG("AAT",BLRACCN,BLRCULT,"")) D ^BLRTNM1 Q
  1.  D BLDMSTR
  1.  Q
  1.  ;
  1. LOOKDRG ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKDRG^BLRTNM")
  1.  I '$D(^BLRTXLOG("AOD",BLRACCN,BLRORG,BLRANTP)) D ^BLRTNM1 Q
  1.  D BLDMSTR
  1.  Q
  1.  ;
  1. LOOKSTG ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER LOOKSTG^BLRTNM")
  1.  I '$D(^BLRTXLOG("AOS",BLRACCN,BLRORG,BLRSTG)) D ^BLRTNM1 Q
  1.  D BLDMSTR
  1.  Q
  1. BLDMSTR ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER BLDMSTR^BLRTNM")
  1.  S BLRCMF="M"
  1.  I BLR60F S BLRCRSBS="""AAT"",BLRACCN,BLRTEST",BLRDIR=-1,BLROKCK="",BLRBADCK="",BLR("PANEL/TEST POINTER")=BLRTEST,BLR("PANEL/TEST NAME")=BLRTESTN,BLR("RESULT")=BLRRES S:BLRCMTS'="" BLR("COMMENTS")=BLRCMTS
  1.  I 'BLR60F D
  1.  .I BLRSPT'=6 D  Q
  1.  ..;S BLRSTR="SEQUENCE NUMBER_$$GETOGIEN(BLRACCN,BLRORG"_$S(BLRANTI="":")",1:",BLRANTP)~ANTIBIOTIC_BLRANTP")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG~ANTIBIOTIC NAME_BLRANTN~PCC ERROR FLAG_BLRERFS" Q
  1.   ..S BLRCRSBS=""""_$S(BLRANTP'="":"AOD",1:"AOG")_""",BLRACCN,BLRORG",BLRDIR=-1,BLROKCK="CHKDT",BLRBADCK=""
  1.  ..S BLR("RESULT")=BLRRES,BLR("ORGANISM")=BLRORG,BLR("ANTIBIOTIC NAME")=BLRANTN,BLR("PCC ERROR FLAG")=BLRERFS
  1.  ..S:BLRANTP'="" BLRCRSBS=BLRCRSBS_",BLRANTP",BLR("ANTIBIOTIC")=BLRANTP
  1.  .;S BLRSTR="SEQUENCE NUMBER_$$GETOSIEN(BLRACCN,BLRORG"_$S(BLRSTG="":")",1:",BLRSTG)~STAGE COUNTER_BLRSTG")_"~STATUS FLAG_BLRPHASE~RESULT_BLRRES~ORGANISM_BLRORG" S:BLRSTGN'="" BLRSTR=BLRSTR_"~STAGE NAME_BLRSTGN" Q
  1.  .S BLRCRSBS=""""_$S(BLRSTG'="":"AOS",1:"AOG")_""",BLRACCN,BLRORG",BLRDIR=-1,BLROKCK="CHKDT",BLRBADCK=""
  1.  .S BLR("RESULT")=BLRRES,BLR("ORGANISM")=BLRORG S:BLRSTGN'="" BLR("STAGE NAME")=BLRSTGN Q
  1.  .S:BLRSTG'="" BLRCRSBS=BLRCRSBS_",BLRSTG",BLR("STAGE COUNTER")=BLRSTG
  1.  S BLR("COLLECTION SAMPLE POINTER")=BLRCOLSP S:+BLRCMPD BLR("COMPLETE DATE")=BLRCMPD
  1.  S BLR("SEQUENCE NUMBER")=$$GETIEN D:'BLRERR ^BLRNFLTL
  1.  S BLRCMTS=""
  1.  K BLR
  1.  Q
  1.  ;
  1. GETRES(BLRRSUB) ;
  1.  ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETRES^BLRTNM")
  1.  S BLRYY=0 F BLRI=1:1 S BLRYY=$O(^LR(BLRLRDFN,"MI",BLRIDT,BLRRSUB,BLRYY)) Q:BLRYY=""  S:BLRI>1 BLRCMTS=BLRCMTS_$C(20) S BLRCMTS=BLRCMTS_^LR(BLRLRDFN,"MI",BLRIDT,BLRRSUB,BLRYY,0)
  1.  I BLRCMTS'="" S BLRRES="POSITIVE"
  1.  K BLRI
  1.  Q
  1.  ;
  1. GETIEN() ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETIEN^BLRTNM")
  1.  S BLRERR=0 I BLRCMF="C" D GETNEW Q BLRENT
  1.  D
  1.  .S BLRCRGL="^BLRTXLOG("_BLRCRSBS_")",BLRENT=$O(@BLRCRGL@(""),BLRDIR)
  1.  .S:'BLRENT BLRERR=1
  1.  .I BLRENT,BLROKCK'="" D @BLROKCK
  1.  .I 'BLRERR,BLRBADCK'="" D @BLRBADCK
  1.  .I BLRERR D EMSG Q
  1.  .S BLRIEN=BLRENT_"," Q
  1.  Q BLRENT
  1.  ;
  1. GETNEW ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER GETNEW^BLRTNM")
  1.  S BLRENT=$G(^BLRTXLOG("SEQ"))
  1.  I 'BLRENT S BLRENT=$O(^BLRTXLOG("@"),-1) I BLRENT,'$D(^BLRTXLOG(1)) S BLRENT=0
  1.  F BLRENT=BLRENT+1:1 Q:'$D(^BLRTXLOG(BLRENT))
  1.  S BLRENTS="BLRENTS",BLRENTS(1)=BLRENT,^BLRTXLOG("SEQ")=BLRENT,BLRIEN="+1,"
  1.  Q
  1.  ;
  1. CHKDT ;
  1.  D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER CHKDT^BLRTNM")
  1.  S BLRCDT=$P(^BLRTXLOG(BLRENT,12),U)
  1.  Q:$E(BLRCDT,1,3)=$E(DT,1,3)
  1.  I ($E(BLRCDT,1,3)+1)'=$E(DT,1,3) S BLRERR=1,BLRDTER=1 Q  ;MORE THAN 1 YEAR AHEAD
  1.  I $E(BLRCDT,4,5)<11 S BLRERR=1,BLRDTER=1 Q
  1.  Q
  1.  ;
  1. EMSG ;
  1.  ; Log an error because the crossreference isn't set.
  1.  I 'BLRENT D
  1.  .S BLRERR=1,BLRERROR(1)="Something wrong -- problem with IHS Lab Transaction Log Cross Reference: "_BLRCRGL
  1.  Q
  1.  ;
  1.  ;
  1. KILL ;
  1.  K BLR60F,BLRANTI,BLRANTP,BLRATOM,BLRCAT,BLRCLNC,BLRCMTS,BLRCPTC,BLRCPTF,BLRCPTP,BLRCPTS,BLRCST,BLRCULT,BLRLRDFN,BLRDTC,BLRDUZ,BLRDUZ2,BLRDUZN,BLRENT,BLREXEC,BLRFID,BLRFILE,BLRFOUND,BLRANTN,BLRERFS,BLRERF
  1.  K BLRGBL,BLRIDT,BLRL60,BLRLOC,BLRLOCN,BLRLOGDA,BLRLRDFN,BLRODT,BLRODTM,BLRORG,BLRORGX,BLRPAR,BLRPROV,BLRPROVN,BLRRES,BLRSEQ,BLRSETP,BLRSPEC,BLRSPT,BLRSTG,BLRSTGN,BLRSTR,BLRSTR1,BLRTEST
  1.  K BLRTEST1,BLRTESTN,BLRUNITS,BLRVAL,BLRXII,BLRYY,BLRZ,BLRCMPD,BLRCOLSP
  1.  Q