BWLABLG1.m

BWLABLG1 ;IHS/ANMC/MWR - DISPLAY LAB LOG;15-Feb-2003 21:55;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  DISPLAY CODE FOR LAB LOG.  CALLED BY BWLABLG.

 ;

DISPLAY ;EP

 ;---> BWCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.

 ;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.

 ;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).

 ;---> BWCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).

 ;---> BWCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).

 ;---> BWPRMT(1,Q)=PROMPTS FOR DIR.

 ;

 N BWTITLE,BWTITLE1,N,Y S:BWB BWCONF=1

 U IO

 D

 .I 'BWB S BWTITLE1="TOTALS" Q

 .I BWC=1 S BWTITLE1="LISTED BY ACCESSION#" Q

 .I BWC=2 S BWTITLE1="LISTED BY PATIENT" Q

 .S BWTITLE="UNKNOWN REPORT"

 S BWTITLE="* * *  WOMEN'S HEALTH: LAB LOG "_BWTITLE1_"  * * *"

 D CENTERT^BWUTL5(.BWTITLE)

 S BWSUBH="SUBHEAD^BWLABLG1"

 D TOPHEAD^BWUTL7

 S (BWPOP,N)=0

NOMATCH ;EP

 ;---> QUIT IF NO RECORDS MATCH.

 I '$D(^TMP("BW",$J,1)) D  Q

 .D HEADER3^BWUTL7

 .W !!?5,"No records match the selected criteria.",!

 .D:BWCRT DIRZ^BWUTL3 W @IOF D ^%ZISC S BWPOP=1

 ;

 D:BWB DISPLAY1

 I BWPOP D

 .W !?5,"Because you have entered ^, the remainder of the individual"

 .W !?5,"procedures will not be displayed.  The totals that follow,"

 .W !?5,"however, are accurate for the selected date range."

 I 'BWB K BWSUBH D HEADER3^BWUTL7

 D TOTALS,END

 Q

 ;

 ;

DISPLAY1 ;EP

 D HEADER3^BWUTL7

 F  S N=$O(^TMP("BW",$J,2,N)) Q:'N!(BWPOP)  D

 .I $Y+6>IOSL D:BWCRT DIRZ^BWUTL3 Q:BWPOP  D

 ..S BWPAGE=BWPAGE+1

 ..D HEADER3^BWUTL7

 .S Y=^TMP("BW",$J,2,N),M=N

 .W !,$$SLDT2^BWUTL5($P(Y,U,3))

 .W ?10,$P(Y,U,4)

 .W ?23,$E($P(Y,U,2),1,18)

 .W ?43,$P(Y,U)

 .W ?53,$E($P(Y,U,8),1,10)

 .W ?65,$E($P(Y,U,9),1,14)

 .W !?10,"Date of ",$E($P(Y,U,5),1,23),": ",$P(Y,U,7)

 .W ?53,"Entered by: ",$E($P(Y,U,10),1,14)

 .W !?10,"Results: "

 .W $S($P(Y,U,6):"RECEIVED, "_$P(Y,U,11),1:"NOT RECEIVED")

 .W ?43,"Res/Diag: ",?53,$E($P(Y,U,12),1,26)

 .W !,BWLINE

 Q

 ;

TOTALS ;EP

 N N,R S (N,R)=0

 I $Y+6>IOSL D:BWCRT DIRZ^BWUTL3 Q:BWPOP  D

 .S BWPAGE=BWPAGE+1 K BWSUBH

 .D HEADER3^BWUTL7

 ;

 F  S N=$O(^TMP("BW",$J,2,N)) Q:'N  D

 .S M=N S:($P(^TMP("BW",$J,2,N),U,12)="NOT ENTERED") R=R+1

 W !?4,"*"

 W ?10,"TOTAL PROCEDURES: ",M,?37,"PROCEDURES WITHOUT RESULTS: ",R

 W ?75,"*"

 W !,BWLINE

 Q

 ;

END ;EP

 W:'BWCRT @IOF

 I BWCRT&('$D(IO("S")))&('BWPOP) D DIRZ^BWUTL3

 D ^%ZISC

 Q

 ;

SUBHEAD ;EP

 ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.

 W !,"DATE",?10,"ACCESSION#",?23,"PATIENT"

 W ?43,$$PNLB^BWUTL5(DUZ(2)),?53,"LOCATION",?65,"PROVIDER",!

 F I=1:1:80 W "="

 Q

BWLABLG1  ;IHS/ANMC/MWR - DISPLAY LAB LOG;15-Feb-2003 21:55;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  DISPLAY CODE FOR LAB LOG.  CALLED BY BWLABLG.

 +4       ;

DISPLAY   ;EP

 +1       ;---> BWCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.

 +2       ;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.

 +3       ;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).

 +4       ;---> BWCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).

 +5       ;---> BWCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).

 +6       ;---> BWPRMT(1,Q)=PROMPTS FOR DIR.

 +7       ;

 +8        NEW BWTITLE,BWTITLE1,N,Y

           IF BWB

               SET BWCONF=1

 +9        USE IO

 +10       Begin DoDot:1

 +11           IF 'BWB

                   SET BWTITLE1="TOTALS"

                   QUIT 

 +12           IF BWC=1

                   SET BWTITLE1="LISTED BY ACCESSION#"

                   QUIT 

 +13           IF BWC=2

                   SET BWTITLE1="LISTED BY PATIENT"

                   QUIT 

 +14           SET BWTITLE="UNKNOWN REPORT"

           End DoDot:1

 +15       SET BWTITLE="* * *  WOMEN'S HEALTH: LAB LOG "_BWTITLE1_"  * * *"

 +16       DO CENTERT^BWUTL5(.BWTITLE)

 +17       SET BWSUBH="SUBHEAD^BWLABLG1"

 +18       DO TOPHEAD^BWUTL7

 +19       SET (BWPOP,N)=0

NOMATCH   ;EP

 +1       ;---> QUIT IF NO RECORDS MATCH.

 +2        IF '$DATA(^TMP("BW",$JOB,1))

               Begin DoDot:1

 +3                DO HEADER3^BWUTL7

 +4                WRITE !!?5,"No records match the selected criteria.",!

 +5                IF BWCRT

                       DO DIRZ^BWUTL3

                   WRITE @IOF

                   DO ^%ZISC

                   SET BWPOP=1

               End DoDot:1

               QUIT 

 +6       ;

 +7        IF BWB

               DO DISPLAY1

 +8        IF BWPOP

               Begin DoDot:1

 +9                WRITE !?5,"Because you have entered ^, the remainder of the individual"

 +10               WRITE !?5,"procedures will not be displayed.  The totals that follow,"

 +11               WRITE !?5,"however, are accurate for the selected date range."

               End DoDot:1

 +12       IF 'BWB

               KILL BWSUBH

               DO HEADER3^BWUTL7

 +13       DO TOTALS

           DO END

 +14       QUIT 

 +15      ;

 +16      ;

DISPLAY1  ;EP

 +1        DO HEADER3^BWUTL7

 +2        FOR 

               SET N=$ORDER(^TMP("BW",$JOB,2,N))

               IF 'N!(BWPOP)

                   QUIT 

               Begin DoDot:1

 +3                IF $Y+6>IOSL

                       IF BWCRT

                           DO DIRZ^BWUTL3

                       IF BWPOP

                           QUIT 

                       Begin DoDot:2

 +4                        SET BWPAGE=BWPAGE+1

 +5                        DO HEADER3^BWUTL7

                       End DoDot:2

 +6                SET Y=^TMP("BW",$JOB,2,N)

                   SET M=N

 +7                WRITE !,$$SLDT2^BWUTL5($PIECE(Y,U,3))

 +8                WRITE ?10,$PIECE(Y,U,4)

 +9                WRITE ?23,$EXTRACT($PIECE(Y,U,2),1,18)

 +10               WRITE ?43,$PIECE(Y,U)

 +11               WRITE ?53,$EXTRACT($PIECE(Y,U,8),1,10)

 +12               WRITE ?65,$EXTRACT($PIECE(Y,U,9),1,14)

 +13               WRITE !?10,"Date of ",$EXTRACT($PIECE(Y,U,5),1,23),": ",$PIECE(Y,U,7)

 +14               WRITE ?53,"Entered by: ",$EXTRACT($PIECE(Y,U,10),1,14)

 +15               WRITE !?10,"Results: "

 +16               WRITE $SELECT($PIECE(Y,U,6):"RECEIVED, "_$PIECE(Y,U,11),1:"NOT RECEIVED")

 +17               WRITE ?43,"Res/Diag: ",?53,$EXTRACT($PIECE(Y,U,12),1,26)

 +18               WRITE !,BWLINE

               End DoDot:1

 +19       QUIT 

 +20      ;

TOTALS    ;EP

 +1        NEW N,R

           SET (N,R)=0

 +2        IF $Y+6>IOSL

               IF BWCRT

                   DO DIRZ^BWUTL3

               IF BWPOP

                   QUIT 

               Begin DoDot:1

 +3                SET BWPAGE=BWPAGE+1

                   KILL BWSUBH

 +4                DO HEADER3^BWUTL7

               End DoDot:1

 +5       ;

 +6        FOR 

               SET N=$ORDER(^TMP("BW",$JOB,2,N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +7                SET M=N

                   IF ($PIECE(^TMP("BW",$JOB,2,N),U,12)="NOT ENTERED")

                       SET R=R+1

               End DoDot:1

 +8        WRITE !?4,"*"

 +9        WRITE ?10,"TOTAL PROCEDURES: ",M,?37,"PROCEDURES WITHOUT RESULTS: ",R

 +10       WRITE ?75,"*"

 +11       WRITE !,BWLINE

 +12       QUIT 

 +13      ;

END       ;EP

 +1        IF 'BWCRT

               WRITE @IOF

 +2        IF BWCRT&('$DATA(IO("S")))&('BWPOP)

               DO DIRZ^BWUTL3

 +3        DO ^%ZISC

 +4        QUIT 

 +5       ;

SUBHEAD   ;EP

 +1       ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.

 +2        WRITE !,"DATE",?10,"ACCESSION#",?23,"PATIENT"

 +3        WRITE ?43,$$PNLB^BWUTL5(DUZ(2)),?53,"LOCATION",?65,"PROVIDER",!

 +4        FOR I=1:1:80

               WRITE "="

 +5        QUIT