1 | WVBRPCD1 ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES; ;8/10/98 16:37
|
---|
2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
---|
3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
4 | ;; DISPLAY CODE FOR BROWSING PROCEDURES. CALLED BY BRBRPCD.
|
---|
5 | ;
|
---|
6 | DISPLAY(WVTITLE,WVHEADER,WVCODE) ;EP
|
---|
7 | ;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
|
---|
8 | ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
|
---|
9 | ;---> WVHEADER=HEADER CALL TO ^WVUTL7
|
---|
10 | ;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
|
---|
11 | ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
|
---|
12 | ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
|
---|
13 | ;---> WVTAB=6 IF OUTPUT IS TO SCREEN, =3 IF OUTPUT IS TO PRINTER.
|
---|
14 | ;---> WVPRMT(1,Q)=PROMPTS FOR DIR.
|
---|
15 | ;
|
---|
16 | U IO
|
---|
17 | S WVCONF=1,WVHEADER=WVHEADER_"^WVUTL7"
|
---|
18 | D CENTERT^WVUTL5(.WVTITLE)
|
---|
19 | S WVSUBH="SUBHEAD^WVBRPCD1"
|
---|
20 | S (WVPOP,N,Z)=0
|
---|
21 | D TOPHEAD^WVUTL7
|
---|
22 | S WVTAB=$S(WVCRT:5,1:3)
|
---|
23 | ;
|
---|
24 | NOMATCH ;EP
|
---|
25 | ;---> QUIT IF NO RECORDS MATCH.
|
---|
26 | I '$D(^TMP("WV",$J,1)) D Q
|
---|
27 | .D @(WVHEADER)
|
---|
28 | .K WVPRMT,WVPRMT1,WVPRMTQ,DIR
|
---|
29 | .W !!?5,"No records match the selected criteria.",!
|
---|
30 | .I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
|
---|
31 | .D ^%ZISC S WVPOP=1
|
---|
32 | ;
|
---|
33 | DISPLAY1 ;EP
|
---|
34 | ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
|
---|
35 | ;---> FROM LINELABEL "END" BELOW.
|
---|
36 | D @(WVHEADER)
|
---|
37 | F S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP) D
|
---|
38 | .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D
|
---|
39 | ..S WVPAGE=WVPAGE+1
|
---|
40 | ..D @(WVHEADER) S Z=0
|
---|
41 | .S Y=^TMP("WV",$J,2,N),M=N
|
---|
42 | .W !
|
---|
43 | .;---> DON'T WRITE SSN# AND NAME IF IT MATCHES THE PREVIOUS RECORD.
|
---|
44 | .;---> DON'T WRITE BROWSE SELECTION#'S IF IO IS NOT A CRT (BRCRT).
|
---|
45 | .I $P(Y,U)'=Z D
|
---|
46 | ..W ! W:WVCRT $J(N,3),")" ;BROWSE SELECTION#
|
---|
47 | ..W ?WVTAB,$P(Y,U) ;SSN#
|
---|
48 | ..W ?WVTAB+10,$E($P(Y,U,2),1,16)," " ;NAME
|
---|
49 | ..W $$REPEAT^XLFSTR(".",16-$L($P(Y,U,2))) ;CONNECTING DOTS
|
---|
50 | ..W:'WVCRT "..." ;ADD DOTS IF NOT A CRT
|
---|
51 | .I $P(Y,U)=Z D ;IF NEW SSN#...
|
---|
52 | ..W:WVCRT $J(N,3),")" ;BROWSE SELECTION#
|
---|
53 | ..W ?WVTAB,". . . . . . . . . . . . . ." ;CONNECTING DOTS
|
---|
54 | .S Z=$P(Y,U) ;STORE AS PREVIOUS SSN#
|
---|
55 | .;
|
---|
56 | .W ?34,$$SLDT2^WVUTL5($P(Y,U,3)) ;DATE OF PROCEDURE
|
---|
57 | .W ?44,$P(Y,U,4) ;ACCESSION#
|
---|
58 | .W ?57,$S($P(Y,U,7)="D":"*",1:" ") ;STATUS (* IF DELINQ)
|
---|
59 | .W ?58,$P(Y,U,7) ;STATUS
|
---|
60 | .W ?62,$E($P(Y,U,5),1,14)_" ("_$P(Y,U,6)_")" ;RESULTS/DIAGNOSIS (PRIORITY)
|
---|
61 | ;
|
---|
62 | END ;EP
|
---|
63 | ;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-5 AND START (GOTO)
|
---|
64 | ;---> DISPLAY1 OVER AGAIN FROM 5 RECORDS PREVIOUS.
|
---|
65 | I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 I N S N=N-1 G NOMATCH
|
---|
66 | D ^%ZISC
|
---|
67 | K N,Z
|
---|
68 | Q
|
---|
69 | ;
|
---|
70 | SUBHEAD ;EP
|
---|
71 | ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
|
---|
72 | W !?WVTAB,$$PNLB^WVUTL5()
|
---|
73 | W ?WVTAB+12,"PATIENT",?34,"DATE",?44,"ACC#"
|
---|
74 | W ?57,"STA",?62,"RESULTS/DIAGNOSIS"
|
---|
75 | W !?62,"(PRIORITY)",!
|
---|
76 | W $$REPEAT^XLFSTR("-",80)
|
---|
77 | Q
|
---|
78 | ;
|
---|
79 | EDIT ;EP
|
---|
80 | ;---> FROM BROWSE, WVPOP IN TO EDIT A SINGLE PROCEDURE.
|
---|
81 | D SETVARS^WVUTL5
|
---|
82 | S X=+X,DA=$P(^TMP("WV",$J,2,X),U,8)
|
---|
83 | S WVN=X N X
|
---|
84 | D EDIT2^WVPROC1(DA,.WVPOP)
|
---|
85 | ;---> BACK UP 5 RECORDS AFTER EDIT.
|
---|
86 | S N=$S(WVN<6:1,1:WVN-5),Z=0 K WVN
|
---|
87 | Q
|
---|