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

BLRLUAC4.m

Go to the documentation of this file. 
  1. BLRLUAC4 ; IHS/OIT/MKK - IHS LRUPAC 4, file 61 & 60 report ; [ 05/15/11  7:50 AM ]
  1.  ;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
  1.  ;;
  1.  ;; Emulates the Lab accession and test counts Report, Part 4
  1.  ;;
  1. F6160RPT ; EP
  1.  NEW LAB60IEN,L60DESC,SPECTYPE,SPECNAME
  1.  NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
  1.  NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
  1.  NEW F60GTOT,F60STOT,F61GTOT,F61STOT
  1.  ;
  1.  Q:$$F6160INV()="Q"
  1.  ;
  1.  F  S SPECTYPE=$O(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))  Q:SPECTYPE<1!(QFLG="Q")  D
  1.  . D SPECLINE
  1.  . F  S LAB60IEN=$O(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))  Q:LAB60IEN<1!(QFLG="Q")  D
  1.  .. D L60LINE
  1.  . D SPECTOTL
  1.  ;
  1.  Q:QFLG="Q"
  1.  ;
  1.  D F6160TOT
  1.  ;
  1.  D CLOSEIO^BLRLUAC9
  1.  ;
  1.  D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  Q
  1.  ;
  1. F6160INV() ; EP - File 61 with File 60 detail report INitialization of Variables
  1.  D SETXTMPN^BLRLUAC1(.XTMPNODE)     ; Set the ^TMP node
  1.  S BLRVERN=$P($P($T(+1),";")," ")
  1.  ;
  1.  NEW DATERNGE,BADMSG,STR
  1.  ;
  1.  S BADMSG="No Topography nor Laboratory Test File Data Found."
  1.  Q:$$GETXTMPV^BLRLUAC2("SPECSORT",.SELRAAAB,.LRSDT,.LRLDT,BADMSG)="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 Counts Only"
  1.  S HEADER(3)=$$CJ^XLFSTR("Topography (# 61) & Laboratory Test (# 60) Report",IOM)
  1.  S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
  1.  ;
  1.  S MAXLINES=22,LINES=MAXLINES+10,PG=0
  1.  S QFLG="NO"
  1.  ;
  1.  S HEADER(5)=" "
  1.  S HEADER(6)=$TR($$CJ^XLFSTR("@TOPOGRAPHY@(File@61)@",38)," @","= ")
  1.  S $E(HEADER(6),42)=$TR($$CJ^XLFSTR("@LABORATORY@TEST@(File@60)@",39)," @","= ")
  1.  S HEADER(7)="IEN"
  1.  S $E(HEADER(7),10)="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 (F60GTOT,F61GTOT,F61STOT,SPECTYPE)=0
  1.  ;
  1.  S (HEDONE,QFLG)="NO"
  1.  S MAXLINES=22,LINES=MAXLINES+10,PG=0
  1.  ;
  1.  D OPENIO^BLRLUAC9(.MAXLINES,.LINES)
  1.  ;
  1.  I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE)  W !
  1.  ;
  1.  Q "OK"
  1.  ;
  1. SPECLINE ; EP
  1.  S SPECNAME=$P($G(^LAB(61,SPECTYPE,0)),"^")
  1.  I LINES<(MAXLINES+1) D JUSTSPEC
  1.  I LINES>MAXLINES D F6160PG  Q:QFLG="Q"
  1.  S (F60STOT,LAB60IEN)=0
  1.  Q
  1.  ;
  1. L60LINE ; EP
  1.  I LINES>MAXLINES&(HEDONE'="YES") D F6160PG  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,"SPECSORT",SPECTYPE,LAB60IEN)),7)
  1.  W !
  1.  ;
  1.  S LINES=LINES+1
  1.  S F60GTOT=F60GTOT+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
  1.  S F60STOT=F60STOT+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
  1.  Q
  1.  ;
  1. SPECTOTL ; EP
  1.  D:LINES+3>MAXLINES HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)  Q:QFLG="Q"
  1.  ;
  1.  W ?73,$TR($J("",7)," ","-")
  1.  W !
  1.  ;
  1.  W SPECTYPE
  1.  W ?9,SPECNAME," TOTALS"
  1.  W ?73,$J(F60STOT,7)
  1.  W !!
  1.  S LINES=LINES+3
  1.  ;
  1.  S F61GTOT=F61GTOT+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))
  1.  S (F61STOT,F60STOT)=0
  1.  Q
  1.  ;
  1. F6160TOT ; EP
  1.  W ?73,$TR($J("",7)," ","-")
  1.  W !
  1.  W ?9,"TOPOGRAPHY (File 61) Totals"
  1.  W ?73,$J(F60GTOT,7)
  1.  W !
  1.  S LINES=LINES+2
  1.  Q
  1.  ;
  1. F6160PG ; EP
  1.  D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)  Q:QFLG="Q"
  1.  ;
  1. JUSTSPEC ; EP
  1.  W SPECTYPE
  1.  W ?9,$E(SPECNAME,1,25)
  1.  ; W ?31,$J($G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE)),7)
  1.  S:HEDONE="YES" PG=PG+1,LINES=7
  1.  Q