BLRLUAC8 ; IHS/OIT/MKK - IHS LRUPAC 8, error in compilation report ; 17-Oct-2014 09:22 ; MKK
;;5.2;IHS LABORATORY;**1030,1034**;NOV 01, 1997;Build 88
;;
REPTERRS ; EP -- Report on Errors during compilation
NEW BLRVERN,COMPDATE,DFN,ERRDESC,DATANAME,DATANDES
NEW LRAS,LRDFN,LRSS,LRIDT,LAB60IEN,LAB60DES,XTMPNODE
NEW CNT,HEADER,HEDONE,LINES,MAXLINES,MAX,PG,QFLG
NEW LRLDT,LRSDT,SELRAAAB,SPTKNDTT,XTMPNODE
NEW DATERNGE,STR
;
Q:$$RPTERRSI()="Q"
;
F S LRDFN=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN)) Q:LRDFN<1!(QFLG="Q") D
. F S LRSS=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS)) Q:$L(LRSS)<1!(QFLG="Q") D
.. F S LRIDT=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT)) Q:$G(LRIDT)=""!(QFLG="Q") D
... F S DATANAME=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT,DATANAME)) Q:$G(DATANAME)=""!(QFLG="Q") D
.... D RPTERRSL
;
W:CNT<1 !!,?4,"No Errors Found.",!
W:CNT>0 !!,?4,"Number of Errors = ",CNT,!
;
D PRESSKEY^BLRGMENU(9)
Q
;
RPTERRSI() ; EP -- Errors Report INITialization of variables
D SETXTMPN^BLRLUAC1(.XTMPNODE) ; Set the ^BLRLUPAC( node
S BLRVERN=$P($P($T(+1),";")," ")
;
Q:$$GETXTMPV^BLRLUAC2("ERRORS",.SELRAAAB,.LRSDT,.LRLDT,"No Errors Found.")="Q" "Q"
;
S DATERNGE="Date Range: "_$$FMTE^XLFDT(LRSDT,"5DZ")
S DATERNGE=DATERNGE_" thru "_$$FMTE^XLFDT(LRLDT,"5DZ")
;
K HEADER
S HEADER(1)="Lab Accession and Test Counts"
S HEADER(2)=SELRAAAB_" Accession Area"
S HEADER(3)=$$CJ^XLFSTR("Compilaton Errors Report",IOM)
S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
;
D HEADONE^BLRLUAC2(.HEDONE)
;
S MAXLINES=21,LINES=MAXLINES+10,PG=0
S QFLG="NO"
;
S HEADER(5)=" "
S $E(HEADER(6),20)="Specimen Taken"
S $E(HEADER(6),56)=$TR($$CJ^XLFSTR("@File@63.04@",25)," @","= ")
S HEADER(7)="LRDFN"
S $E(HEADER(7),10)="DFN"
S $E(HEADER(7),22)="Date Time"
S $E(HEADER(7),36)="Accession Number"
S $E(HEADER(7),56)="IEN"
S $E(HEADER(7),66)="Description"
;
S (LRDFN,LRSS,LRIDT,DATANAME)=""
S CNT=0
;
Q "OK"
;
RPTERRSL ; EP
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
;
D ERRBRKO ; Breakout Variables
;
W LRDFN
W ?9,DFN
W ?19,$TR($$FMTE^XLFDT(SPTKNDTT,"2MZ"),"@"," ")
W ?35,LRAS
W ?55,DATANAME
W ?65,$E(DATANDES,1,15)
W !
S LINES=LINES+1
S CNT=CNT+1
Q
;
ERRBRKO ; EP
S DFN=$P($G(^LR(LRDFN,0)),"^",3)
;
S SPTKNDTT=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^")
S COMPDATE=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^",3)
S LRAS=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^",6)
;
; DataName Description
S DATANDES=$P($G(^DD(63.04,DATANAME,0)),"^")
;
; Error Description
S ERRDESC=$P($G(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT,DATANAME)),"^",2)
;
Q
;
ERRDESC ; EP -- Report on Errors during compilation
NEW BLRVERN,COMPDATE,DFN,ERRDESC,LRAS,LRDFN,LRSS,LRIDT,DATANAME,DATANDES
NEW LAB60IEN,LAB60DES,XTMPNODE
NEW CNT,HEADER,HEDONE,LINES,MAXLINES,MAX,PG,QFLG
NEW LRLDT,LRSDT,SELRAAAB,SPTKNDTT,XTMPNODE
NEW DATERNGE,STR
;
Q:$$ERRSINIT()="Q"
;
F S LRDFN=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN)) Q:LRDFN<1!(QFLG="Q") D
. S DFN=$P($G(^LR(LRDFN,0)),"^",3)
. F S LRSS=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS)) Q:$L(LRSS)<1!(QFLG="Q") D
.. F S LRIDT=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT)) Q:$G(LRIDT)=""!(QFLG="Q") D
... S DATANAME=""
... S DATANAME=$O(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT,DATANAME))
... D ERRSLINE
;
W:CNT<1 !!,?4,"No Errors Found.",!
W:CNT>0 !!,?4,"Number of Errors = ",CNT,!
;
D PRESSKEY^BLRGMENU(9)
Q
;
ERRSINIT() ; EP -- Errors Report INITialization of variables
D SETXTMPN^BLRLUAC1(.XTMPNODE) ; Set the ^TMP node
S BLRVERN=$P($P($T(+1),";")," ")
;
Q:$$GETXTMPV^BLRLUAC2("ERRORS",.SELRAAAB,.LRSDT,.LRLDT,"No Errors Found.")="Q" "Q"
;
S DATERNGE="Date Range: "_$$FMTE^XLFDT(LRSDT,"5DZ")
S DATERNGE=DATERNGE_" thru "_$$FMTE^XLFDT(LRLDT,"5DZ")
;
K HEADER
S HEADER(1)="Lab Accession and Test Counts"
S HEADER(2)=SELRAAAB_" Accession Area"
S HEADER(3)=$$CJ^XLFSTR("Compilaton Errors Report",IOM)
S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
;
D HEADONE^BLRLUAC2(.HEDONE)
;
S MAXLINES=21,LINES=MAXLINES+10,PG=0
S QFLG="NO"
;
S HEADER(5)=" "
S $E(HEADER(6),10)="Specimen Taken"
S HEADER(7)="DFN"
S $E(HEADER(7),12)="Date"
S $E(HEADER(7),19)="Time"
S $E(HEADER(7),26)="Accession Number"
S $E(HEADER(7),46)="Error Description"
;
S (LRDFN,LRSS,LRIDT,DATANAME)=""
S CNT=0
;
Q "OK"
;
ERRSLINE ; EP
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
;
D ERRBRKO ; Breakout Variables
;
W DFN
W ?9,$TR($$FMTE^XLFDT(SPTKNDTT,"2MZ"),"@"," ")
W ?25,LRAS
W ?45,$E(ERRDESC,1,35)
W !
S LINES=LINES+1
S CNT=CNT+1
Q
;
TESTORD ; EP - CH Hospital Location sort
NEW CNT,DFN,FNDLRIDT,LRDFN,LRAA,LRAD,LRAN,LRIDT,LRAS,LRSS,SPTKNDAT,STR0,VLABLRAS
;
D ^XBFMK
S DIR(0)="PO^2"
D ^DIR
;
I +$G(Y)<1!(+$G(DIRUT)) D Q
. W !,?4,"No/Invalid Entry. Routine Ends.",!
. D PRESSKEY^BLRGMENU(4)
;
S DFN=+$G(Y)
S LRDFN=+$G(^DPT(DFN,"LR"))
;
D ^XBFMK
S DIR(0)="FO"
S DIR("A")="Select ACCESSION"
D ^DIR
I $G(X)=""!(+$G(DIRUT)) D Q
. W !,?4,"No/Invalid Entry. Routine Ends.",!
. D PRESSKEY^BLRGMENU(4)
;
S X=$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)
I X<1 D Q
. W !,?4,"Could not 'Break Apart' Accession ",LRAS,!!
. D PRESSKEY^BLRGMENU(4)
;
S LRSS=$$GET1^DIQ(68,LRAA,"LR SUBSCRIPT",,,"ERRORS") ; LR Subscript
I $D(ERRORS)>0 D Q
. W !,?4,"Could not Find LR Subscript for ",LRAA,".",!
. D PRESSKEY^BLRGMENU(4)
;
W "LRAD=",LRAD,"; Pseudo LRIDT=",9999999-LRAD,!!
;
S LRIDT=999999,SPTKNDAT=0
F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LRIDT<1!(SPTKNDAT) D
. S STR0=$G(^LR(LRDFN,LRSS,LRIDT,0))
. Q:$P(STR0,"^",6)=LRAS
. S SPTKNDAT=+$P(STR0,"^")
. S FNDLRIDT=LRIDT
;
I SPTKNDAT<1 D Q
. W !,?4,"Could not Find Speciment Taken Date for ",LRAS,".",!
. D PRESSKEY^BLRGMENU(4)
;
W !!,"LRAS:",LRAS,"; SPTKNDAT:",SPTKNDAT,!!
;
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 Q
. W !,"No V LAB Data",!
;
S VISITIEN=+$P($G(^AUPNVLAB(VLABFND,0)),"^",3)
;
S F44IEN=+$P($G(^AUPNVSIT(VISITIEN,0)),"^",22)
;
I F44IEN<1 D Q
. W !,"No File 44 Data in V FILE",!
;
W !,"F44IEN:",F44IEN,!
;
Q
;
VLABIT ; EP
NEW VLABCNT,VLABFND,VLABIEN,VLABLRAS
;
S (VLABCNT,VLABFND)=0,VLABIEN="A"
W ?4
F S VLABIEN=$O(^AUPNVLAB("B",LAB60IEN,VLABIEN),-1) Q:VLABIEN<1!(VLABFND) D
. S VLABLRAS=$P($G(^AUPNVLAB(VLABIEN,0)),"^",6)
. W $$LJ^XLFSTR(VLABLRAS,20)
. W:$X>60 !,?4
. S:VLABLRAS=LRAS VLABFND=VLABIEN
;
W !,"VLABFND:",VLABFND,!
Q
;
VLABDET ; EP
NEW STR,VLABIEN
;
D ^XBFMK
S DIR(0)="PO^9000010.09"
D ^DIR
I +$G(Y)<1!(+$G(DIRUT)) D Q
. W ?4,"No/Invalid Entry into V LAB file. Routine Ends.",!
. D PRESSKEY^BLRGMENU(9)
;
W !!
S VLABIEN=+$G(Y)
S STR=$G(^AUPNVLAB(VLABIEN,0))
W "LAB TEST: ",$E($P($G(^LAB(60,+$P(STR,"^"),0)),"^"),1,27)
W ?40,"PATIENT NAME: ",$E($P($G(^DPT(+$P(STR,"^",2),0)),"^"),1,25)
W !
W ?2,"VISIT:",$P($G(^AUPNVSIT(+$P(STR,"^",3),0)),"^")
W ?40,"RESULTS: ",$E($P(STR,"^",4),1,25)
W !
W ?2,"ABNORMAL: ",$P(STR,"^",5)
W ?40,"LR ACCESSION NO.: ",$P(STR,"^",6)
W !
W ?2,"PROVIDER: ",$E($P($G(^VA(200,+$P(STR,"^",7),0)),"^"),1,25)
;
S STR=$G(^AUPNVLAB(VLABIEN,12))
W ?40,"COLLECTION DATE AND TIME: ",$P(STR,"^")
W !
W ?2,"ORDERING PROVIDER: ",$E($P($G(^VA(200,+$P(STR,"^",2),0)),"^"),1,25)
W ?40,"CLINIC: ",$E($P($G(^DIC(40.7,+$P(STR,"^",3),0)),"^"),1,25)
W !
W ?2,"ENCOUNTER PROVIDER: ",$E($P($G(^VA(200,+$P(STR,"^",4),0)),"^"),1,25)
W ?40,"PARENT: ",$P(STR,"^",8)
W !
W ?2,"EXTERNAL KEY: ",$P(STR,"^",9)
W ?40,"OUTSIDE PROVIDER NAME: ",$E($P(STR,"^",10),1,25)
W !
W ?2,"ORDERING DATE:",$P(STR,"^",11)
W ?40,"RESULT DATE AND TIME: ",$P(STR,"^",12)
W !
; W ?2,"ANCILLARY POV: ",$G(^ICD9(+$P(STR,"^",13),0))
W ?2,"ICD: ",$$GET1^DIQ(9000010.09,VLABIEN,"ICD CODE") ; IHS/MSC/MKK - LR*5.2*1034
W ?40,"ORDERING LOCATION: ",$E($P($G(^SC(+$P(STR,"^",15),0)),"^"),1,25)
W !
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
; Display PROVIDER NARRATIVE and first SNOMED Code
W ?2,"SNOMED: ",$$GET1^DIQ(9000010.0926,1_","_VLABIEN,"SNOMED CT")
D LINEWRAP^BLRGMENU(40,$$GET1^DIQ(9000010.09,VLABIEN,"PROVIDER NARRATIVE"),40)
W !
; ----- END IHS/MSC/MKK - LR*5.2*1034
Q
;
REPTERRC ; EP -- Report on Errors during compilation, Count version
NEW BLRVERN,COMPDATE,DFN,ERRDESC,DATANAME,DATANDES,ERRMSG,ERRMTOT,F60GTOT
NEW LABCNT,LRAS,LRDFN,LRSS,LRIDT,LAB60IEN,LAB60DES,XTMPNODE
NEW CNT,HEADER,HEDONE,LINES,MAXLINES,MAX,PG,QFLG
NEW LRLDT,LRSDT,SELRAAAB,SPTKNDTT,XTMPNODE
NEW DATERNGE,STR
;
Q:$$RPTERRCI()="Q"
;
F S ERRMSG=$O(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG)) Q:ERRMSG=""!(QFLG="Q") D
. D ERRMLINE
. S LABCNT=0
. F S LAB60IEN=$O(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN)) Q:LAB60IEN<1!(QFLG="Q") D
.. D L60LINE
.. S LABCNT=LABCNT+1
. D ERRMTOTL
. I LABCNT<1 W ! S LINES=LINES+1
;
Q:QFLG="Q"
;
D ERR60TOT
;
D CLOSEIO^BLRLUAC9
;
D PRESSKEY^BLRGMENU(9)
;
Q
;
RPTERRCI() ; EP -- Errors Report INITialization of variables - Count version
D SETXTMPN^BLRLUAC1(.XTMPNODE) ; Set the ^BLRLUPAC( node
S BLRVERN=$P($P($T(+1),";")," ")
;
Q:$$GETXTMPV^BLRLUAC2("ERRORS",.SELRAAAB,.LRSDT,.LRLDT,"No Errors Found.")="Q" "Q"
;
S DATERNGE="Date Range: "_$$FMTE^XLFDT(LRSDT,"5DZ")
S DATERNGE=DATERNGE_" thru "_$$FMTE^XLFDT(LRLDT,"5DZ")
;
K HEADER
S HEADER(1)="Lab Accession and Test Counts"
S HEADER(2)=SELRAAAB_" Accession Area"
S HEADER(3)=$$CJ^XLFSTR("Compilaton Errors Report",IOM)
S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
;
D HEADONE^BLRLUAC2(.HEDONE)
;
S MAXLINES=21,LINES=MAXLINES+10,PG=0
S QFLG="NO"
;
S HEADER(5)=" "
S $E(HEADER(6),42)=$TR($$CJ^XLFSTR("@LABORATORY@TEST@(File@60)@",39)," @","= ")
S HEADER(7)="Error Description"
S $E(HEADER(7),32)="Count"
S $E(HEADER(7),42)="IEN"
S $E(HEADER(7),52)="Description"
S $E(HEADER(7),74)="Count"
;
S (CNT,ERRMTOT,F60GTOT,LAB60IEN)=0
;
S ERRMSG=""
Q "OK"
;
ERRMLINE ; EP - Error Message Line
I LINES<(MAXLINES+1) D JUSTERRM
I LINES>MAXLINES D ERRMCPG Q:QFLG="Q"
S LAB60IEN=0
Q
;
ERRMCPG ; EP
D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
;
JUSTERRM ; EP
W $E(ERRMSG,1,30)
W ?31,$J($G(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG)),7)
S:HEDONE="YES" PG=PG+1,LINES=7
Q
;
L60LINE ; EP
I LINES>MAXLINES&(HEDONE'="YES") D ERRMCPG Q:QFLG="Q"
;
S L60DESC=$$TRIM^XLFSTR($P($G(^LAB(60,LAB60IEN,0)),"^"),"LR"," ")
;
W ?41,LAB60IEN
W ?51,$E(L60DESC,1,18)
W ?73,$J($G(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN)),7)
W !
;
S LINES=LINES+1
S F60GTOT=F60GTOT+$G(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN))
Q
;
ERRMTOTL ; EP
W !
S LINES=LINES+1
S ERRMTOT=ERRMTOT+$G(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG))
Q
;
ERR60TOT ; EP
W ?31,$TR($J("",7)," ","-")
W ?73,$TR($J("",7)," ","-")
W !
W ?9,"TOTALS"
W ?31,$J(ERRMTOT,7)
W ?73,$J(F60GTOT,7)
W !
Q
BLRLUAC8 ; IHS/OIT/MKK - IHS LRUPAC 8, error in compilation report ; 17-Oct-2014 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1030,1034**;NOV 01, 1997;Build 88
+2 ;;
REPTERRS ; EP -- Report on Errors during compilation
+1 NEW BLRVERN,COMPDATE,DFN,ERRDESC,DATANAME,DATANDES
+2 NEW LRAS,LRDFN,LRSS,LRIDT,LAB60IEN,LAB60DES,XTMPNODE
+3 NEW CNT,HEADER,HEDONE,LINES,MAXLINES,MAX,PG,QFLG
+4 NEW LRLDT,LRSDT,SELRAAAB,SPTKNDTT,XTMPNODE
+5 NEW DATERNGE,STR
+6 ;
+7 IF $$RPTERRSI()="Q"
QUIT
+8 ;
+9 FOR
SET LRDFN=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN))
IF LRDFN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+10 FOR
SET LRSS=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS))
IF $LENGTH(LRSS)<1!(QFLG="Q")
QUIT
Begin DoDot:2
+11 FOR
SET LRIDT=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT))
IF $GET(LRIDT)=""!(QFLG="Q")
QUIT
Begin DoDot:3
+12 FOR
SET DATANAME=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT,DATANAME))
IF $GET(DATANAME)=""!(QFLG="Q")
QUIT
Begin DoDot:4
+13 DO RPTERRSL
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 IF CNT<1
WRITE !!,?4,"No Errors Found.",!
+16 IF CNT>0
WRITE !!,?4,"Number of Errors = ",CNT,!
+17 ;
+18 DO PRESSKEY^BLRGMENU(9)
+19 QUIT
+20 ;
RPTERRSI() ; EP -- Errors Report INITialization of variables
+1 ; Set the ^BLRLUPAC( node
DO SETXTMPN^BLRLUAC1(.XTMPNODE)
+2 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+3 ;
+4 IF $$GETXTMPV^BLRLUAC2("ERRORS",.SELRAAAB,.LRSDT,.LRLDT,"No Errors Found.")="Q"
QUIT "Q"
+5 ;
+6 SET DATERNGE="Date Range: "_$$FMTE^XLFDT(LRSDT,"5DZ")
+7 SET DATERNGE=DATERNGE_" thru "_$$FMTE^XLFDT(LRLDT,"5DZ")
+8 ;
+9 KILL HEADER
+10 SET HEADER(1)="Lab Accession and Test Counts"
+11 SET HEADER(2)=SELRAAAB_" Accession Area"
+12 SET HEADER(3)=$$CJ^XLFSTR("Compilaton Errors Report",IOM)
+13 SET HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
+14 ;
+15 DO HEADONE^BLRLUAC2(.HEDONE)
+16 ;
+17 SET MAXLINES=21
SET LINES=MAXLINES+10
SET PG=0
+18 SET QFLG="NO"
+19 ;
+20 SET HEADER(5)=" "
+21 SET $EXTRACT(HEADER(6),20)="Specimen Taken"
+22 SET $EXTRACT(HEADER(6),56)=$TRANSLATE($$CJ^XLFSTR("@File@63.04@",25)," @","= ")
+23 SET HEADER(7)="LRDFN"
+24 SET $EXTRACT(HEADER(7),10)="DFN"
+25 SET $EXTRACT(HEADER(7),22)="Date Time"
+26 SET $EXTRACT(HEADER(7),36)="Accession Number"
+27 SET $EXTRACT(HEADER(7),56)="IEN"
+28 SET $EXTRACT(HEADER(7),66)="Description"
+29 ;
+30 SET (LRDFN,LRSS,LRIDT,DATANAME)=""
+31 SET CNT=0
+32 ;
+33 QUIT "OK"
+34 ;
RPTERRSL ; EP
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+2 ;
+3 ; Breakout Variables
DO ERRBRKO
+4 ;
+5 WRITE LRDFN
+6 WRITE ?9,DFN
+7 WRITE ?19,$TRANSLATE($$FMTE^XLFDT(SPTKNDTT,"2MZ"),"@"," ")
+8 WRITE ?35,LRAS
+9 WRITE ?55,DATANAME
+10 WRITE ?65,$EXTRACT(DATANDES,1,15)
+11 WRITE !
+12 SET LINES=LINES+1
+13 SET CNT=CNT+1
+14 QUIT
+15 ;
ERRBRKO ; EP
+1 SET DFN=$PIECE($GET(^LR(LRDFN,0)),"^",3)
+2 ;
+3 SET SPTKNDTT=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),"^")
+4 SET COMPDATE=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),"^",3)
+5 SET LRAS=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),"^",6)
+6 ;
+7 ; DataName Description
+8 SET DATANDES=$PIECE($GET(^DD(63.04,DATANAME,0)),"^")
+9 ;
+10 ; Error Description
+11 SET ERRDESC=$PIECE($GET(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT,DATANAME)),"^",2)
+12 ;
+13 QUIT
+14 ;
ERRDESC ; EP -- Report on Errors during compilation
+1 NEW BLRVERN,COMPDATE,DFN,ERRDESC,LRAS,LRDFN,LRSS,LRIDT,DATANAME,DATANDES
+2 NEW LAB60IEN,LAB60DES,XTMPNODE
+3 NEW CNT,HEADER,HEDONE,LINES,MAXLINES,MAX,PG,QFLG
+4 NEW LRLDT,LRSDT,SELRAAAB,SPTKNDTT,XTMPNODE
+5 NEW DATERNGE,STR
+6 ;
+7 IF $$ERRSINIT()="Q"
QUIT
+8 ;
+9 FOR
SET LRDFN=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN))
IF LRDFN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+10 SET DFN=$PIECE($GET(^LR(LRDFN,0)),"^",3)
+11 FOR
SET LRSS=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS))
IF $LENGTH(LRSS)<1!(QFLG="Q")
QUIT
Begin DoDot:2
+12 FOR
SET LRIDT=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT))
IF $GET(LRIDT)=""!(QFLG="Q")
QUIT
Begin DoDot:3
+13 SET DATANAME=""
+14 SET DATANAME=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",LRDFN,LRSS,LRIDT,DATANAME))
+15 DO ERRSLINE
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 IF CNT<1
WRITE !!,?4,"No Errors Found.",!
+18 IF CNT>0
WRITE !!,?4,"Number of Errors = ",CNT,!
+19 ;
+20 DO PRESSKEY^BLRGMENU(9)
+21 QUIT
+22 ;
ERRSINIT() ; EP -- Errors Report INITialization of variables
+1 ; Set the ^TMP node
DO SETXTMPN^BLRLUAC1(.XTMPNODE)
+2 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+3 ;
+4 IF $$GETXTMPV^BLRLUAC2("ERRORS",.SELRAAAB,.LRSDT,.LRLDT,"No Errors Found.")="Q"
QUIT "Q"
+5 ;
+6 SET DATERNGE="Date Range: "_$$FMTE^XLFDT(LRSDT,"5DZ")
+7 SET DATERNGE=DATERNGE_" thru "_$$FMTE^XLFDT(LRLDT,"5DZ")
+8 ;
+9 KILL HEADER
+10 SET HEADER(1)="Lab Accession and Test Counts"
+11 SET HEADER(2)=SELRAAAB_" Accession Area"
+12 SET HEADER(3)=$$CJ^XLFSTR("Compilaton Errors Report",IOM)
+13 SET HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
+14 ;
+15 DO HEADONE^BLRLUAC2(.HEDONE)
+16 ;
+17 SET MAXLINES=21
SET LINES=MAXLINES+10
SET PG=0
+18 SET QFLG="NO"
+19 ;
+20 SET HEADER(5)=" "
+21 SET $EXTRACT(HEADER(6),10)="Specimen Taken"
+22 SET HEADER(7)="DFN"
+23 SET $EXTRACT(HEADER(7),12)="Date"
+24 SET $EXTRACT(HEADER(7),19)="Time"
+25 SET $EXTRACT(HEADER(7),26)="Accession Number"
+26 SET $EXTRACT(HEADER(7),46)="Error Description"
+27 ;
+28 SET (LRDFN,LRSS,LRIDT,DATANAME)=""
+29 SET CNT=0
+30 ;
+31 QUIT "OK"
+32 ;
ERRSLINE ; EP
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+2 ;
+3 ; Breakout Variables
DO ERRBRKO
+4 ;
+5 WRITE DFN
+6 WRITE ?9,$TRANSLATE($$FMTE^XLFDT(SPTKNDTT,"2MZ"),"@"," ")
+7 WRITE ?25,LRAS
+8 WRITE ?45,$EXTRACT(ERRDESC,1,35)
+9 WRITE !
+10 SET LINES=LINES+1
+11 SET CNT=CNT+1
+12 QUIT
+13 ;
TESTORD ; EP - CH Hospital Location sort
+1 NEW CNT,DFN,FNDLRIDT,LRDFN,LRAA,LRAD,LRAN,LRIDT,LRAS,LRSS,SPTKNDAT,STR0,VLABLRAS
+2 ;
+3 DO ^XBFMK
+4 SET DIR(0)="PO^2"
+5 DO ^DIR
+6 ;
+7 IF +$GET(Y)<1!(+$GET(DIRUT))
Begin DoDot:1
+8 WRITE !,?4,"No/Invalid Entry. Routine Ends.",!
+9 DO PRESSKEY^BLRGMENU(4)
End DoDot:1
QUIT
+10 ;
+11 SET DFN=+$GET(Y)
+12 SET LRDFN=+$GET(^DPT(DFN,"LR"))
+13 ;
+14 DO ^XBFMK
+15 SET DIR(0)="FO"
+16 SET DIR("A")="Select ACCESSION"
+17 DO ^DIR
+18 IF $GET(X)=""!(+$GET(DIRUT))
Begin DoDot:1
+19 WRITE !,?4,"No/Invalid Entry. Routine Ends.",!
+20 DO PRESSKEY^BLRGMENU(4)
End DoDot:1
QUIT
+21 ;
+22 SET X=$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)
+23 IF X<1
Begin DoDot:1
+24 WRITE !,?4,"Could not 'Break Apart' Accession ",LRAS,!!
+25 DO PRESSKEY^BLRGMENU(4)
End DoDot:1
QUIT
+26 ;
+27 ; LR Subscript
SET LRSS=$$GET1^DIQ(68,LRAA,"LR SUBSCRIPT",,,"ERRORS")
+28 IF $DATA(ERRORS)>0
Begin DoDot:1
+29 WRITE !,?4,"Could not Find LR Subscript for ",LRAA,".",!
+30 DO PRESSKEY^BLRGMENU(4)
End DoDot:1
QUIT
+31 ;
+32 WRITE "LRAD=",LRAD,"; Pseudo LRIDT=",9999999-LRAD,!!
+33 ;
+34 SET LRIDT=999999
SET SPTKNDAT=0
+35 FOR
SET LRIDT=$ORDER(^LR(LRDFN,LRSS,LRIDT))
IF LRIDT<1!(SPTKNDAT)
QUIT
Begin DoDot:1
+36 SET STR0=$GET(^LR(LRDFN,LRSS,LRIDT,0))
+37 IF $PIECE(STR0,"^",6)=LRAS
QUIT
+38 SET SPTKNDAT=+$PIECE(STR0,"^")
+39 SET FNDLRIDT=LRIDT
End DoDot:1
+40 ;
+41 IF SPTKNDAT<1
Begin DoDot:1
+42 WRITE !,?4,"Could not Find Speciment Taken Date for ",LRAS,".",!
+43 DO PRESSKEY^BLRGMENU(4)
End DoDot:1
QUIT
+44 ;
+45 WRITE !!,"LRAS:",LRAS,"; SPTKNDAT:",SPTKNDAT,!!
+46 ;
+47 SET (VLABCNT,VLABFND)=0
SET VLABIEN="A"
+48 FOR
SET VLABIEN=$ORDER(^AUPNVLAB("B",LAB60IEN,VLABIEN),-1)
IF VLABIEN<1!(VLABFND)
QUIT
Begin DoDot:1
+49 IF $PIECE($GET(^AUPNVLAB(VLABIEN,0)),"^",6)=LRAS
SET VLABFND=VLABIEN
End DoDot:1
+50 ;
+51 IF VLABFND<1
Begin DoDot:1
+52 WRITE !,"No V LAB Data",!
End DoDot:1
QUIT
+53 ;
+54 SET VISITIEN=+$PIECE($GET(^AUPNVLAB(VLABFND,0)),"^",3)
+55 ;
+56 SET F44IEN=+$PIECE($GET(^AUPNVSIT(VISITIEN,0)),"^",22)
+57 ;
+58 IF F44IEN<1
Begin DoDot:1
+59 WRITE !,"No File 44 Data in V FILE",!
End DoDot:1
QUIT
+60 ;
+61 WRITE !,"F44IEN:",F44IEN,!
+62 ;
+63 QUIT
+64 ;
VLABIT ; EP
+1 NEW VLABCNT,VLABFND,VLABIEN,VLABLRAS
+2 ;
+3 SET (VLABCNT,VLABFND)=0
SET VLABIEN="A"
+4 WRITE ?4
+5 FOR
SET VLABIEN=$ORDER(^AUPNVLAB("B",LAB60IEN,VLABIEN),-1)
IF VLABIEN<1!(VLABFND)
QUIT
Begin DoDot:1
+6 SET VLABLRAS=$PIECE($GET(^AUPNVLAB(VLABIEN,0)),"^",6)
+7 WRITE $$LJ^XLFSTR(VLABLRAS,20)
+8 IF $X>60
WRITE !,?4
+9 IF VLABLRAS=LRAS
SET VLABFND=VLABIEN
End DoDot:1
+10 ;
+11 WRITE !,"VLABFND:",VLABFND,!
+12 QUIT
+13 ;
VLABDET ; EP
+1 NEW STR,VLABIEN
+2 ;
+3 DO ^XBFMK
+4 SET DIR(0)="PO^9000010.09"
+5 DO ^DIR
+6 IF +$GET(Y)<1!(+$GET(DIRUT))
Begin DoDot:1
+7 WRITE ?4,"No/Invalid Entry into V LAB file. Routine Ends.",!
+8 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+9 ;
+10 WRITE !!
+11 SET VLABIEN=+$GET(Y)
+12 SET STR=$GET(^AUPNVLAB(VLABIEN,0))
+13 WRITE "LAB TEST: ",$EXTRACT($PIECE($GET(^LAB(60,+$PIECE(STR,"^"),0)),"^"),1,27)
+14 WRITE ?40,"PATIENT NAME: ",$EXTRACT($PIECE($GET(^DPT(+$PIECE(STR,"^",2),0)),"^"),1,25)
+15 WRITE !
+16 WRITE ?2,"VISIT:",$PIECE($GET(^AUPNVSIT(+$PIECE(STR,"^",3),0)),"^")
+17 WRITE ?40,"RESULTS: ",$EXTRACT($PIECE(STR,"^",4),1,25)
+18 WRITE !
+19 WRITE ?2,"ABNORMAL: ",$PIECE(STR,"^",5)
+20 WRITE ?40,"LR ACCESSION NO.: ",$PIECE(STR,"^",6)
+21 WRITE !
+22 WRITE ?2,"PROVIDER: ",$EXTRACT($PIECE($GET(^VA(200,+$PIECE(STR,"^",7),0)),"^"),1,25)
+23 ;
+24 SET STR=$GET(^AUPNVLAB(VLABIEN,12))
+25 WRITE ?40,"COLLECTION DATE AND TIME: ",$PIECE(STR,"^")
+26 WRITE !
+27 WRITE ?2,"ORDERING PROVIDER: ",$EXTRACT($PIECE($GET(^VA(200,+$PIECE(STR,"^",2),0)),"^"),1,25)
+28 WRITE ?40,"CLINIC: ",$EXTRACT($PIECE($GET(^DIC(40.7,+$PIECE(STR,"^",3),0)),"^"),1,25)
+29 WRITE !
+30 WRITE ?2,"ENCOUNTER PROVIDER: ",$EXTRACT($PIECE($GET(^VA(200,+$PIECE(STR,"^",4),0)),"^"),1,25)
+31 WRITE ?40,"PARENT: ",$PIECE(STR,"^",8)
+32 WRITE !
+33 WRITE ?2,"EXTERNAL KEY: ",$PIECE(STR,"^",9)
+34 WRITE ?40,"OUTSIDE PROVIDER NAME: ",$EXTRACT($PIECE(STR,"^",10),1,25)
+35 WRITE !
+36 WRITE ?2,"ORDERING DATE:",$PIECE(STR,"^",11)
+37 WRITE ?40,"RESULT DATE AND TIME: ",$PIECE(STR,"^",12)
+38 WRITE !
+39 ; W ?2,"ANCILLARY POV: ",$G(^ICD9(+$P(STR,"^",13),0))
+40 ; IHS/MSC/MKK - LR*5.2*1034
WRITE ?2,"ICD: ",$$GET1^DIQ(9000010.09,VLABIEN,"ICD CODE")
+41 WRITE ?40,"ORDERING LOCATION: ",$EXTRACT($PIECE($GET(^SC(+$PIECE(STR,"^",15),0)),"^"),1,25)
+42 WRITE !
+43 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
+44 ; Display PROVIDER NARRATIVE and first SNOMED Code
+45 WRITE ?2,"SNOMED: ",$$GET1^DIQ(9000010.0926,1_","_VLABIEN,"SNOMED CT")
+46 DO LINEWRAP^BLRGMENU(40,$$GET1^DIQ(9000010.09,VLABIEN,"PROVIDER NARRATIVE"),40)
+47 WRITE !
+48 ; ----- END IHS/MSC/MKK - LR*5.2*1034
+49 QUIT
+50 ;
REPTERRC ; EP -- Report on Errors during compilation, Count version
+1 NEW BLRVERN,COMPDATE,DFN,ERRDESC,DATANAME,DATANDES,ERRMSG,ERRMTOT,F60GTOT
+2 NEW LABCNT,LRAS,LRDFN,LRSS,LRIDT,LAB60IEN,LAB60DES,XTMPNODE
+3 NEW CNT,HEADER,HEDONE,LINES,MAXLINES,MAX,PG,QFLG
+4 NEW LRLDT,LRSDT,SELRAAAB,SPTKNDTT,XTMPNODE
+5 NEW DATERNGE,STR
+6 ;
+7 IF $$RPTERRCI()="Q"
QUIT
+8 ;
+9 FOR
SET ERRMSG=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG))
IF ERRMSG=""!(QFLG="Q")
QUIT
Begin DoDot:1
+10 DO ERRMLINE
+11 SET LABCNT=0
+12 FOR
SET LAB60IEN=$ORDER(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN))
IF LAB60IEN<1!(QFLG="Q")
QUIT
Begin DoDot:2
+13 DO L60LINE
+14 SET LABCNT=LABCNT+1
End DoDot:2
+15 DO ERRMTOTL
+16 IF LABCNT<1
WRITE !
SET LINES=LINES+1
End DoDot:1
+17 ;
+18 IF QFLG="Q"
QUIT
+19 ;
+20 DO ERR60TOT
+21 ;
+22 DO CLOSEIO^BLRLUAC9
+23 ;
+24 DO PRESSKEY^BLRGMENU(9)
+25 ;
+26 QUIT
+27 ;
RPTERRCI() ; EP -- Errors Report INITialization of variables - Count version
+1 ; Set the ^BLRLUPAC( node
DO SETXTMPN^BLRLUAC1(.XTMPNODE)
+2 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+3 ;
+4 IF $$GETXTMPV^BLRLUAC2("ERRORS",.SELRAAAB,.LRSDT,.LRLDT,"No Errors Found.")="Q"
QUIT "Q"
+5 ;
+6 SET DATERNGE="Date Range: "_$$FMTE^XLFDT(LRSDT,"5DZ")
+7 SET DATERNGE=DATERNGE_" thru "_$$FMTE^XLFDT(LRLDT,"5DZ")
+8 ;
+9 KILL HEADER
+10 SET HEADER(1)="Lab Accession and Test Counts"
+11 SET HEADER(2)=SELRAAAB_" Accession Area"
+12 SET HEADER(3)=$$CJ^XLFSTR("Compilaton Errors Report",IOM)
+13 SET HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
+14 ;
+15 DO HEADONE^BLRLUAC2(.HEDONE)
+16 ;
+17 SET MAXLINES=21
SET LINES=MAXLINES+10
SET PG=0
+18 SET QFLG="NO"
+19 ;
+20 SET HEADER(5)=" "
+21 SET $EXTRACT(HEADER(6),42)=$TRANSLATE($$CJ^XLFSTR("@LABORATORY@TEST@(File@60)@",39)," @","= ")
+22 SET HEADER(7)="Error Description"
+23 SET $EXTRACT(HEADER(7),32)="Count"
+24 SET $EXTRACT(HEADER(7),42)="IEN"
+25 SET $EXTRACT(HEADER(7),52)="Description"
+26 SET $EXTRACT(HEADER(7),74)="Count"
+27 ;
+28 SET (CNT,ERRMTOT,F60GTOT,LAB60IEN)=0
+29 ;
+30 SET ERRMSG=""
+31 QUIT "OK"
+32 ;
ERRMLINE ; EP - Error Message Line
+1 IF LINES<(MAXLINES+1)
DO JUSTERRM
+2 IF LINES>MAXLINES
DO ERRMCPG
IF QFLG="Q"
QUIT
+3 SET LAB60IEN=0
+4 QUIT
+5 ;
ERRMCPG ; EP
+1 DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+2 ;
JUSTERRM ; EP
+1 WRITE $EXTRACT(ERRMSG,1,30)
+2 WRITE ?31,$JUSTIFY($GET(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG)),7)
+3 IF HEDONE="YES"
SET PG=PG+1
SET LINES=7
+4 QUIT
+5 ;
L60LINE ; EP
+1 IF LINES>MAXLINES&(HEDONE'="YES")
DO ERRMCPG
IF QFLG="Q"
QUIT
+2 ;
+3 SET L60DESC=$$TRIM^XLFSTR($PIECE($GET(^LAB(60,LAB60IEN,0)),"^"),"LR"," ")
+4 ;
+5 WRITE ?41,LAB60IEN
+6 WRITE ?51,$EXTRACT(L60DESC,1,18)
+7 WRITE ?73,$JUSTIFY($GET(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN)),7)
+8 WRITE !
+9 ;
+10 SET LINES=LINES+1
+11 SET F60GTOT=F60GTOT+$GET(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG,LAB60IEN))
+12 QUIT
+13 ;
ERRMTOTL ; EP
+1 WRITE !
+2 SET LINES=LINES+1
+3 SET ERRMTOT=ERRMTOT+$GET(^BLRLUPAC(DATETIME,"ERRORS",ERRMSG))
+4 QUIT
+5 ;
ERR60TOT ; EP
+1 WRITE ?31,$TRANSLATE($JUSTIFY("",7)," ","-")
+2 WRITE ?73,$TRANSLATE($JUSTIFY("",7)," ","-")
+3 WRITE !
+4 WRITE ?9,"TOTALS"
+5 WRITE ?31,$JUSTIFY(ERRMTOT,7)
+6 WRITE ?73,$JUSTIFY(F60GTOT,7)
+7 WRITE !
+8 QUIT
