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
