BLRLUAC6.m

BLRLUAC6 ; IHS/OIT/MKK - IHS LRUPAC 6, file 61 report ; [ 05/15/11  7:50 AM ]

 ;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997

 ;;

 ;; Emulates the Lab accession and test counts Report, Part 3

 ;;

F61REPT ; EP - File 61 (Topography File) REPorT

 NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE

 NEW F61GTOT,SPECTYPE,SPECNAME

 NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE

 ;

 Q:$$F61INITV()="Q"

 ;

 S (F61GTOT,SPECTYPE)=0

 F  S SPECTYPE=$O(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))  Q:SPECTYPE<1!(QFLG="Q")  D

 . I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)  Q:QFLG="Q"

 . ;

 . S SPECNAME=$P($G(^LAB(61,SPECTYPE,0)),"^")

 . W ?4,SPECTYPE

 . W ?14,SPECNAME

 . W ?64,$J($FN(+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE)),","),11)

 . W !

 . S LINES=LINES+1

 . S F61GTOT=F61GTOT+$G(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))

 ;

 D TOTALS^BLRLUAC2(F61GTOT)

 ;

 D ^%ZISC

 ;

 Q:QFLG="Q"

 ;

 D PRESSKEY^BLRGMENU(9)

 ;

 Q

 ;

F61INITV() ; EP - File 61 report's 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 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 File (# 61) Report",IOM)

 S HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)

 ;

 S MAXLINES=21,LINES=MAXLINES+10,PG=0,(QFLG,HEDONE)="NO"

 ;

 S HEADER(5)=" "

 S $E(HEADER(6),5)="IEN"

 S $E(HEADER(6),15)="Description"

 S $E(HEADER(6),65)=$J("Count",11)

 ;

 D OPENIO^BLRLUAC9(.MAXLINES,.LINES)

 ;

 I IOST["C-VT" D HEADONE2^BLRLUAC2(.HEDONE)  W !

 ;

 Q "OK"

BLRLUAC6  ; IHS/OIT/MKK - IHS LRUPAC 6, file 61 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 3

 +4       ;;

F61REPT   ; EP - File 61 (Topography File) REPorT

 +1        NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE

 +2        NEW F61GTOT,SPECTYPE,SPECNAME

 +3        NEW BLRVERN,HEADER,LINES,MAXLINES,PG,QFLG,HEDONE

 +4       ;

 +5        IF $$F61INITV()="Q"

               QUIT 

 +6       ;

 +7        SET (F61GTOT,SPECTYPE)=0

 +8        FOR 

               SET SPECTYPE=$ORDER(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))

               IF SPECTYPE<1!(QFLG="Q")

                   QUIT 

               Begin DoDot:1

 +9                IF LINES>MAXLINES

                       DO HEADERPG^BLRGMENU(.PG,.QFLG,HEDONE)

                       IF QFLG="Q"

                           QUIT 

 +10      ;

 +11               SET SPECNAME=$PIECE($GET(^LAB(61,SPECTYPE,0)),"^")

 +12               WRITE ?4,SPECTYPE

 +13               WRITE ?14,SPECNAME

 +14               WRITE ?64,$JUSTIFY($FNUMBER(+$GET(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE)),","),11)

 +15               WRITE !

 +16               SET LINES=LINES+1

 +17               SET F61GTOT=F61GTOT+$GET(^BLRLUPAC(DATETIME,"SPECSORT",SPECTYPE))

               End DoDot:1

 +18      ;

 +19       DO TOTALS^BLRLUAC2(F61GTOT)

 +20      ;

 +21       DO ^%ZISC

 +22      ;

 +23       IF QFLG="Q"

               QUIT 

 +24      ;

 +25       DO PRESSKEY^BLRGMENU(9)

 +26      ;

 +27       QUIT 

 +28      ;

F61INITV() ; EP - File 61 report's 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 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 File (# 61) Report",IOM)

 +16       SET HEADER(4)=$$CJ^XLFSTR(DATERNGE,IOM)

 +17      ;

 +18       SET MAXLINES=21

           SET LINES=MAXLINES+10

           SET PG=0

           SET (QFLG,HEDONE)="NO"

 +19      ;

 +20       SET HEADER(5)=" "

 +21       SET $EXTRACT(HEADER(6),5)="IEN"

 +22       SET $EXTRACT(HEADER(6),15)="Description"

 +23       SET $EXTRACT(HEADER(6),65)=$JUSTIFY("Count",11)

 +24      ;

 +25       DO OPENIO^BLRLUAC9(.MAXLINES,.LINES)

 +26      ;

 +27       IF IOST["C-VT"

               DO HEADONE2^BLRLUAC2(.HEDONE)

               WRITE !

 +28      ;

 +29       QUIT "OK"