BLRLUAC7 ; IHS/OIT/MKK - IHS LRUPAC 7, file 4 & 60 report ; [ 05/15/11 7:50 AM ]
;;5.2;LR;**1030**;NOV 01, 1997
;;
;; Emulates the Lab accession and test counts Report, Part 5
;;
FILE4RPT ; EP - Institution File Counts
NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
NEW F4GTOT,LAB4IEN,L4DESC
NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
;
Q:$$F4INITV()="Q"
;
F S LAB4IEN=$O(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN)) Q:LAB4IEN<1!(QFLG="Q") D
. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
. ;
. S L4DESC=$$TRIM^XLFSTR($P($G(^DIC(4,LAB4IEN,0)),"^"),"LR"," ")
. W ?4,LAB4IEN
. W ?14,L4DESC
. W ?64,$J($FN($G(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN)),","),11)
. W !
. S LINES=LINES+1
. S F4GTOT=F4GTOT+$G(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN))
;
D TOTALS^BLRLUAC2(F4GTOT)
;
D ^%ZISC
;
Q:QFLG="Q"
D PRESSKEY^BLRGMENU(9)
;
Q
;
F4INITV() ; EP - File 4 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 Institution File Data Found."
Q:$$GETXTMPV^BLRLUAC2("SITESORT",.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("Institution File (# 4) Sort",IOM)
S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
;
S MAXLINES=22,LINES=MAXLINES+10,PG=0,(QFLG,HEDONE)="NO"
;
D OPENIO^BLRLUAC9(.MAXLINES,.LINES)
;
I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE) W !
;
S QFLG="NO"
;
S HEADER(5)=" "
S $E(HEADER(6),5)="IEN"
S $E(HEADER(6),15)="Description"
S $E(HEADER(6),65)=$J("Count",11)
;
S (F4GTOT,LAB4IEN)=0
;
Q "OK"
;
F460REPT ; EP
NEW F4DESC,F4IEN,LAB60IEN,L60DESC
NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
NEW F4GTOT,F4STOT,F60GTOT
;
Q:$$F460INIV()="Q"
;
F S F4IEN=$O(^BLRLUPAC(DATETIME,"SITESORT",F4IEN)) Q:F4IEN<1!(QFLG="Q") D
. D F4LINE
. F S LAB60IEN=$O(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN)) Q:LAB60IEN<1!(QFLG="Q") D
.. D F460LINE
. D F460SUB
;
I QFLG="Q" D ^%ZISC Q
;
D F460TOT
;
D ^%ZISC
;
D PRESSKEY^BLRGMENU(9)
;
Q
;
F460INIV() ; 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 Institution 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("Institution (# 4) & Laboratory Test (# 60) Report",IOM)
S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
;
S MAXLINES=22,LINES=MAXLINES+10,PG=0,(QFLG,HEDONE)="NO"
;
D OPENIO^BLRLUAC9(.MAXLINES,.LINES)
;
I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE) W !
;
S HEADER(5)=" "
S HEADER(6)=$TR($$CJ^XLFSTR("@INSTITUTION@(File@4)@",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 (F4GTOT,F4STOT,F60GTOT,F4IEN)=0
;
Q "OK"
;
F4LINE ; EP
S F4DESC=$P($G(^DIC(4,F4IEN,0)),"^")
I LINES<(MAXLINES+1) D JUSTSPEC
I LINES>MAXLINES D F460PG Q:QFLG="Q"
S LAB60IEN=0
Q
;
F460LINE ; EP
I LINES>MAXLINES&(HEDONE'="YES") D F460PG 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,"SITESORT",F4IEN,LAB60IEN)),7)
W !
;
S LINES=LINES+1
S F60GTOT=F60GTOT+$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))
S F4STOT=F4STOT+$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))
Q
;
F460SUB ; EP - Subtotal
W ?73,$TR($J("",7)," ","-"),!
W ?9,F4DESC," TOTAL",?73,$J(F4STOT,7),!!
S LINES=LINES+3
S F4GTOT=F4GTOT+$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))
S F4STOT=0
Q
;
F460TOT ; EP
; W ?31,$TR($J("",7)," ","-")
W ?73,$TR($J("",7)," ","-")
W !
W ?9,"TOTALS"
; W ?31,F4GTOT
W ?73,$J(F60GTOT,7)
W !
Q
;
F460PG ; EP
D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
;
JUSTSPEC ; EP
W F4IEN
W ?9,$E(F4DESC,1,18)
; W ?31,$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))
S:HEDONE="YES" PG=PG+1,LINES=7
Q
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
+2 ;;
+3 ;; Emulates the Lab accession and test counts Report, Part 5
+4 ;;
FILE4RPT ; EP - Institution File Counts
+1 NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
+2 NEW F4GTOT,LAB4IEN,L4DESC
+3 NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
+4 ;
+5 IF $$F4INITV()="Q"
QUIT
+6 ;
+7 FOR
SET LAB4IEN=$ORDER(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN))
IF LAB4IEN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+8 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+9 ;
+10 SET L4DESC=$$TRIM^XLFSTR($PIECE($GET(^DIC(4,LAB4IEN,0)),"^"),"LR"," ")
+11 WRITE ?4,LAB4IEN
+12 WRITE ?14,L4DESC
+13 WRITE ?64,$JUSTIFY($FNUMBER($GET(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN)),","),11)
+14 WRITE !
+15 SET LINES=LINES+1
+16 SET F4GTOT=F4GTOT+$GET(^BLRLUPAC(DATETIME,"SITESORT",LAB4IEN))
End DoDot:1
+17 ;
+18 DO TOTALS^BLRLUAC2(F4GTOT)
+19 ;
+20 DO ^%ZISC
+21 ;
+22 IF QFLG="Q"
QUIT
+23 DO PRESSKEY^BLRGMENU(9)
+24 ;
+25 QUIT
+26 ;
F4INITV() ; EP - File 4 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 Institution File Data Found."
+7 IF $$GETXTMPV^BLRLUAC2("SITESORT",.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("Institution File (# 4) Sort",IOM)
+16 SET HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
+17 ;
+18 SET MAXLINES=22
SET LINES=MAXLINES+10
SET PG=0
SET (QFLG,HEDONE)="NO"
+19 ;
+20 DO OPENIO^BLRLUAC9(.MAXLINES,.LINES)
+21 ;
+22 IF IOST["C-VT"
DO HEADONE2^BLRLUAC2(.HEDONE)
WRITE !
+23 ;
+24 SET QFLG="NO"
+25 ;
+26 SET HEADER(5)=" "
+27 SET $EXTRACT(HEADER(6),5)="IEN"
+28 SET $EXTRACT(HEADER(6),15)="Description"
+29 SET $EXTRACT(HEADER(6),65)=$JUSTIFY("Count",11)
+30 ;
+31 SET (F4GTOT,LAB4IEN)=0
+32 ;
+33 QUIT "OK"
+34 ;
F460REPT ; EP
+1 NEW F4DESC,F4IEN,LAB60IEN,L60DESC
+2 NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
+3 NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
+4 NEW F4GTOT,F4STOT,F60GTOT
+5 ;
+6 IF $$F460INIV()="Q"
QUIT
+7 ;
+8 FOR
SET F4IEN=$ORDER(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))
IF F4IEN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+9 DO F4LINE
+10 FOR
SET LAB60IEN=$ORDER(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))
IF LAB60IEN<1!(QFLG="Q")
QUIT
Begin DoDot:2
+11 DO F460LINE
End DoDot:2
+12 DO F460SUB
End DoDot:1
+13 ;
+14 IF QFLG="Q"
DO ^%ZISC
QUIT
+15 ;
+16 DO F460TOT
+17 ;
+18 DO ^%ZISC
+19 ;
+20 DO PRESSKEY^BLRGMENU(9)
+21 ;
+22 QUIT
+23 ;
F460INIV() ; 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 Institution 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("Institution (# 4) & 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
SET (QFLG,HEDONE)="NO"
+19 ;
+20 DO OPENIO^BLRLUAC9(.MAXLINES,.LINES)
+21 ;
+22 IF IOST["C-VT"
DO HEADONE2^BLRLUAC2(.HEDONE)
WRITE !
+23 ;
+24 SET HEADER(5)=" "
+25 SET HEADER(6)=$TRANSLATE($$CJ^XLFSTR("@INSTITUTION@(File@4)@",38)," @","= ")
+26 SET $EXTRACT(HEADER(6),42)=$TRANSLATE($$CJ^XLFSTR("@LABORATORY@TEST@(File@60)@",39)," @","= ")
+27 SET HEADER(7)="IEN"
+28 SET $EXTRACT(HEADER(7),10)="Description"
+29 ; S $E(HEADER(7),32)="Count"
+30 SET $EXTRACT(HEADER(7),42)="IEN"
+31 SET $EXTRACT(HEADER(7),52)="Description"
+32 SET $EXTRACT(HEADER(7),74)="Count"
+33 ;
+34 SET (F4GTOT,F4STOT,F60GTOT,F4IEN)=0
+35 ;
+36 QUIT "OK"
+37 ;
F4LINE ; EP
+1 SET F4DESC=$PIECE($GET(^DIC(4,F4IEN,0)),"^")
+2 IF LINES<(MAXLINES+1)
DO JUSTSPEC
+3 IF LINES>MAXLINES
DO F460PG
IF QFLG="Q"
QUIT
+4 SET LAB60IEN=0
+5 QUIT
+6 ;
F460LINE ; EP
+1 IF LINES>MAXLINES&(HEDONE'="YES")
DO F460PG
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,"SITESORT",F4IEN,LAB60IEN)),7)
+8 WRITE !
+9 ;
+10 SET LINES=LINES+1
+11 SET F60GTOT=F60GTOT+$GET(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))
+12 SET F4STOT=F4STOT+$GET(^BLRLUPAC(DATETIME,"SITESORT",F4IEN,LAB60IEN))
+13 QUIT
+14 ;
F460SUB ; EP - Subtotal
+1 WRITE ?73,$TRANSLATE($JUSTIFY("",7)," ","-"),!
+2 WRITE ?9,F4DESC," TOTAL",?73,$JUSTIFY(F4STOT,7),!!
+3 SET LINES=LINES+3
+4 SET F4GTOT=F4GTOT+$GET(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))
+5 SET F4STOT=0
+6 QUIT
+7 ;
F460TOT ; EP
+1 ; W ?31,$TR($J("",7)," ","-")
+2 WRITE ?73,$TRANSLATE($JUSTIFY("",7)," ","-")
+3 WRITE !
+4 WRITE ?9,"TOTALS"
+5 ; W ?31,F4GTOT
+6 WRITE ?73,$JUSTIFY(F60GTOT,7)
+7 WRITE !
+8 QUIT
+9 ;
F460PG ; EP
+1 DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+2 ;
JUSTSPEC ; EP
+1 WRITE F4IEN
+2 WRITE ?9,$EXTRACT(F4DESC,1,18)
+3 ; W ?31,$G(^BLRLUPAC(DATETIME,"SITESORT",F4IEN))
+4 IF HEDONE="YES"
SET PG=PG+1
SET LINES=7
+5 QUIT
