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

BLRMIRPT.m

Go to the documentation of this file. 
  1. BLRMIRPT ; IHS/MSC/MKK - IHS Lab Micro Report ; 15-Apr-2014 11:42 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. PEP ; EP
  1. EP ; EP
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  Q:$$GETLRDFN()="Q"
  1.  ;
  1.  W !!
  1.  ;
  1.  D B^LRU      ; Get Date Range
  1.  ;
  1.  I +$G(LRSDT)<1!(+$G(LRLDT)<1) D BADSTUFF("Quit or Invalid Data. Routine Ends.")  Q
  1.  ;
  1.  S LRSIDT=9999999-$$FMADD^XLFDT(LRLDT,1)      ; "Starting" Inverse Date
  1.  S LREIDT=9999999-LRSDT                       ; "Ending" Inverse Date
  1.  ;
  1.  W !!  D HEADONE^BLRGMENU(.HEADONE) W !!      ; Pagination
  1.  ;
  1.  D ^%ZIS
  1.  I POP D BADSTUFF("Open Device Failed.  Routine Ends.")  Q
  1.  U IO
  1.  ;
  1.  S BLRVERN=$TR($P($T(+1),";")," "),LINES=0
  1.  S LRIDT=LRSIDT,QFLG="NO"
  1.  F  S LRIDT=$O(^LR(LRDFN,"MI",LRIDT))  Q:LRIDT<1!($P(LRIDT,".")>LREIDT)!(QFLG="Q")  D
  1.  . D HEADER
  1.  . D GRAMSTAN(LRDFN,LRIDT)
  1.  . S ORGL=.9999999,ORGHEAD=0
  1.  . F  S ORGL=$O(^LR(LRDFN,"MI",LRIDT,3,ORGL))  Q:ORGL<1!(QFLG="Q")  D
  1.  .. D ORGLINE,DRUGSORT
  1.  .. W !  S LINES=LINES+1
  1.  . W !  S LINES=LINES+1
  1.  . D FOOTER
  1.  . D:IOST["VT" PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  Q
  1.  ;
  1.  S PATNAME=$$GET1^DIQ(2,DFN,"NAME")
  1.  S PATDOB=$$GET1^DIQ(2,DFN,"DATE OF BIRTH","I")
  1.  S:$L(PATDOB) PATDOB=$$FMTE^XLFDT(PATDOB,"5DZ")
  1.  S DOD=+$$GET1^DIQ(2,DFN,"DATE OF DEATH","I")
  1.  S:DOD PATDOD=$$FMTE^XLFDT(DOD,"5DZ")
  1.  S HRCN=$$HRCN^BDGF2(DFN,DUZ(2))
  1.  ;
  1.  K HEADER
  1.  S HEADER(1)="---- MICROBIOLOGY ----"
  1.  S:'DOD HEADER(2)=PATNAME_"    DOB:"_PATDOB_"    HRCN:"_HRCN
  1.  S:DOD HEADER(2)=PATNAME_"  DOB:"_PATDOB_"  DIED:"_PATDOD_"  HRCN:"_HRCN
  1.  S HEADER(3)=" "
  1.  D INSTDATA(DUZ(2),.STR1,.STR2)
  1.  S HEADER(4)=$$CJ^XLFSTR("Printed At: "_STR1,IOM)
  1.  S:$L(STR2) HEADER(5)=$$CJ^XLFSTR(STR2,IOM)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D DATAHEAD
  1.  ;
  1.  W "Accession:",LRAS,?44,"Received:",RECDDATE,!
  1.  W "Collection Sample:",CSNAME,?44,"Collection Date:",COLLDATE,!
  1.  W "Site/Specimen:",SSNAME,!,"Provider:",PROVIDER,!
  1.  W:$L(COMMENT) "Comment on Specimen:",$G(COMMENT),!
  1.  W !!
  1.  ;
  1.  D ORDTESTS
  1.  Q
  1.  ;
  1. DATAHEAD ; EP - Get Data for Header
  1.  S STR=$G(^LR(LRDFN,"MI",LRIDT,0))
  1.  S COLLDATE=$$FMTE^XLFDT($P(STR,"^"),"5MZ") ; Collection Date
  1.  S RECDDATE=$$FMTE^XLFDT($P(STR,"^",10),"5MZ")   ; Received Date
  1.  S LRAS=$P(STR,"^",6)   ; Accession
  1.  S SSIEN=+$P(STR,"^",5)
  1.  S SSNAME=$$GET1^DIQ(61,SSIEN,"NAME")  ; Site/Specimen Name
  1.  ;
  1.  S PHYIEN=+$P(STR,"^",7),PROVIDER=$$GET1^DIQ(200,PHYIEN,"NAME")
  1.  S CSIEN=+$P(STR,"^",11),CSNAME=$$GET1^DIQ(62,CSIEN,"NAME")     ; Collection Sample
  1.  S COMMENT=$G(^LR(LRDFN,"MI",LRIDT,99))
  1.  Q
  1.  ;
  1.  W !,$TR($J("",IOM)," ","-"),!
  1.  ;
  1.  S RF=$$GETPERFL()
  1.  S:RF<1 RF=$G(DUZ(2))
  1.  ;
  1.  Q:$$INSTDATA(RF,.STR1,.STR2)="Q"
  1.  ;
  1.  W $$CJ^XLFSTR("Performing Laboratory:",IOM),!
  1.  W "[",RF,"]  ",STR1,!
  1.  S LINES=LINES+1
  1.  I $L(STR2)<1 D WRITECC  Q
  1.  ;
  1.  W STR2,!
  1.  S LINES=LINES+1
  1.  D WRITECC
  1.  Q
  1.  ;
  1. GETPERFL() ; GET PERForming Lab
  1.  S X=$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)
  1.  S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5)
  1.  ;
  1.  S RF=+$G(^LR(LRDFN,"MI",LRIDT,"RF"))    ; Reference Lab Node
  1.  Q:RF RF
  1.  ;
  1.  ; Try to get from Organism structure
  1.  S RF=+$P($G(^LR(LRDFN,"MI",LRIDT,3,1,"IHSOBX")),U,6)     ; Performing Lab
  1.  Q:RF RF
  1.  ;
  1.  S RF=+$P($G(^LR(LRDFN,"MI",LRIDT,0)),U,14)     ; Accessioning Lab
  1.  Q:RF RF
  1.  ;
  1.  ; Try the Accession Division
  1.  S RF=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.4))
  1.  Q RF
  1.  ;
  1. WRITECC ; EP - Write County & Country, if they exist
  1.  NEW COUNTRY,COUNTY,IENS
  1.  ;
  1.  S (COUNTY,COUNTRY)=""
  1.  ;
  1.  S IENS=LRIDT_","_LRDFN
  1.  S COUNTY=$$GET1^DIQ(63.05,IENS,9999996),COUNTRY=$$GET1^DIQ(63.05,IENS,9999997)
  1.  Q:$L(COUNTY)<1&($L(COUNTRY)<1)
  1.  ;
  1.  W ?8
  1.  W:$L(COUNTY) $$LJ^XLFSTR("County:"_COUNTY,15)
  1.  W:$L(COUNTRY) "Country:",COUNTRY
  1.  W !
  1.  S LINES=LINES+1
  1.  Q
  1.  ;
  1. ORDTESTS ; EP - Ordered Tests(s)
  1.  NEW COMPDATE,F6OIEN,F60DESC,IENSTR,LRAA,LRAD,LRAN,LRAS,TESTS
  1.  NEW ORG,ORGCOMM,ORGDESC,ORGQUANT,UID
  1.  ;
  1.  W $$CJ^XLFSTR("Tests(s) Ordered:",IOM),!!
  1.  ;
  1.  S UID=+$G(^LR(LRDFN,"MI",LRIDT,"ORU"))
  1.  I UID S X=$Q(^LRO(68,"C",UID,0)),LRAA=$QS(X,4),LRAD=$QS(X,5),LRAN=$QS(X,6)
  1.  I UID<1 D
  1.  . S LRAS=$P($G(^LR(LRDFN,"MI",LRIDT,0)),"^",6)
  1.  . D GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)
  1.  ;
  1.  S IENSTR=LRAN_","_LRAD_","_LRAA_","
  1.  S TESTS=.9999999,X=0
  1.  F  S TESTS=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,TESTS))  Q:TESTS<1  D
  1.  . W ?4,$$GET1^DIQ(60,TESTS,"NAME")
  1.  . S COMPDATE=$$GET1^DIQ(68.04,TESTS_","_IENSTR,"COMPLETE DATE","I")
  1.  . W:$L(COMPDATE) ?44,"Completed: ",$TR($$FMTE^XLFDT(COMPDATE,"MZ"),"@"," ")
  1.  . W !
  1.  W !
  1.  S IENSTR=LRIDT_","_LRDFN
  1.  S BACRPTDA=$$GET1^DIQ(63.05,IENSTR,"BACT RPT DATE APPROVED","I")
  1.  S BCRPTSTS=$$GET1^DIQ(63.05,IENSTR,"BACT RPT STATUS")
  1.  S BCRPTDUZ=$$GET1^DIQ(63.05,IENSTR,"BACT PERSON","I")
  1.  ;
  1.  W ?4,"BACTERIOLOGY ",BCRPTSTS," => "
  1.  W $$FMTE^XLFDT(BACRPTDA,"5DZ")
  1.  W ?59,"TECH CODE:",BCRPTDUZ
  1.  W !!
  1.  ;
  1.  D PRELIM^BLRMIRP2      ; Preliminary Remarks
  1.  ;
  1.  D REMARKS
  1.  ;
  1.  F  S TESTS=$O(^LR(LRDFN,"MI",LRIDT,26,TESTS))  Q:TESTS<1  D
  1.  Q
  1.  ;
  1. REMARKS ; EP - BACT RPT REMARKS
  1.  Q:$O(^LR(LRDFN,"MI",LRIDT,4,0))<1
  1.  ;
  1.  NEW BACTREM
  1.  W ?4,"Bacteriology Remark(s):",!
  1.  S BACTREM=0
  1.  F  S BACTREM=$O(^LR(LRDFN,"MI",LRIDT,4,BACTREM))  Q:BACTREM<1  W ?9,$G(^(BACTREM,0)),!
  1.  Q
  1.  ;
  1. INSTDATA(INST,STR1,STR2) ; EP
  1.  NEW ARRAY,ERRS
  1.  ;
  1.  ; Use MAILING Address
  1.  D GETS^DIQ(4,INST,".01;4.01;4.02;4.03;4.04;4.05",,"ARRAY","ERRS")
  1.  ;
  1.  Q:$D(ERRS) "Q"
  1.  ;
  1.  S RFS=INST_$C(44)
  1.  ;
  1.  S NAME=$G(ARRAY(4,RFS,.01))      ; Name
  1.  S ADDR1=$G(ARRAY(4,RFS,4.01))    ; Street Address 1
  1.  S:$L($G(ARRAY(4,RFS,4.02))) ADDR2=$G(ARRAY(4,RFS,1.02))   ; Street Address 2
  1.  S CITY=$G(ARRAY(4,RFS,4.03))     ; City
  1.  S STATE=$G(ARRAY(4,RFS,4.04))    ; State
  1.  S ZIP=$G(ARRAY(4,RFS,4.05))      ; Zip
  1.  ;
  1.  I $L(ADDR1)<1 D    ; No Address.  Have to try and see if default address entries exist
  1.  . K ARRAY,ERRS
  1.  . D GETS^DIQ(4,INST,".01;1.01;1.02;1.03;.02;1.04",,"ARRAY","ERRS")
  1.  . S NAME=$G(ARRAY(4,RFS,.01))    ; Name
  1.  . S ADDR1=$G(ARRAY(4,RFS,1.01))  ;  Street Address 1
  1.  . S:$L($G(ARRAY(4,RFS,1.02))) ADDR2=$G(ARRAY(4,RFS,1.02))_"  " ; Street Address 2
  1.  . S CITY=$G(ARRAY(4,RFS,1.03))   ; City
  1.  . S STATE=$G(ARRAY(4,RFS,.02))   ; State
  1.  . S ZIP=$G(ARRAY(4,RFS,1.04))    ; Zip
  1.  ;
  1.  Q:$D(ERRS) "Q"
  1.  Q:$L(ADDR1)<1 "Q"
  1.  ;
  1.  S STR1=NAME_"  "_ADDR1_"  "_$S($L($G(ADDR2)):ADDR2_"  ",1:"")_CITY_", "_STATE_"  "_ZIP
  1.  I $L(STR1)<(IOM-10)  S STR2=""  Q "OK"
  1.  ;
  1.  ; Need to have 2 line Footer
  1.  K STR1,STR2
  1.  S STR1=NAME_"  "_ADDR1_"  "_$S($L($G(ADDR2)):ADDR2,1:"")
  1.  S STR2=CITY_", "_STATE_"  "_ZIP
  1.  Q "OK"
  1.  ;
  1. IHSVARS(LRDFN,LRIDT,ORGANISM) ; EP
  1.  S STR=$G(^LR(LRDFN,"MI",LRIDT,3,ORGANISM,"IHS"))
  1.  S RELDATE=$P(STR,"^")
  1.  S STATUS=$P(STR,"^",2),FLAG=$P(STR,"^",3)
  1.  S SUSC=$P(STR,"^",4),UP=$P(STR,"^",5)
  1.  S:+UP UNITS=$$GET1^DIQ(90475.3,UP,"DESCRIPTION")
  1.  S INTP=$P(STR,"^",6)
  1.  Q
  1.  ;
  1. GRAMSTAN(LRDFN,LRIDT) ; EP - GRAM STAIN Data
  1.  NEW GRAMCNT,GRAMSTR
  1.  ;
  1.  Q:$D(^LR(LRDFN,"MI",LRIDT,2))<1
  1.  ;
  1.  S (D2,GRAMCNT)=0
  1.  F  S D2=$O(^LR(LRDFN,"MI",LRIDT,2,D2))  Q:D2<1  D
  1.  . S GRAMSTR=$G(^LR(LRDFN,"MI",LRIDT,2,D2,0))
  1.  . Q:$TR(GRAMSTR," ")=""!(GRAMSTR["***GRAM STAIN")!(GRAMSTR="GRAM STAIN")!($TR(GRAMSTR," ")="GS")
  1.  . ;
  1.  . S GRAMCNT=GRAMCNT+1
  1.  . W:GRAMCNT=1 ?4,"GRAM STAIN:",!
  1.  . W ?9,$G(^LR(LRDFN,"MI",LRIDT,2,D2,0)),!
  1.  . S LINES=LINES+1
  1.  ;
  1.  W !
  1.  S LINES=LINES+1
  1.  Q
  1.  ;
  1. ORGLINE ; EP - ORGANISM Line
  1.  NEW ABNFLAG,HL7FLAG,IENSTR,OBSDATE,ORGCOMM,ORGIEN,ORGDESC,ORGQUANT,ORGSNOMD
  1.  ;
  1.  S HL7FLAG=0
  1.  S STR=$G(^LR(LRDFN,"MI",LRIDT,3,ORGL,"IHSOBX"))
  1.  S:$L(STR) HL7FLAG=1
  1.  S SNOMED=$P(STR,"^"),(ABNFLAG,FLAG)=$P(STR,"^",3),OBSDATE=$P(STR,"^",5)
  1.  ;
  1.  I $L(OBSDATE)<1 D
  1.  . S OBSDATE=$P($G(^LR(LRDFN,"MI",LRIDT,ORGL,1)),"^")
  1.  . S:$L(OBSDATE)<1 OBSDATE=$P($G(^LR(LRDFN,"MI",LRIDT,0)),"^",3)  S:$L(OBSDATE)<1 OBSDATE=$P($G(^(0)),"^",10)
  1.  ;
  1.  I ORGHEAD<1  W !,"CULTURE RESULTS:",!  S ORGHEAD=1+$G(ORGHEAD)
  1.  ;
  1.  S IENSTR=ORGL_","_LRIDT_","_LRDFN_","
  1.  S ORGDESC=$$GET1^DIQ(63.3,IENSTR,"ORGANISM")
  1.  S ORGQUANT=$$GET1^DIQ(63.3,IENSTR,"QUANTITY")
  1.  ;
  1.  I HL7FLAG D
  1.  . W !,?4,"Description",?39,"Quantity",?58,"FLG",?63,"Observation Date",!
  1.  . W ORGL,".",?4,ORGDESC,?39,ORGQUANT,?59,ABNFLAG,?63,$$FMTE^XLFDT(OBSDATE,"5MZ"),!
  1.  ;
  1.  I 'HL7FLAG D
  1.  . W !,?4,"Description",?39,"Quantity",?63,"Observation Date",!
  1.  . W ORGL,".",?4,ORGDESC,?39,ORGQUANT,?63,$$FMTE^XLFDT(OBSDATE,"5MZ"),!
  1.  ;
  1.  S ORGCOMM=0
  1.  F  S ORGCOMM=$O(^LR(LRDFN,"MI",LRIDT,3,ORGL,1,ORGCOMM))  Q:ORGCOMM<1  D
  1.  . W ?9,$G(^LR(LRDFN,"MI",LRIDT,3,ORGL,1,ORGCOMM,0)),!
  1.  Q
  1.  ;
  1. DRUGSORT ; Put drugs into Print Order
  1.  S DRUGNODE=2
  1.  F  S DRUGNODE=$O(^LR(LRDFN,"MI",LRIDT,3,ORGL,DRUGNODE))  Q:DRUGNODE<1  D
  1.  . S DRUGIEN=$O(^LAB(62.06,"AD",DRUGNODE,0))
  1.  . S DRUGNAME=$$GET1^DIQ(62.06,DRUGIEN,"NAME")
  1.  . S DRUGDISP=$$GET1^DIQ(62.06,DRUGIEN,"DISPLAY COMMENT")
  1.  . S PRNTORDR=+$$GET1^DIQ(62.06,DRUGIEN,"PRINT ORDER")
  1.  . S DRUGSORT(PRNTORDR,DRUGNODE)=DRUGIEN_"^"_DRUGNAME_"^"_DRUGDISP
  1.  ;
  1.  S PRNTORDR="",DRUGHEAD=0
  1.  F  S PRNTORDR=$O(DRUGSORT(PRNTORDR))  Q:PRNTORDR<1  D
  1.  . S DRUGNODE=""
  1.  . F  S DRUGNODE=$O(DRUGSORT(PRNTORDR,DRUGNODE))  Q:DRUGNODE<1  D
  1.  .. S STR=$G(DRUGSORT(PRNTORDR,DRUGNODE))
  1.  .. S DRUGIEN=$P(STR,"^"),DRUGNAME=$P(STR,"^",2),DRUGDISP=$P(STR,"^",3)
  1.  .. D DRUGAMTS
  1.  Q
  1.  ;
  1. DRUGAMTS ; EP - Drug values
  1.  I $D(^LR(LRDFN,"MI",LRIDT,3,ORGL,"ISO"))  D HL7DRUGS  Q
  1.  ;
  1.  D INHOUSE
  1.  Q
  1.  ;
  1. INHOUSE ; EP - Drug values from RPMS entry
  1.  S STR=$G(^LR(LRDFN,"MI",LRIDT,3,ORGL,DRUGNODE))
  1.  S SUSC=$P(STR,"^"),INTP=$P(STR,"^",2),ALTI=$P(STR,"^",3)
  1.  ;
  1.  Q:$L(SUSC)<1&($L(INTP)<1)&($L(ALTI)<1)
  1.  ;
  1.  ; Only display drugs that have valid interpretation for the result (the "AI" X-ref)
  1.  S (BADSUSC,BADINTP)=1
  1.  S:$L(INTP) BADINTP=$D(^LAB(62.06,"AI",DRUGNODE,INTP))
  1.  S:$L(SUSC) BADSUSC=$D(^LAB(62.06,"AI",DRUGNODE,SUSC))
  1.  Q:BADINTP<1&(BADSUSC<1)
  1.  ;
  1.  D:+$G(DRUGHEAD)<1 DRUGHEAD
  1.  ;
  1.  S RPTSTS=$P($G(^LR(LRDFN,"MI",LRIDT,1)),"^",2)
  1.  ;
  1.  S STR=$G(^LR(LRDFN,"MI",LRIDT,ORGL,1))
  1.  S OBSDATE=$P(STR,"^")
  1.  S:$L(OBSDATE)<1 OBSDATE=$P($G(^LR(LRDFN,"MI",LRIDT,0)),"^",3)  S:$L(OBSDATE)<1 OBSDATE=$P($G(^(0)),"^",10)
  1.  ;
  1.  S LRAS=$P($G(^LR(LRDFN,"MI",LRIDT,0)),"^",6)
  1.  S RF=$$GETPERFL()
  1.  S:$L(RF) LRPLS(RF)=""
  1.  ;
  1.  S:$L(OBSDATE) OBSDATE=$$FMTE^XLFDT(OBSDATE,"5MZ")
  1.  S (FLAG,RESULT,UNITS)=""
  1.  ;
  1.  ; Special "trick".  See file 62.06 & RESULT entry
  1.  S RESULT=SUSC
  1.  I $L($P(SUSC," ",2)) S RESULT=$P(SUSC," "),UNITS=$P(SUSC," ",2),SUSC=""
  1.  ;
  1.  W $E(DRUGNAME,1,25),?27,RESULT,?33,UNITS,?40,INTP,?46,ALTI,?53,OBSDATE
  1.  W:$L(RF) ?74,"[",RF,"]",!
  1.  S LINES=LINES+1
  1.  I $L(DRUGDISP) W ?14,DRUGDISP,!  S LINES=LINES+1
  1.  Q
  1.  ;
  1. DRUGHEAD ; EP - In-House Drug "Heading"
  1.  W !,?46,"ALT",!,"ANTIBIOTIC",?27,"SUSC",?33,"UNITS",?40,"INTP",?46,"INTP",?53,"OBSERVATION DATE",?75,"SITE",!
  1.  S DRUGHEAD=1+$G(DRUGHEAD)
  1.  Q
  1.  ;
  1. HL7DRUGS ; EP - Drug values from INCOMING HL7 messages
  1.  S STR=$G(^LR(LRDFN,"MI",LRIDT,3,ORGL,DRUGNODE))
  1.  S SUSC=$P(STR,"^")
  1.  S INTP=$P(STR,"^",2)
  1.  ;
  1.  D:+$G(DRUGHEAD)<1 HL7DHEAD
  1.  ;
  1.  S ISO=.9999999,FOUNDIT=0
  1.  F  S ISO=$O(^LR(LRDFN,"MI",LRIDT,3,ORGL,"ISO",ISO))  Q:ISO<1!(FOUNDIT)  D
  1.  . S:$G(^LR(LRDFN,"MI",LRIDT,3,ORGL,"ISO",ISO))[DRUGNODE FOUNDIT=ISO
  1.  ;
  1.  I FOUNDIT<1 W !  S LINES=LINES+1  Q
  1.  ;
  1.  S STR=$G(^LR(LRDFN,"MI",LRIDT,3,ORGL,"ISO","IHSOBX",FOUNDIT))
  1.  S RESULT=$P(STR,"^"),UNITS=$P($P(STR,"^",2),"~"),FLAG=$P(STR,"^",3)
  1.  S RPTSTS=$P(STR,"^",4),OBSDATE=$P(STR,"^",5),RF=$P(STR,"^",6)
  1.  S:$L(RF) LRPLS(RF)=""
  1.  S:$L(OBSDATE) OBSDATE=$$FMTE^XLFDT(OBSDATE,"5MZ")
  1.  ;
  1.  Q:SUSC="R"&(INTP="R")
  1.  ;
  1.  W $E(DRUGNAME,1,25),?27,RESULT,?33,UNITS,?40,FLAG,?43,SUSC,?48,INTP,?54,RPTSTS,?57,OBSDATE
  1.  W:$L(RF) ?74,"[",RF,"]"
  1.  W !
  1.  S LINES=LINES+1
  1.  I $L(DRUGDISP) W ?14,DRUGDISP,!  S LINES=LINES+1
  1.  ;
  1.  Q
  1.  ;
  1. HL7DHEAD ; EP - HL7 Incoming Drug "Heading"
  1.  W !,?27,"CONC",!,"ANTIBIOTIC",?27,"RANGE",?33,"UNITS",?39,"FLG",?43,"SUSC",?48,"INTP",?53,"STS",?57,"OBSERVATION DATE",?75,"SITE",!
  1.  S DRUGHEAD=1+$G(DRUGHEAD)
  1.  Q
  1.  ;
  1. PRELIM ; EP - Preliminary Report -- For Testing Purposes Only
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S HEADER(1)="*** PRELIMINARY ***"
  1.  S HEADER(2)="Meaningful Use Stage 2 Micro Report"
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D ^LRWU4
  1.  ;
  1.  S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5)
  1.  ;
  1.  I LRDFN<1 D  Q
  1.  . W !!,?4,"Could not determine Accession's data.  Routine Ends."
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  S LINES=0
  1.  ;
  1.  D HEADER
  1.  D GRAMSTAN(LRDFN,LRIDT)
  1.  S ORGL=.9999999,ORGHEAD=0
  1.  F  S ORGL=$O(^LR(LRDFN,"MI",LRIDT,3,ORGL))  Q:ORGL<1  D
  1.  . D ORGLINE
  1.  . D DRUGSORT
  1.  . W !
  1.  ;
  1.  D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  Q
  1.  ;
  1. GETLRDFN() ; EP - Always get LRDFN
  1.  D ^LRPARAM
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="PO^2:E"
  1.  S DIR("A")="PATIENT"
  1.  D ^DIR
  1.  I +$G(Y)<1!(+$G(DIRUT)) D  Q "Q"
  1.  . W !,?4,"No/Invalid/Quit Entry.  Routine Ends."
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  S DFN=+$G(Y)
  1.  S PNM=$P(Y,"^",2)
  1.  ;
  1.  S DOD=+$$GET1^DIQ(2,DFN,.351,"I")
  1.  I DOD  D WARN^LRDPA  Q:DFN<1 "Q"
  1.  ;
  1.  S LRDFN=+$G(^DPT(DFN,"LR"))
  1.  Q:LRDFN "OK"
  1.  ;
  1.  W !!,?4,"Patient ",$$GET1^DIQ(2,+Y,"NAME")," [",+Y,"] has NO Lab Data.  Routine Ends."
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q "Q"
  1.  ;
  1. DEBUGER ; EP
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D B^LRU      ; Get Date Range
  1.  ;
  1.  S LRSIDT=9999999-$$FMADD^XLFDT(LRLDT,1)      ; "Starting" Inverse Date
  1.  S LREIDT=9999999-LRSDT                       ; "Ending" Inverse Date
  1.  ;
  1.  W !!,?4,"LRSIDT:",LRSIDT,!,?4,"LREIDT:",LREIDT,!!
  1.  W ?4,"LRIDT",?24,"$P(LRIDT,""."")>LREIDT",!
  1.  W ?4,$TR($J("",15)," ","-"),?24,$TR($J("",22)," ","-"),!
  1.  ;
  1.  S LRDFN=10553,LRIDT=LRSIDT,QFLG="NO"
  1.  F  S LRIDT=$O(^LR(LRDFN,"MI",LRIDT))  Q:LRIDT<1  D
  1.  . W ?4,LRIDT
  1.  . W ?24,$S($P(LRIDT,".")>LREIDT:"TRUE",1:"FALSE")
  1.  . W !
  1.  Q
  1.  ;
  1. LRAS ; EP - Debug by entering Accession or UID
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D ^LRWU4
  1.  ;
  1.  I LRAA<1!(LRAD<1)!(LRAN<1) D BADSTUFF("No/Invalid Entry.  Routine Ends.")  Q
  1.  ;
  1.  I $$GET1^DIQ(68,LRAA,.02,"I")'="MI" D  Q
  1.  . D BADSTUFF("Accession "_$$GET1^DIQ(68,LRAA,.01)_" (#"_LRAA_") is not a Micro Accession.  Routine Ends.")
  1.  ;
  1.  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN))<1 D BADSTUFF("No Accession Data for Accession "_BLRLRAS_". Routine Ends.")  Q
  1.  ;
  1.  S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5),DFN=$P($G(^LR(LRDFN,0)),"^",3)
  1.  S QFLG="NO"
  1.  ;
  1.  W !!
  1.  D HEADONE^BLRGMENU(.HEADONE)                 ; Pagination
  1.  W !!
  1.  ;
  1.  D ^%ZIS
  1.  I POP D BADSTUFF("Open Device Failed.  Routine Ends.")  Q
  1.  ;
  1.  U IO
  1.  ;
  1.  D HEADER
  1.  D GRAMSTAN(LRDFN,LRIDT)
  1.  S ORGL=.9999999,ORGHEAD=0
  1.  F  S ORGL=$O(^LR(LRDFN,"MI",LRIDT,3,ORGL))  Q:ORGL<1!(QFLG="Q")  D
  1.  . D ORGLINE,DRUGSORT
  1.  . W !  S LINES=LINES+1
  1.  W !  S LINES=LINES+1
  1.  ;
  1.  D FOOTER
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. BADSTUFF(MSG) ; EP
  1.  W !!,?4,MSG
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q