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

BLRLUAC1.m

Go to the documentation of this file. 
  1. BLRLUAC1 ; IHS/OIT/MKK - IHS LRUPAC 1, main driver ; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1030,1033**;NOV 01, 1997
  1.  ;;
  1.  ;; Emulates the Lab accession and test counts Report.
  1.  ;; Should be more Accurate.
  1.  ;;
  1. EP ; EP 
  1.  NEW BLRDUZ,CNT,COMPDATE,DATANAME,DATETIME,DFN,DINVBEG
  1.  NEW DINVEND,ERRORS,F44IEN,FILE4IEN,HEADER,LAB60IEN,L60DESC
  1.  NEW LABTEST,LOCPIECE,LOGOFF,LOGON,LRAA,LRAD,LRAN,LRAS
  1.  NEW LRDFN,LRDFNCNT,LRIDT,LRSSOCNT,PURGDATE,SELRAA
  1.  NEW SELRAAAB,SELRAAAN,SELLRSS,SOMEDATA,SPECTYPE,SPECNAME
  1.  NEW SPTKNDAT,SRCHDN,STR,STR0,TESTLOC,TODAY,VMICIEN,VBBIEN
  1.  NEW VISITIEN,VLABCNT,VLABFND,VLABIEN,XTMPNODE
  1.  ;
  1.  S HEADER(1)="Count Accessioned Tests"
  1.  ;
  1.  Q:$$GETACCSA()="Q"
  1.  ;
  1.  Q:$$GETDATER()="Q"
  1.  ;
  1.  D TASKEDGD
  1.  ;
  1.  Q
  1.  ;
  1. GETACCSA() ; EP -- Get Accession Area
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="PO^68"
  1.  S DIR("A")="Select ACCESSION AREA"
  1.  D ^DIR
  1.  I +$G(Y)<1!(+$G(DIRUT)) D PROGEND("Invalid/No Entry.")  Q "Q"
  1.  ;
  1.  S SELRAA=+$G(Y)
  1.  ;
  1.  ; Accession Area Abbreviation
  1.  S SELRAAAB=$$GET1^DIQ(68,SELRAA,"ABBREVIATION",,,"ERRORS")
  1.  I $D(ERRORS)>0 D PROGEND("Could not Find Accession Abbreviation.")  Q "Q"
  1.  ;
  1.  ; Accession Area Name
  1.  S SELRAAAN=$$GET1^DIQ(68,SELRAA,"AREA",,,"ERRORS")
  1.  I $D(ERRORS)>0 D PROGEND("Could not Find Accession Area.")  Q "Q"
  1.  ;
  1.  ; Accession Area LR Subscript
  1.  S LRSS=$$GET1^DIQ(68,SELRAA,"LR SUBSCRIPT",,,"ERRORS")  ; LR Subscript
  1.  I $D(ERRORS)>0 D PROGEND("Could not Find LR Subscript.")  Q "Q"
  1.  ;
  1.  S SELLRSS=$E(LRSS,1,2)   ; Lab Data File D1 node
  1.  ;
  1.  Q "OK"
  1.  ;
  1. GETDATER() ; EP - Get Date Range
  1.  D HEADERDT^BLRGMENU
  1.  D B^LRU             ; Get beginning (LRSDT) & ending (LRLDT) dates
  1.  ;
  1.  I $L(Y)<1!($G(Y)=-1) D PROGEND("Invalid/No Date Range Entered.")  Q "Q"
  1.  ;
  1.  Q "OK"
  1.  ;
  1. TASKEDGD ; EP - Setup routine for TaskMan
  1.  NEW BLRDUZ,IOP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  ;
  1.  W !!!,"Queuing Compilation",!
  1.  ;
  1.  S ZTRTN="TGETDATA^BLRLUAC1"
  1.  S ZTDESC="BLRLUAC1 Compilation"
  1.  ;
  1.  M BLRDUZ=DUZ
  1.  S ZTSAVE("*")=""
  1.  S ZTDTH=$H
  1.  S ZTIO=""
  1.  S IOP="Q"
  1.  D ^%ZTLOAD
  1.  W !,?4,"Job ",ZTSK," Queued",!
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. TGETDATA ; EP - Tasked GETDATA
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  D TASKDATI
  1.  ;
  1.  F  S LRDFN=$O(^LR(LRDFN))  Q:LRDFN<1  D
  1.  . ; S DFN=$P($G(^LR(LRDFN,0)),"^",3)
  1.  . S DFN=+$P($G(^LR(LRDFN,0)),"^",3)     ; IHS/OIT/MKK - LR*5.2*1033 - DFN Must be an integer
  1.  . S LRIDT=DINVEND
  1.  . F  S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT))  Q:LRIDT<1!(LRIDT>DINVBEG)  D
  1.  .. S STR0=$G(^LR(LRDFN,LRSS,LRIDT,0))
  1.  .. Q:$L(STR0)<1                         ; Skip if no data
  1.  .. ;
  1.  .. S LRAS=$P(STR0,"^",6)                ; Accession Number
  1.  .. Q:$P(LRAS," ")'=SELRAAAB             ; Skip if not Selected Acc
  1.  .. ;
  1.  .. S SPTKNDAT=+$P(STR0,"^")             ; Specimen Taken Date
  1.  .. S COMPDATE=+$P(STR0,"^",3)           ; Completed Date
  1.  .. ; S SPECTYPE=$P(STR0,"^",5)            ; Specimen Type
  1.  .. S SPECTYPE=+$P(STR0,"^",5)           ; IHS/OIT/MKK - LR*5.2*1033 - Specimen Type Must be an integer
  1.  .. ;
  1.  .. S LRIDT($P(LRIDT,"."))=SPTKNDAT
  1.  .. ;
  1.  .. D @(LRSS_"DATA")                     ; Do Specific Breakout
  1.  .. D LDORDSRT                           ; Hospital Location Sort
  1.  .. S CNT=CNT+1
  1.  ;
  1.  S:SOMEDATA<1 ^BLRLUPAC(DATETIME,"GETDATA2 Compilation Failed.")=""
  1.  S:SOMEDATA>0 ^BLRLUPAC(DATETIME,"COMPILED")=$$DT^XLFDT_"^"_$H
  1.  ;
  1.  D DONEGETD
  1.  ;
  1.  Q
  1.  ;
  1. TASKDATI ; EP - Tasked Initialization of variables
  1.  S TODAY=$$DT^XLFDT
  1.  S PURGDATE=$$FMADD^XLFDT(TODAY,30)
  1.  ;
  1.  S LRDFN=.9999999,LRSS=SELLRSS
  1.  ;
  1.  S DINVEND=9999999-$$FMADD^XLFDT(LRLDT,1)
  1.  S DINVBEG=9999999-$$FMADD^XLFDT(LRSDT,-1)
  1.  ;
  1.  S (CNT,LRDFNCNT,ORDCNT,SOMEDATA)=0
  1.  S LOGON=$$HTFM^XLFDT($H)              ; Set Login Date/Time
  1.  S DATETIME=LOGON
  1.  K ^BLRLUPAC(DATETIME)
  1.  ;
  1.  Q
  1.  ;
  1. DONEGETD ; EP - Compilation DONE; send E-mail
  1.  NEW STR
  1.  ;
  1.  S STR(1)="Compilation of Lab Accession and Test counts Report Completed."
  1.  S STR(2)=" "
  1.  S STR(3)="Accession Area:"_SELRAAAN_" ("_SELRAAAB_")"
  1.  S STR(4)=" "
  1.  S STR(5)="Date Range: "_$$FMTE^XLFDT(LRSDT,"5MZ")_" thru "_$$FMTE^XLFDT(LRLDT,"5MZ")_"."
  1.  S STR(6)=" "
  1.  S LOGOFF=$$HTFM^XLFDT($H)
  1.  S STR(7)="START="_$$LJ^XLFSTR($$FMTE^XLFDT(LOGON,"5MZ"),18)_"END="_$$FMTE^XLFDT(LOGOFF,"5MZ")
  1.  S STR(8)="     Compilation took:"_$$FMDIFF^XLFDT(LOGOFF,LOGON,3)
  1.  S STR(9)=" "
  1.  S STR(10)="Date/Time of compilation:"_$$FMTE^XLFDT(DATETIME,"5MZ")
  1.  ;
  1.  I SOMEDATA<1 D
  1.  . S STR(11)=" "
  1.  . S STR(12)=" >>> NO DATA GATHERED.  REPORTS WILL BE EMPTY. <<<"
  1.  . S STR(13)=" "
  1.  ;
  1.  D SENDMAIL(.STR)
  1.  ;
  1.  Q
  1.  ;
  1. SENDMAIL(STR) ; EP - SEND MAIL when tasked GETDATA complete
  1.  NEW XMDUZ,XMMG,XMSUB,XMTEST,XMY,XMZ
  1.  ;
  1.  S XMY(BLRDUZ)=""
  1.  ;
  1.  S LRBLNOW=$E($$NOW^XLFDT,1,12)
  1.  ;
  1.  S XMSUB=$G(STR(1))
  1.  S XMTEXT="STR("
  1.  S XMDUZ="BLRLUAC1"
  1.  S XMZ="NOT OKAY"
  1.  D ^XMD
  1.  ;
  1.  I $G(XMMG)'=""!(XMZ="NOT OKAY") D
  1.  . S NOW=$H
  1.  . S ^XTMP("BLRLUPAC",DATETIME,0)=$$FMADD^XLFDT(TODAY,7)_"^"_TODAY_"^BLRLUPAC Message"
  1.  . S ^XTMP("BLRLUPAC",DATETIME,NOW,"MAILMAN ERROR")=""
  1.  . S ^XTMP("BLRLUPAC",DATETIME,NOW,"MAILMAN ERROR","XMZ")=XMZ
  1.  . S ^XTMP("BLRLUPAC",DATETIME,NOW,"MAILMAN ERROR","XMMG")=XMMG
  1.  ;
  1.  Q
  1.  ;
  1. CHDATA ; EP - "CH" Data
  1.  Q:(COMPDATE<LRSDT)!(COMPDATE>LRLDT)     ; Skip if not in Date Range
  1.  ;
  1.  S DATANAME=1.9999999
  1.  F  S DATANAME=$O(^LR(LRDFN,LRSS,LRIDT,DATANAME))  Q:DATANAME<1  D
  1.  . Q:DATANAME=9009027   ; Skip E-Sig Node
  1.  . ;
  1.  . ; Skip Pending tests
  1.  . ; Q:$$UP^XLFSTR($G(^LR(LRDFN,LRSS,LRIDT,DATANAME)))["PENDING"
  1.  . ;
  1.  . S SRCHDN="CH;"_DATANAME_";1"
  1.  . S LAB60IEN=+$O(^LAB(60,"C",SRCHDN,0))
  1.  . I LAB60IEN<1 D STORERRS(LRDFN,LRSS,LRIDT,DATANAME,LAB60IEN,"No Test Associated with Dataname")  Q
  1.  . ;
  1.  . S SOMEDATA=SOMEDATA+1
  1.  . D TOPOGSRT
  1.  . D LATSTSRT
  1.  . ; D CHORDSRT
  1.  . D INSTFSRT
  1.  . ;
  1.  Q
  1.  ;
  1. TOPOGSRT ; EP - Topography File sort
  1.  S:$D(^BLRLUPAC(DATETIME,"SPECSORT"))<1 ^BLRLUPAC(DATETIME,"SPECSORT")=SELRAAAB_"^"_LRSDT_"^"_LRLDT
  1.  S ^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE)=1+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))
  1.  S ^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN)=1+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
  1.  Q
  1.  ;
  1. LATSTSRT ; EP - V File - Laboratory Test File sort
  1.  S:$D(^BLRLUPAC(DATETIME,"TESTSORT"))<1 ^BLRLUPAC(DATETIME,"TESTSORT")=SELRAAAB_"^"_LRSDT_"^"_LRLDT
  1.  S ^BLRLUPAC(DATETIME,"TESTSORT",LAB60IEN)=1+$G(^BLRLUPAC(DATETIME,"TESTSORT",LAB60IEN))
  1.  S ^BLRLUPAC(DATETIME,"TESTSORT",LAB60IEN,SPECTYPE)=1+$G(^BLRLUPAC(DATETIME,"TESTSORT",LAB60IEN,SPECTYPE))
  1.  Q
  1.  ;
  1. CHORDSRT ; EP - CH Hospital Location sort
  1.  NEW DNHOLDER
  1.  ;
  1.  S DNHOLDER=$S($L($G(DATANAME)):$G(DATANAME),1:"<NO DATANAME>")
  1.  ;
  1.  ;
  1.  ; Use V LAB file to get information
  1.  S (VLABCNT,VLABFND)=0,VLABIEN="A"
  1.  F  S VLABIEN=$O(^AUPNVLAB("B",LAB60IEN,VLABIEN),-1)  Q:VLABIEN<1!(VLABFND)  D
  1.  . S:$P($G(^AUPNVLAB(VLABIEN,0)),"^",6)=LRAS VLABFND=VLABIEN
  1.  ;
  1.  I VLABFND<1 D STORERRS(LRDFN,LRSS,LRIDT,DNHOLDER,LAB60IEN,"No V LAB Data")  Q
  1.  ;
  1.  S VISITIEN=+$P($G(^AUPNVLAB(VLABFND,0)),"^",3)
  1.  D VFORDSRT
  1.  Q
  1.  ;
  1. INSTFSRT ; EP - Institution File sort
  1.  NEW NOW,DATASTR,DNHOLDER
  1.  ;
  1.  S DNHOLDER=$S($L($G(DATANAME)):$G(DATANAME),1:"<NO DATANAME>")
  1.  ;
  1.  S FILE4IEN=0
  1.  S DATASTR=$G(^LR(LRDFN,LRSS,LRIDT,DNHOLDER))
  1.  S:$L(DATASTR,"^")>1 FILE4IEN=+$RE($P($RE(DATASTR),"^"))
  1.  S:FILE4IEN<1 FILE4IEN=$P($G(^SC(+$G(F44IEN),0)),"^",4)
  1.  ;
  1.  I FILE4IEN<1 D STORERRS(LRDFN,LRSS,LRIDT,DNHOLDER,LAB60IEN,"No Site in File 63 nor File 44")  Q
  1.  ;
  1.  S:$D(^BLRLUPAC(DATETIME,"SITESORT"))<1 ^BLRLUPAC(DATETIME,"SITESORT")=SELRAAAB_"^"_LRSDT_"^"_LRLDT
  1.  S ^BLRLUPAC(DATETIME,"SITESORT",FILE4IEN)=1+$G(^BLRLUPAC(DATETIME,"SITESORT",FILE4IEN))
  1.  S ^BLRLUPAC(DATETIME,"SITESORT",FILE4IEN,LAB60IEN)=1+$G(^BLRLUPAC(DATETIME,"SITESORT",FILE4IEN,LAB60IEN))
  1.  Q
  1.  ;
  1. MIDATA ; EP - "MI" Data
  1.  Q:(SPTKNDAT<LRSDT)!(SPTKNDAT>LRLDT)   ; Skip if not in Date Range
  1.  ;
  1.  S LRAS=$P($G(^LR(LRDFN,"MI",LRIDT,0)),"^",6)
  1.  ;
  1.  D GETVMIEN(.VMICIEN)
  1.  I VMICIEN<1 D STORERRS(LRDFN,LRSS,LRIDT,"<Not App>","<UNK>","No MI Data in VISIT file")  Q
  1.  ;
  1.  S STR=$G(^AUPNVMIC(VMICIEN,0))
  1.  S LAB60IEN=+$P(STR,"^",1)
  1.  S VISITIEN=+$P(STR,"^",3)
  1.  ;
  1.  S SOMEDATA=SOMEDATA+1
  1.  D TOPOGSRT
  1.  D LATSTSRT
  1.  D VFORDSRT   ; Be aware that MI Subscripts don't have DATANAME
  1.  D INSTFSRT   ; Be aware that MI Subscripts don't have DATANAME
  1.  Q
  1.  ;
  1. GETVMIEN(VMICIEN) ; EP - Get V MICRO IEN, if it exists
  1.  S VMICIEN=0,FLAG="NO"
  1.  F  S VMICIEN=$O(^AUPNVMIC("AC",DFN,VMICIEN))  Q:VMICIEN<1!(FLAG)  D
  1.  . S COLLDTT=+$G(^AUPNVMIC(VMICIEN,12))
  1.  . Q:$P(COLLDTT,".")'=$P(SPTKNDAT,".")
  1.  . Q:LRAS'=$P($G(^AUPNVMIC(VMICIEN,0)),"^",6)
  1.  . S FLAG=VMICIEN
  1.  S VMICIEN=FLAG
  1.  Q
  1.  ;
  1. LDORDSRT ; EP - Lab Data Hospital Location File Sort
  1.  Q:+$G(LAB60IEN)<1
  1.  ;
  1.  NEW LOCPIECE
  1.  ;
  1.  ; S LOCPIECE=$S(LRSS="BB":8,LRSS="CH":11,LRSS="CY":8,LRSS="MI":8,LRSS="SP":8,1:0)
  1.  S LOCPIECE=$S(LRSS="BB":8,LRSS="CH":11,LRSS="CY":8,LRSS="MI":13,LRSS="SP":8,1:0)   ; IHS/MSC/MKK - LR*5.2*1033 - Need to use Requesting LOC/DIV field for "MI" tests
  1.  ;
  1.  S F44IEN=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^",LOCPIECE)
  1.  S:$L(F44IEN)>0 F44IEN=+$O(^SC("C",F44IEN,0))
  1.  ;
  1.  ; I +$G(F44IEN)<1 D STORERRS(LRDFN,LRSS,LRIDT,DATANAME,LAB60IEN,"No File 44 Data in V FILE")  Q
  1.  I +$G(F44IEN)<1 D STORERRS(LRDFN,LRSS,LRIDT,+$G(DATANAME),LAB60IEN,"No File 44 Data in V FILE")  Q     ; IHS/MSC/MKK - LR*5.2*1033 - DATANAME variable only exists for "CH" tests
  1.  ;
  1.  S:$D(^BLRLUPAC(DATETIME,"LOCSORT"))<1 ^BLRLUPAC(DATETIME,"LOCSORT")=SELRAAAB_"^"_LRSDT_"^"_LRLDT
  1.  S ^BLRLUPAC(DATETIME,"LOCSORT",F44IEN)=1+$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN))
  1.  S ^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN)=1+$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN))
  1.  Q
  1.  ;
  1. VFORDSRT ; EP - V File - Hospital Location File sort
  1.  NEW DNHOLDER
  1.  S F44IEN=+$P($G(^AUPNVSIT(VISITIEN,0)),"^",22)
  1.  ;
  1.  S DNHOLDER=$S($L($G(DATANAME)):$G(DATANAME),1:"<NO DATANAME>")
  1.  I F44IEN<1 D STORERRS(LRDFN,LRSS,LRIDT,DNHOLDER,LAB60IEN,"No File 44 Data in V FILE")  Q
  1.  ;
  1.  S:$D(^BLRLUPAC(DATETIME,"LOCSORT"))<1 ^BLRLUPAC(DATETIME,"LOCSORT")=SELRAAAB_"^"_LRSDT_"^"_LRLDT
  1.  S ^BLRLUPAC(DATETIME,"LOCSORT",F44IEN)=1+$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN))
  1.  S ^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN)=1+$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN))
  1.  Q
  1.  ;
  1. BBDATA ; EP - "BB" Data
  1.  Q:(SPTKNDAT<LRSDT)!(SPTKNDAT>LRLDT)   ; Skip if not in Date Range
  1.  ;
  1.  S LRAS=$P($G(^LR(LRDFN,"BB",LRIDT,0)),"^",6)
  1.  ;
  1.  D GETBBIEN(.VBBIEN)
  1.  I VBBIEN<1 D STORERRS(LRDFN,LRSS,LRIDT,"<Not App>","<UNK>","No BB Data in V BLOOD BANK File")  Q
  1.  ;
  1.  S STR=$G(^AUPNVBB(VBBIEN,0))
  1.  S LAB60IEN=$P(STR,"^",1)
  1.  S VISITIEN=+$P(STR,"^",3)
  1.  ;
  1.  S SOMEDATA=SOMEDATA+1
  1.  D TOPOGSRT
  1.  D LATSTSRT
  1.  ; D VFORDSRT
  1.  D INSTFSRT
  1.  ;
  1.  Q
  1.  ;
  1. GETBBIEN(VBBIEN) ; EP -- Get V BLOOD BANK IEN, if it exists
  1.  S VBBIEN=0,FLAG="NO"
  1.  F  S VBBIEN=$O(^AUPNVBB("AC",DFN,VBBIEN))  Q:VBBIEN<1!(FLAG)  D
  1.  . S COLLDTT=+$G(^AUPNVBB(VBBIEN,12))
  1.  . Q:$P(COLLDTT,".")'=$P(SPTKNDAT,".")
  1.  . Q:LRAS'=$P($G(^AUPNVBB(VBBIEN,0)),"^",6)
  1.  . S FLAG=VBBIEN
  1.  S VBBIEN=FLAG
  1.  Q
  1.  ;
  1. STORERRS(LRDFN,LRSS,LRIDT,DATANAME,LAB60IEN,ERRMSG) ; EP -- Store DATANAME Errors
  1.  NEW STR
  1.  ; S STR=LAB60IEN
  1.  ; S:$G(ERRMSG)'="" STR=STR_"^"_ERRMSG
  1.  S:$D(^BLRLUPAC(DATETIME,"ERRORS"))<1 ^BLRLUPAC(DATETIME,"ERRORS")=SELRAAAB_"^"_LRSDT_"^"_LRLDT
  1.  ; S ^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT,DATANAME)=STR
  1.  S ^BLRLUPAC(DATETIME,"ERRORS",ERRMSG)=1+$G(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG))
  1.  S ^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN)=1+$G(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN))
  1.  S ^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN,LRDFN,LRSS,LRIDT,DATANAME)=""
  1.  Q
  1.  ;
  1. SETXTMPN(XTMPNODE) ; EP -- Set the node for the ^BLRLUPAC global
  1.  S XTMPNODE="BLRLUPAC"
  1.  Q
  1.  ;
  1. PROGEND(MSG) ; EP -- Routine Ends 
  1.  W !,?4,MSG,"  Routine Ends.",!
  1.  D PRESSKEY^BLRGMENU(9)
  1.  D V^LRU
  1.  Q
  1.  ;
  1. NOTHING ; EP - No Data Found
  1.  D HEADERDT^BLRGMENU
  1.  D PROGEND("No Data Found.")
  1.  K ^BLRLUPAC(DATETIME)
  1.  Q