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