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

BLRLUAC8.m

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