BLRLUAC4 ; IHS/OIT/MKK - IHS LRUPAC 4, file 61 & 60 report ; [ 05/15/11 7:50 AM ]
;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
;;
;; Emulates the Lab accession and test counts Report, Part 4
;;
F6160RPT ; EP
NEW LAB60IEN,L60DESC,SPECTYPE,SPECNAME
NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
NEW F60GTOT,F60STOT,F61GTOT,F61STOT
;
Q:$$F6160INV()="Q"
;
F S SPECTYPE=$O(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE)) Q:SPECTYPE<1!(QFLG="Q") D
. D SPECLINE
. F S LAB60IEN=$O(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN)) Q:LAB60IEN<1!(QFLG="Q") D
.. D L60LINE
. D SPECTOTL
;
Q:QFLG="Q"
;
D F6160TOT
;
D CLOSEIO^BLRLUAC9
;
D PRESSKEY^BLRGMENU(9)
;
Q
;
F6160INV() ; EP - File 61 with File 60 detail report INitialization of Variables
D SETXTMPN^BLRLUAC1(.XTMPNODE) ; Set the ^TMP node
S BLRVERN=$P($P($T(+1),";")," ")
;
NEW DATERNGE,BADMSG,STR
;
S BADMSG="No Topography nor Laboratory Test File Data Found."
Q:$$GETXTMPV^BLRLUAC2("SPECSORT",.SELRAAAB,.LRSDT,.LRLDT,BADMSG)="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 Counts Only"
S HEADER(3)=$$CJ^XLFSTR("Topography (# 61) & Laboratory Test (# 60) Report",IOM)
S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
;
S MAXLINES=22,LINES=MAXLINES+10,PG=0
S QFLG="NO"
;
S HEADER(5)=" "
S HEADER(6)=$TR($$CJ^XLFSTR("@TOPOGRAPHY@(File@61)@",38)," @","= ")
S $E(HEADER(6),42)=$TR($$CJ^XLFSTR("@LABORATORY@TEST@(File@60)@",39)," @","= ")
S HEADER(7)="IEN"
S $E(HEADER(7),10)="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 (F60GTOT,F61GTOT,F61STOT,SPECTYPE)=0
;
S (HEDONE,QFLG)="NO"
S MAXLINES=22,LINES=MAXLINES+10,PG=0
;
D OPENIO^BLRLUAC9(.MAXLINES,.LINES)
;
I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE) W !
;
Q "OK"
;
SPECLINE ; EP
S SPECNAME=$P($G(^LAB(61,SPECTYPE,0)),"^")
I LINES<(MAXLINES+1) D JUSTSPEC
I LINES>MAXLINES D F6160PG Q:QFLG="Q"
S (F60STOT,LAB60IEN)=0
Q
;
L60LINE ; EP
I LINES>MAXLINES&(HEDONE'="YES") D F6160PG 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,"SPECSORT",SPECTYPE,LAB60IEN)),7)
W !
;
S LINES=LINES+1
S F60GTOT=F60GTOT+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
S F60STOT=F60STOT+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
Q
;
SPECTOTL ; EP
D:LINES+3>MAXLINES HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
;
W ?73,$TR($J("",7)," ","-")
W !
;
W SPECTYPE
W ?9,SPECNAME," TOTALS"
W ?73,$J(F60STOT,7)
W !!
S LINES=LINES+3
;
S F61GTOT=F61GTOT+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))
S (F61STOT,F60STOT)=0
Q
;
F6160TOT ; EP
W ?73,$TR($J("",7)," ","-")
W !
W ?9,"TOPOGRAPHY (File 61) Totals"
W ?73,$J(F60GTOT,7)
W !
S LINES=LINES+2
Q
;
F6160PG ; EP
D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
;
JUSTSPEC ; EP
W SPECTYPE
W ?9,$E(SPECNAME,1,25)
; W ?31,$J($G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE)),7)
S:HEDONE="YES" PG=PG+1,LINES=7
Q
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
+2 ;;
+3 ;; Emulates the Lab accession and test counts Report, Part 4
+4 ;;
F6160RPT ; EP
+1 NEW LAB60IEN,L60DESC,SPECTYPE,SPECNAME
+2 NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
+3 NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
+4 NEW F60GTOT,F60STOT,F61GTOT,F61STOT
+5 ;
+6 IF $$F6160INV()="Q"
QUIT
+7 ;
+8 FOR
SET SPECTYPE=$ORDER(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))
IF SPECTYPE<1!(QFLG="Q")
QUIT
Begin DoDot:1
+9 DO SPECLINE
+10 FOR
SET LAB60IEN=$ORDER(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
IF LAB60IEN<1!(QFLG="Q")
QUIT
Begin DoDot:2
+11 DO L60LINE
End DoDot:2
+12 DO SPECTOTL
End DoDot:1
+13 ;
+14 IF QFLG="Q"
QUIT
+15 ;
+16 DO F6160TOT
+17 ;
+18 DO CLOSEIO^BLRLUAC9
+19 ;
+20 DO PRESSKEY^BLRGMENU(9)
+21 ;
+22 QUIT
+23 ;
F6160INV() ; EP - File 61 with File 60 detail report INitialization of Variables
+1 ; Set the ^TMP node
DO SETXTMPN^BLRLUAC1(.XTMPNODE)
+2 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+3 ;
+4 NEW DATERNGE,BADMSG,STR
+5 ;
+6 SET BADMSG="No Topography nor Laboratory Test File Data Found."
+7 IF $$GETXTMPV^BLRLUAC2("SPECSORT",.SELRAAAB,.LRSDT,.LRLDT,BADMSG)="Q"
QUIT "Q"
+8 ;
+9 SET DATERNGE="Date Range: "_$$FMTE^XLFDT(LRSDT,"5DZ")
+10 SET DATERNGE=DATERNGE_" thru "_$$FMTE^XLFDT(LRLDT,"5DZ")
+11 ;
+12 KILL HEADER
+13 SET HEADER(1)="Lab Accession and Test Counts"
+14 SET HEADER(2)=SELRAAAB_" Accession Area Counts Only"
+15 SET HEADER(3)=$$CJ^XLFSTR("Topography (# 61) & Laboratory Test (# 60) Report",IOM)
+16 SET HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
+17 ;
+18 SET MAXLINES=22
SET LINES=MAXLINES+10
SET PG=0
+19 SET QFLG="NO"
+20 ;
+21 SET HEADER(5)=" "
+22 SET HEADER(6)=$TRANSLATE($$CJ^XLFSTR("@TOPOGRAPHY@(File@61)@",38)," @","= ")
+23 SET $EXTRACT(HEADER(6),42)=$TRANSLATE($$CJ^XLFSTR("@LABORATORY@TEST@(File@60)@",39)," @","= ")
+24 SET HEADER(7)="IEN"
+25 SET $EXTRACT(HEADER(7),10)="Description"
+26 ; S $E(HEADER(7),32)="Count"
+27 SET $EXTRACT(HEADER(7),42)="IEN"
+28 SET $EXTRACT(HEADER(7),52)="Description"
+29 SET $EXTRACT(HEADER(7),74)="Count"
+30 ;
+31 SET (F60GTOT,F61GTOT,F61STOT,SPECTYPE)=0
+32 ;
+33 SET (HEDONE,QFLG)="NO"
+34 SET MAXLINES=22
SET LINES=MAXLINES+10
SET PG=0
+35 ;
+36 DO OPENIO^BLRLUAC9(.MAXLINES,.LINES)
+37 ;
+38 IF IOST["C-VT"
DO HEADONE2^BLRLUAC2(.HEDONE)
WRITE !
+39 ;
+40 QUIT "OK"
+41 ;
SPECLINE ; EP
+1 SET SPECNAME=$PIECE($GET(^LAB(61,SPECTYPE,0)),"^")
+2 IF LINES<(MAXLINES+1)
DO JUSTSPEC
+3 IF LINES>MAXLINES
DO F6160PG
IF QFLG="Q"
QUIT
+4 SET (F60STOT,LAB60IEN)=0
+5 QUIT
+6 ;
L60LINE ; EP
+1 IF LINES>MAXLINES&(HEDONE'="YES")
DO F6160PG
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,"SPECSORT",SPECTYPE,LAB60IEN)),7)
+8 WRITE !
+9 ;
+10 SET LINES=LINES+1
+11 SET F60GTOT=F60GTOT+$GET(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
+12 SET F60STOT=F60STOT+$GET(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE,LAB60IEN))
+13 QUIT
+14 ;
SPECTOTL ; EP
+1 IF LINES+3>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+2 ;
+3 WRITE ?73,$TRANSLATE($JUSTIFY("",7)," ","-")
+4 WRITE !
+5 ;
+6 WRITE SPECTYPE
+7 WRITE ?9,SPECNAME," TOTALS"
+8 WRITE ?73,$JUSTIFY(F60STOT,7)
+9 WRITE !!
+10 SET LINES=LINES+3
+11 ;
+12 SET F61GTOT=F61GTOT+$GET(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))
+13 SET (F61STOT,F60STOT)=0
+14 QUIT
+15 ;
F6160TOT ; EP
+1 WRITE ?73,$TRANSLATE($JUSTIFY("",7)," ","-")
+2 WRITE !
+3 WRITE ?9,"TOPOGRAPHY (File 61) Totals"
+4 WRITE ?73,$JUSTIFY(F60GTOT,7)
+5 WRITE !
+6 SET LINES=LINES+2
+7 QUIT
+8 ;
F6160PG ; EP
+1 DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+2 ;
JUSTSPEC ; EP
+1 WRITE SPECTYPE
+2 WRITE ?9,$EXTRACT(SPECNAME,1,25)
+3 ; W ?31,$J($G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE)),7)
+4 IF HEDONE="YES"
SET PG=PG+1
SET LINES=7
+5 QUIT
