source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVBRPCD1.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1WVBRPCD1 ;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 ;
6DISPLAY(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 ;
24NOMATCH ;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 ;
33DISPLAY1 ;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 ;
62END ;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 ;
70SUBHEAD ;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 ;
79EDIT ;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
Note: See TracBrowser for help on using the repository browser.