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

BLRLUAC7.m

Go to the documentation of this file. 
  1. BLRLUAC7 ;  IHS/OIT/MKK - IHS LRUPAC 7, file 4 & 60 report ; [ 05/15/11  7:50 AM ]
  1.  ;;5.2;LR;**1030**;NOV 01, 1997
  1.  ;;
  1.  ;; Emulates the Lab accession and test counts Report, Part 5
  1.  ;;
  1. FILE4RPT ; EP - Institution File Counts
  1.  NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
  1.  NEW F4GTOT,LAB4IEN,L4DESC
  1.  NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
  1.  ;
  1.  Q:$$F4INITV()="Q"
  1.  ;
  1.  F  S LAB4IEN=$O(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN))  Q:LAB4IEN<1!(QFLG="Q")  D
  1.  . I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)  Q:QFLG="Q"
  1.  . ;
  1.  . S L4DESC=$$TRIM^XLFSTR($P($G(^DIC(4,LAB4IEN,0)),"^"),"LR"," ")
  1.  . W ?4,LAB4IEN
  1.  . W ?14,L4DESC
  1.  . W ?64,$J($FN($G(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN)),","),11)
  1.  . W !
  1.  . S LINES=LINES+1
  1.  . S F4GTOT=F4GTOT+$G(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN))
  1.  ;
  1.  D TOTALS^BLRLUAC2(F4GTOT)
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  Q:QFLG="Q"
  1.  D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  Q
  1.  ;
  1. F4INITV() ; EP - File 4 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 Institution File Data Found."
  1.  Q:$$GETXTMPV^BLRLUAC2("SITESORT",.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("Institution File (# 4) Sort",IOM)
  1.  S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
  1.  ;
  1.  S MAXLINES=22,LINES=MAXLINES+10,PG=0,(QFLG,HEDONE)="NO"
  1.  ;
  1.  D OPENIO^BLRLUAC9(.MAXLINES,.LINES)
  1.  ;
  1.  I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE)  W !
  1.  ;
  1.  S QFLG="NO"
  1.  ;
  1.  S HEADER(5)=" "
  1.  S $E(HEADER(6),5)="IEN"
  1.  S $E(HEADER(6),15)="Description"
  1.  S $E(HEADER(6),65)=$J("Count",11)
  1.  ;
  1.  S (F4GTOT,LAB4IEN)=0
  1.  ;
  1.  Q "OK"
  1.  ;
  1. F460REPT ; EP
  1.  NEW F4DESC,F4IEN,LAB60IEN,L60DESC
  1.  NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
  1.  NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
  1.  NEW F4GTOT,F4STOT,F60GTOT
  1.  ;
  1.  Q:$$F460INIV()="Q"
  1.  ;
  1.  F  S F4IEN=$O(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))  Q:F4IEN<1!(QFLG="Q")  D
  1.  . D F4LINE
  1.  . F  S LAB60IEN=$O(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))  Q:LAB60IEN<1!(QFLG="Q")  D
  1.  .. D F460LINE
  1.  . D F460SUB
  1.  ;
  1.  I QFLG="Q"  D ^%ZISC  Q
  1.  ;
  1.  D F460TOT
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  Q
  1.  ;
  1. F460INIV() ; 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 Institution 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("Institution (# 4) & Laboratory Test (# 60) Report",IOM)
  1.  S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
  1.  ;
  1.  S MAXLINES=22,LINES=MAXLINES+10,PG=0,(QFLG,HEDONE)="NO"
  1.  ;
  1.  D OPENIO^BLRLUAC9(.MAXLINES,.LINES)
  1.  ;
  1.  I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE)  W !
  1.  ;
  1.  S HEADER(5)=" "
  1.  S HEADER(6)=$TR($$CJ^XLFSTR("@INSTITUTION@(File@4)@",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 (F4GTOT,F4STOT,F60GTOT,F4IEN)=0
  1.  ;
  1.  Q "OK"
  1.  ;
  1. F4LINE ; EP
  1.  S F4DESC=$P($G(^DIC(4,F4IEN,0)),"^")
  1.  I LINES<(MAXLINES+1) D JUSTSPEC
  1.  I LINES>MAXLINES D F460PG  Q:QFLG="Q"
  1.  S LAB60IEN=0
  1.  Q
  1.  ;
  1. F460LINE ; EP 
  1.  I LINES>MAXLINES&(HEDONE'="YES") D F460PG  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,"SITESORT",F4IEN,LAB60IEN)),7)
  1.  W !
  1.  ;
  1.  S LINES=LINES+1
  1.  S F60GTOT=F60GTOT+$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))
  1.  S F4STOT=F4STOT+$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))
  1.  Q
  1.  ;
  1. F460SUB ; EP - Subtotal
  1.  W ?73,$TR($J("",7)," ","-"),!
  1.  W ?9,F4DESC," TOTAL",?73,$J(F4STOT,7),!!
  1.  S LINES=LINES+3
  1.  S F4GTOT=F4GTOT+$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))
  1.  S F4STOT=0
  1.  Q
  1.  ;
  1. F460TOT ; EP 
  1.  ; W ?31,$TR($J("",7)," ","-")
  1.  W ?73,$TR($J("",7)," ","-")
  1.  W !
  1.  W ?9,"TOTALS"
  1.  ; W ?31,F4GTOT
  1.  W ?73,$J(F60GTOT,7)
  1.  W !
  1.  Q
  1.  ;
  1. F460PG ; EP
  1.  D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)  Q:QFLG="Q"
  1.  ;
  1. JUSTSPEC ; EP
  1.  W F4IEN
  1.  W ?9,$E(F4DESC,1,18)
  1.  ; W ?31,$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))
  1.  S:HEDONE="YES" PG=PG+1,LINES=7
  1.  Q