BLRLUAC3 ; IHS/OIT/MKK - IHS LRUPAC 3, files 44 & 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 5
;;
F4460RPT ; EP
NEW F44DESC,F44IEN,LAB60IEN,L60DESC
NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
NEW F44GTOT,F44STOT,F60GTOT
;
Q:$$F4460INV()="Q"
;
F S F44IEN=$O(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN)) Q:F44IEN<1!(QFLG="Q") D
. D F44LINE
. F S LAB60IEN=$O(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN)) Q:LAB60IEN<1!(QFLG="Q") D
.. D F4460LNE
. D F44SUBLN
;
I QFLG="Q" D ^%ZISC Q
;
D F4460TOT
;
D ^%ZISC
;
D PRESSKEY^BLRGMENU(9)
;
Q
;
F4460INV() ; 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 Location 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("Hospital Location (# 44) & Laboratory Test (# 60) Report",IOM)
S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)
;
S MAXLINES=22,LINES=MAXLINES+10,PG=0,(HEDONE,QFLG)="NO"
;
D OPENIO^BLRLUAC9(.MAXLINES,.LINES)
;
I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE) W !
;
S HEADER(5)=" "
S HEADER(6)=$TR($$CJ^XLFSTR("@HOSPITAL@LOCATION@(File@44)@",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 (F44GTOT,F44STOT,F60GTOT,F44IEN)=0
;
Q "OK"
;
F44LINE ; EP
S F44DESC=$P($G(^SC(F44IEN,0)),"^")
I LINES<(MAXLINES+1) D JUSTSPEC
I LINES>MAXLINES D F4460PG Q:QFLG="Q"
S LAB60IEN=0
Q
;
F4460LNE ; EP
I LINES>MAXLINES&(HEDONE'="YES") D F4460PG 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,"LOCSORT",F44IEN,LAB60IEN)),7)
W !
;
S LINES=LINES+1
S F44STOT=F44STOT+$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN))
S F60GTOT=F60GTOT+$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN))
Q
;
F44SUBLN ; EP - F44 Sub total line
W ?73,$TR($J("",7)," ","-"),!
W ?9,F44DESC," TOTAL",?73,$J(F44STOT,7),!!
S LINES=LINES+3
S F44GTOT=F44GTOT+$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN))
S F44STOT=0
Q
;
F4460TOT ; EP
; W ?31,$TR($J("",7)," ","-")
W ?73,$TR($J("",7)," ","-")
W !
W ?9,"HOSPITAL LOCATION (File 44) TOTALS"
; W ?31,F44GTOT
W ?73,$J(F60GTOT,7)
W !
Q
;
F4460PG ; EP
D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE) Q:QFLG="Q"
;
JUSTSPEC ; EP
W F44IEN
W ?9,$E(F44DESC,1,18)
; W ?31,$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN))
S:HEDONE="YES" PG=PG+1,LINES=7
Q
BLRLUAC3 ; IHS/OIT/MKK - IHS LRUPAC 3, files 44 & 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 5
+4 ;;
F4460RPT ; EP
+1 NEW F44DESC,F44IEN,LAB60IEN,L60DESC
+2 NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
+3 NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
+4 NEW F44GTOT,F44STOT,F60GTOT
+5 ;
+6 IF $$F4460INV()="Q"
QUIT
+7 ;
+8 FOR
SET F44IEN=$ORDER(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN))
IF F44IEN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+9 DO F44LINE
+10 FOR
SET LAB60IEN=$ORDER(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN))
IF LAB60IEN<1!(QFLG="Q")
QUIT
Begin DoDot:2
+11 DO F4460LNE
End DoDot:2
+12 DO F44SUBLN
End DoDot:1
+13 ;
+14 IF QFLG="Q"
DO ^%ZISC
QUIT
+15 ;
+16 DO F4460TOT
+17 ;
+18 DO ^%ZISC
+19 ;
+20 DO PRESSKEY^BLRGMENU(9)
+21 ;
+22 QUIT
+23 ;
F4460INV() ; 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 Location 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("Hospital Location (# 44) & 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 (HEDONE,QFLG)="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("@HOSPITAL@LOCATION@(File@44)@",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 (F44GTOT,F44STOT,F60GTOT,F44IEN)=0
+35 ;
+36 QUIT "OK"
+37 ;
F44LINE ; EP
+1 SET F44DESC=$PIECE($GET(^SC(F44IEN,0)),"^")
+2 IF LINES<(MAXLINES+1)
DO JUSTSPEC
+3 IF LINES>MAXLINES
DO F4460PG
IF QFLG="Q"
QUIT
+4 SET LAB60IEN=0
+5 QUIT
+6 ;
F4460LNE ; EP
+1 IF LINES>MAXLINES&(HEDONE'="YES")
DO F4460PG
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,"LOCSORT",F44IEN,LAB60IEN)),7)
+8 WRITE !
+9 ;
+10 SET LINES=LINES+1
+11 SET F44STOT=F44STOT+$GET(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN))
+12 SET F60GTOT=F60GTOT+$GET(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN,LAB60IEN))
+13 QUIT
+14 ;
F44SUBLN ; EP - F44 Sub total line
+1 WRITE ?73,$TRANSLATE($JUSTIFY("",7)," ","-"),!
+2 WRITE ?9,F44DESC," TOTAL",?73,$JUSTIFY(F44STOT,7),!!
+3 SET LINES=LINES+3
+4 SET F44GTOT=F44GTOT+$GET(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN))
+5 SET F44STOT=0
+6 QUIT
+7 ;
F4460TOT ; EP
+1 ; W ?31,$TR($J("",7)," ","-")
+2 WRITE ?73,$TRANSLATE($JUSTIFY("",7)," ","-")
+3 WRITE !
+4 WRITE ?9,"HOSPITAL LOCATION (File 44) TOTALS"
+5 ; W ?31,F44GTOT
+6 WRITE ?73,$JUSTIFY(F60GTOT,7)
+7 WRITE !
+8 QUIT
+9 ;
F4460PG ; EP
+1 DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)
IF QFLG="Q"
QUIT
+2 ;
JUSTSPEC ; EP
+1 WRITE F44IEN
+2 WRITE ?9,$EXTRACT(F44DESC,1,18)
+3 ; W ?31,$G(^BLRLUPAC(DATETIME,"LOCSORT",F44IEN))
+4 IF HEDONE="YES"
SET PG=PG+1
SET LINES=7
+5 QUIT
