VistA-WorldVistAEHR/r/WOMENS_HEALTH-WV/WVBRPCD1.m

88 lines
3.0 KiB
Mathematica

WVBRPCD1 ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES; ;8/10/98 16:37
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR BROWSING PROCEDURES. CALLED BY BRBRPCD.
;
DISPLAY(WVTITLE,WVHEADER,WVCODE) ;EP
;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
;---> WVHEADER=HEADER CALL TO ^WVUTL7
;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
;---> WVTAB=6 IF OUTPUT IS TO SCREEN, =3 IF OUTPUT IS TO PRINTER.
;---> WVPRMT(1,Q)=PROMPTS FOR DIR.
;
U IO
S WVCONF=1,WVHEADER=WVHEADER_"^WVUTL7"
D CENTERT^WVUTL5(.WVTITLE)
S WVSUBH="SUBHEAD^WVBRPCD1"
S (WVPOP,N,Z)=0
D TOPHEAD^WVUTL7
S WVTAB=$S(WVCRT:5,1:3)
;
NOMATCH ;EP
;---> QUIT IF NO RECORDS MATCH.
I '$D(^TMP("WV",$J,1)) D Q
.D @(WVHEADER)
.K WVPRMT,WVPRMT1,WVPRMTQ,DIR
.W !!?5,"No records match the selected criteria.",!
.I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
.D ^%ZISC S WVPOP=1
;
DISPLAY1 ;EP
;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
;---> FROM LINELABEL "END" BELOW.
D @(WVHEADER)
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 @(WVHEADER) S Z=0
.S Y=^TMP("WV",$J,2,N),M=N
.W !
.;---> DON'T WRITE SSN# AND NAME IF IT MATCHES THE PREVIOUS RECORD.
.;---> DON'T WRITE BROWSE SELECTION#'S IF IO IS NOT A CRT (BRCRT).
.I $P(Y,U)'=Z D
..W ! W:WVCRT $J(N,3),")" ;BROWSE SELECTION#
..W ?WVTAB,$P(Y,U) ;SSN#
..W ?WVTAB+10,$E($P(Y,U,2),1,16)," " ;NAME
..W $$REPEAT^XLFSTR(".",16-$L($P(Y,U,2))) ;CONNECTING DOTS
..W:'WVCRT "..." ;ADD DOTS IF NOT A CRT
.I $P(Y,U)=Z D ;IF NEW SSN#...
..W:WVCRT $J(N,3),")" ;BROWSE SELECTION#
..W ?WVTAB,". . . . . . . . . . . . . ." ;CONNECTING DOTS
.S Z=$P(Y,U) ;STORE AS PREVIOUS SSN#
.;
.W ?34,$$SLDT2^WVUTL5($P(Y,U,3)) ;DATE OF PROCEDURE
.W ?44,$P(Y,U,4) ;ACCESSION#
.W ?57,$S($P(Y,U,7)="D":"*",1:" ") ;STATUS (* IF DELINQ)
.W ?58,$P(Y,U,7) ;STATUS
.W ?62,$E($P(Y,U,5),1,14)_" ("_$P(Y,U,6)_")" ;RESULTS/DIAGNOSIS (PRIORITY)
;
END ;EP
;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-5 AND START (GOTO)
;---> DISPLAY1 OVER AGAIN FROM 5 RECORDS PREVIOUS.
I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 I N S N=N-1 G NOMATCH
D ^%ZISC
K N,Z
Q
;
SUBHEAD ;EP
;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
W !?WVTAB,$$PNLB^WVUTL5()
W ?WVTAB+12,"PATIENT",?34,"DATE",?44,"ACC#"
W ?57,"STA",?62,"RESULTS/DIAGNOSIS"
W !?62,"(PRIORITY)",!
W $$REPEAT^XLFSTR("-",80)
Q
;
EDIT ;EP
;---> FROM BROWSE, WVPOP IN TO EDIT A SINGLE PROCEDURE.
D SETVARS^WVUTL5
S X=+X,DA=$P(^TMP("WV",$J,2,X),U,8)
S WVN=X N X
D EDIT2^WVPROC1(DA,.WVPOP)
;---> BACK UP 5 RECORDS AFTER EDIT.
S N=$S(WVN<6:1,1:WVN-5),Z=0 K WVN
Q