WVLABLG1 ;HCIOFO/FT IHS/ANMC/MWR - DISPLAY LAB LOG; ;9/29/98 12:37
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR LAB LOG. CALLED BY WVLABLG.
;
DISPLAY ;EP
;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
;---> WVPRMT(1,Q)=PROMPTS FOR DIR.
;
N WVTITLE,WVTITLE1,N,Y S:WVB WVCONF=1
U IO
D
.I 'WVB S WVTITLE1="TOTALS" Q
.I WVC=1 S WVTITLE1="LISTED BY ACCESSION#" Q
.I WVC=2 S WVTITLE1="LISTED BY PATIENT" Q
.S WVTITLE="UNKNOWN REPORT"
S WVTITLE="* * * WOMEN'S HEALTH: LAB LOG "_WVTITLE1_" * * *"
D CENTERT^WVUTL5(.WVTITLE)
S WVSUBH="SUBHEAD^WVLABLG1"
D TOPHEAD^WVUTL7
S (WVPOP,N)=0
NOMATCH ;EP
;---> QUIT IF NO RECORDS MATCH.
I '$D(^TMP("WV",$J,1)) D Q
.D HEADER3^WVUTL7
.W !!?5,"No records match the selected criteria.",!
.I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
.D ^%ZISC S WVPOP=1
;
D:WVB DISPLAY1
I WVPOP 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 'WVB K WVSUBH D HEADER3^WVUTL7
D TOTALS,END
Q
;
;
DISPLAY1 ;EP
D HEADER3^WVUTL7
F S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP) D
.I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D
..S WVPAGE=WVPAGE+1
..D HEADER3^WVUTL7
.S Y=^TMP("WV",$J,2,N),M=N
.W !,$$SLDT2^WVUTL5($P(Y,U,3))
.W ?9,$P(Y,U,4)
.W ?21,$E($P(Y,U,2),1,18)
.W ?41,$P(Y,U)
.W ?53,$E($P(Y,U,8),1,10)
.W ?65,$E($P(Y,U,9),1,14)
.W !?9,"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 !?43,"Res/Diag: ",?53,$E($P(Y,U,12),1,26)
.W !,WVLINE
Q
;
TOTALS ;EP
N N,R S (N,R)=0
I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D
.S WVPAGE=WVPAGE+1 K WVSUBH
.D HEADER3^WVUTL7
;
F S N=$O(^TMP("WV",$J,2,N)) Q:'N D
.S M=N S:($P(^TMP("WV",$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 !,WVLINE
Q
;
END ;EP
I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3
D ^%ZISC
Q
;
SUBHEAD ;EP
;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
W !,"DATE",?9,"ACCESSION#",?21,"PATIENT"
W ?41,$$PNLB^WVUTL5(),?53,"LOCATION",?65,"PROVIDER",!
W $$REPEAT^XLFSTR("=",80)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVLABLG1 2589 printed Oct 16, 2024@18:47:34 Page 2
WVLABLG1 ;HCIOFO/FT IHS/ANMC/MWR - DISPLAY LAB LOG; ;9/29/98 12:37
+1 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; DISPLAY CODE FOR LAB LOG. CALLED BY WVLABLG.
+4 ;
DISPLAY ;EP
+1 ;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
+2 ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
+3 ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
+4 ;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
+5 ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
+6 ;---> WVPRMT(1,Q)=PROMPTS FOR DIR.
+7 ;
+8 NEW WVTITLE,WVTITLE1,N,Y
if WVB
SET WVCONF=1
+9 USE IO
+10 Begin DoDot:1
+11 IF 'WVB
SET WVTITLE1="TOTALS"
QUIT
+12 IF WVC=1
SET WVTITLE1="LISTED BY ACCESSION#"
QUIT
+13 IF WVC=2
SET WVTITLE1="LISTED BY PATIENT"
QUIT
+14 SET WVTITLE="UNKNOWN REPORT"
End DoDot:1
+15 SET WVTITLE="* * * WOMEN'S HEALTH: LAB LOG "_WVTITLE1_" * * *"
+16 DO CENTERT^WVUTL5(.WVTITLE)
+17 SET WVSUBH="SUBHEAD^WVLABLG1"
+18 DO TOPHEAD^WVUTL7
+19 SET (WVPOP,N)=0
NOMATCH ;EP
+1 ;---> QUIT IF NO RECORDS MATCH.
+2 IF '$DATA(^TMP("WV",$JOB,1))
Begin DoDot:1
+3 DO HEADER3^WVUTL7
+4 WRITE !!?5,"No records match the selected criteria.",!
+5 IF WVCRT&('$DATA(IO("S")))
DO DIRZ^WVUTL3
WRITE @IOF
+6 DO ^%ZISC
SET WVPOP=1
End DoDot:1
QUIT
+7 ;
+8 if WVB
DO DISPLAY1
+9 IF WVPOP
Begin DoDot:1
+10 WRITE !?5,"Because you have entered ^, the remainder of the individual"
+11 WRITE !?5,"procedures will not be displayed. The totals that follow,"
+12 WRITE !?5,"however, are accurate for the selected date range."
End DoDot:1
+13 IF 'WVB
KILL WVSUBH
DO HEADER3^WVUTL7
+14 DO TOTALS
DO END
+15 QUIT
+16 ;
+17 ;
DISPLAY1 ;EP
+1 DO HEADER3^WVUTL7
+2 FOR
SET N=$ORDER(^TMP("WV",$JOB,2,N))
if 'N!(WVPOP)
QUIT
Begin DoDot:1
+3 IF $Y+6>IOSL
if WVCRT
DO DIRZ^WVUTL3
if WVPOP
QUIT
Begin DoDot:2
+4 SET WVPAGE=WVPAGE+1
+5 DO HEADER3^WVUTL7
End DoDot:2
+6 SET Y=^TMP("WV",$JOB,2,N)
SET M=N
+7 WRITE !,$$SLDT2^WVUTL5($PIECE(Y,U,3))
+8 WRITE ?9,$PIECE(Y,U,4)
+9 WRITE ?21,$EXTRACT($PIECE(Y,U,2),1,18)
+10 WRITE ?41,$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 !?9,"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 !?43,"Res/Diag: ",?53,$EXTRACT($PIECE(Y,U,12),1,26)
+16 WRITE !,WVLINE
End DoDot:1
+17 QUIT
+18 ;
TOTALS ;EP
+1 NEW N,R
SET (N,R)=0
+2 IF $Y+6>IOSL
if WVCRT
DO DIRZ^WVUTL3
if WVPOP
QUIT
Begin DoDot:1
+3 SET WVPAGE=WVPAGE+1
KILL WVSUBH
+4 DO HEADER3^WVUTL7
End DoDot:1
+5 ;
+6 FOR
SET N=$ORDER(^TMP("WV",$JOB,2,N))
if 'N
QUIT
Begin DoDot:1
+7 SET M=N
if ($PIECE(^TMP("WV",$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 !,WVLINE
+12 QUIT
+13 ;
END ;EP
+1 IF WVCRT&('$DATA(IO("S")))&('WVPOP)
DO DIRZ^WVUTL3
+2 DO ^%ZISC
+3 QUIT
+4 ;
SUBHEAD ;EP
+1 ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
+2 WRITE !,"DATE",?9,"ACCESSION#",?21,"PATIENT"
+3 WRITE ?41,$$PNLB^WVUTL5(),?53,"LOCATION",?65,"PROVIDER",!
+4 WRITE $$REPEAT^XLFSTR("=",80)
+5 QUIT
