| 1 | WVLABLG1 ;HCIOFO/FT IHS/ANMC/MWR - DISPLAY LAB LOG; ;9/29/98  12:37
 | 
|---|
| 2 |  ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
 | 
|---|
| 3 |  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 | 
|---|
| 4 |  ;;  DISPLAY CODE FOR LAB LOG.  CALLED BY WVLABLG.
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 | DISPLAY ;EP
 | 
|---|
| 7 |  ;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
 | 
|---|
| 8 |  ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
 | 
|---|
| 9 |  ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
 | 
|---|
| 10 |  ;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
 | 
|---|
| 11 |  ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
 | 
|---|
| 12 |  ;---> WVPRMT(1,Q)=PROMPTS FOR DIR.
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  N WVTITLE,WVTITLE1,N,Y S:WVB WVCONF=1
 | 
|---|
| 15 |  U IO
 | 
|---|
| 16 |  D
 | 
|---|
| 17 |  .I 'WVB S WVTITLE1="TOTALS" Q
 | 
|---|
| 18 |  .I WVC=1 S WVTITLE1="LISTED BY ACCESSION#" Q
 | 
|---|
| 19 |  .I WVC=2 S WVTITLE1="LISTED BY PATIENT" Q
 | 
|---|
| 20 |  .S WVTITLE="UNKNOWN REPORT"
 | 
|---|
| 21 |  S WVTITLE="* * *  WOMEN'S HEALTH: LAB LOG "_WVTITLE1_"  * * *"
 | 
|---|
| 22 |  D CENTERT^WVUTL5(.WVTITLE)
 | 
|---|
| 23 |  S WVSUBH="SUBHEAD^WVLABLG1"
 | 
|---|
| 24 |  D TOPHEAD^WVUTL7
 | 
|---|
| 25 |  S (WVPOP,N)=0
 | 
|---|
| 26 | NOMATCH ;EP
 | 
|---|
| 27 |  ;---> QUIT IF NO RECORDS MATCH.
 | 
|---|
| 28 |  I '$D(^TMP("WV",$J,1)) D  Q
 | 
|---|
| 29 |  .D HEADER3^WVUTL7
 | 
|---|
| 30 |  .W !!?5,"No records match the selected criteria.",!
 | 
|---|
| 31 |  .I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
 | 
|---|
| 32 |  .D ^%ZISC S WVPOP=1
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 |  D:WVB DISPLAY1
 | 
|---|
| 35 |  I WVPOP D
 | 
|---|
| 36 |  .W !?5,"Because you have entered ^, the remainder of the individual"
 | 
|---|
| 37 |  .W !?5,"procedures will not be displayed.  The totals that follow,"
 | 
|---|
| 38 |  .W !?5,"however, are accurate for the selected date range."
 | 
|---|
| 39 |  I 'WVB K WVSUBH D HEADER3^WVUTL7
 | 
|---|
| 40 |  D TOTALS,END
 | 
|---|
| 41 |  Q
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 | DISPLAY1 ;EP
 | 
|---|
| 45 |  D HEADER3^WVUTL7
 | 
|---|
| 46 |  F  S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP)  D
 | 
|---|
| 47 |  .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP  D
 | 
|---|
| 48 |  ..S WVPAGE=WVPAGE+1
 | 
|---|
| 49 |  ..D HEADER3^WVUTL7
 | 
|---|
| 50 |  .S Y=^TMP("WV",$J,2,N),M=N
 | 
|---|
| 51 |  .W !,$$SLDT2^WVUTL5($P(Y,U,3))
 | 
|---|
| 52 |  .W ?9,$P(Y,U,4)
 | 
|---|
| 53 |  .W ?21,$E($P(Y,U,2),1,18)
 | 
|---|
| 54 |  .W ?41,$P(Y,U)
 | 
|---|
| 55 |  .W ?53,$E($P(Y,U,8),1,10)
 | 
|---|
| 56 |  .W ?65,$E($P(Y,U,9),1,14)
 | 
|---|
| 57 |  .W !?9,"Date of ",$E($P(Y,U,5),1,23),": ",$P(Y,U,7)
 | 
|---|
| 58 |  .W ?53,"Entered by: ",$E($P(Y,U,10),1,14)
 | 
|---|
| 59 |  .W !?43,"Res/Diag: ",?53,$E($P(Y,U,12),1,26)
 | 
|---|
| 60 |  .W !,WVLINE
 | 
|---|
| 61 |  Q
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 | TOTALS ;EP
 | 
|---|
| 64 |  N N,R S (N,R)=0
 | 
|---|
| 65 |  I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP  D
 | 
|---|
| 66 |  .S WVPAGE=WVPAGE+1 K WVSUBH
 | 
|---|
| 67 |  .D HEADER3^WVUTL7
 | 
|---|
| 68 |  ;
 | 
|---|
| 69 |  F  S N=$O(^TMP("WV",$J,2,N)) Q:'N  D
 | 
|---|
| 70 |  .S M=N S:($P(^TMP("WV",$J,2,N),U,12)="NOT ENTERED") R=R+1
 | 
|---|
| 71 |  W !?4,"*"
 | 
|---|
| 72 |  W ?10,"TOTAL PROCEDURES: ",M,?37,"PROCEDURES WITHOUT RESULTS: ",R
 | 
|---|
| 73 |  W ?75,"*"
 | 
|---|
| 74 |  W !,WVLINE
 | 
|---|
| 75 |  Q
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 | END ;EP
 | 
|---|
| 78 |  I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3
 | 
|---|
| 79 |  D ^%ZISC
 | 
|---|
| 80 |  Q
 | 
|---|
| 81 |  ;
 | 
|---|
| 82 | SUBHEAD ;EP
 | 
|---|
| 83 |  ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
 | 
|---|
| 84 |  W !,"DATE",?9,"ACCESSION#",?21,"PATIENT"
 | 
|---|
| 85 |  W ?41,$$PNLB^WVUTL5(),?53,"LOCATION",?65,"PROVIDER",!
 | 
|---|
| 86 |  W $$REPEAT^XLFSTR("=",80)
 | 
|---|
| 87 |  Q
 | 
|---|