BWBRPCD1 ;IHS/ANMC/MWR - BROWSE PROCEDURES;15-Feb-2003 21:48;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR BROWSING PROCEDURES. CALLED BY BRBRPCD.
;
DISPLAY(BWTITLE,BWHEADER,BWCODE) ;EP
;---> BWCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
;---> BWHEADER=HEADER CALL TO ^BWUTL7
;---> BWCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
;---> BWCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
;---> BWTAB=6 IF OUTPUT IS TO SCREEN, =3 IF OUTPUT IS TO PRINTER.
;---> BWPRMT(1,Q)=PROMPTS FOR DIR.
;
U IO
S BWCONF=1,BWHEADER=BWHEADER_"^BWUTL7"
D CENTERT^BWUTL5(.BWTITLE)
S BWSUBH="SUBHEAD^BWBRPCD1"
S BWPRMT1=" Press RETURN to continue or '^'to exit, or"
S BWPRMT=" Select a left column number to edit"
S BWPRMTQ=" To edit a Procedure, choose a number from the "
S BWPRMTQ=BWPRMTQ_"left column"
S (BWPOP,N,Z)=0
D TOPHEAD^BWUTL7
S BWTAB=$S(BWCRT:6,1:3)
;
NOMATCH ;EP
;---> QUIT IF NO RECORDS MATCH.
I '$D(^TMP("BW",$J,1)) D Q
.D @(BWHEADER)
.K BWPRMT,BWPRMT1,BWPRMTQ,DIR
.W !!?5,"No records match the selected criteria.",!
.D:BWCRT DIRZ^BWUTL3 W @IOF D ^%ZISC S BWPOP=1
;
DISPLAY1 ;EP
;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
;---> FROM LINELABEL "END" BELOW.
D @(BWHEADER)
F S N=$O(^TMP("BW",$J,2,N)) Q:'N!(BWPOP) D
.I $Y+6>IOSL D:BWCRT DIRPRMT^BWUTL3 Q:BWPOP D
..S BWPAGE=BWPAGE+1
..D @(BWHEADER) S Z=0
.S Y=^TMP("BW",$J,2,N),M=N
.W !
.;---> DON'T WRITE CHART# 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:BWCRT $J(N,3),")" ;BROWSE SELECTION#
..W ?BWTAB,$P(Y,U) ;CHART#
..W ?BWTAB+10,$E($P(Y,U,2),1,16)," " ;NAME
..F I=1:1:16-$L($P(Y,U,2)) W "." ;CONNECTING DOTS
..W:'BWCRT "..." ;ADD DOTS IF NOT A CRT
.I $P(Y,U)=Z D ;IF NEW CHART#...
..W:BWCRT $J(N,3),")" ;BROWSE SELECTION#
..W ?BWTAB,". . . . . . . . . . . . ." ;CONNECTING DOTS
.S Z=$P(Y,U) ;STORE AS PREVIOUS CHART#
.;
.W ?35,$$SLDT2^BWUTL5($P(Y,U,3)) ;DATE OF PROCEDURE
.W ?45,$P(Y,U,4) ;ACCESSION#
.W ?55,$S($P(Y,U,7)="D":"*",1:" ") ;STATUS (* IF DELINQ)
.W ?56,$P(Y,U,7) ;STATUS
.W ?60,$E($P(Y,U,5),1,20) ;RESULTS/DIAGNOSIS
;
END ;EP
W:'BWCRT @IOF
;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-5 AND START (GOTO)
;---> DISPLAY1 OVER AGAIN FROM 5 RECORDS PREVIOUS.
I BWCRT&('$D(IO("S")))&('BWPOP) D DIRPRMT^BWUTL3 I N S N=N-1 G NOMATCH
D ^%ZISC
K N,Z
Q
;
SUBHEAD ;EP
;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
W !?BWTAB,$$PNLB^BWUTL5(DUZ(2))
W ?BWTAB+10,"PATIENT",?35,"DATE",?45,"ACC#"
W ?55,"STA",?60,"RESULTS/DIAGNOSIS",!
F I=1:1:80 W "-"
Q
;
EDIT ;EP
;---> FROM BROWSE, BWPOP IN TO EDIT A SINGLE PROCEDURE.
N (DT,DTIME,DUZ,M,N,U,X,Z) D SETVARS^BWUTL5
S X=+X,DA=$P(^TMP("BW",$J,2,X),U,8)
S BWN=X N X
D EDIT2^BWPROC1(DA,.BWPOP)
D:'BWPOP FOLLOWUP^BWPROC1(DA)
;---> BACK UP 5 RECORDS AFTER EDIT.
S N=$S(BWN<6:1,1:BWN-5),Z=0 K BWN
Q
BWBRPCD1 ;IHS/ANMC/MWR - BROWSE PROCEDURES;15-Feb-2003 21:48;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; DISPLAY CODE FOR BROWSING PROCEDURES. CALLED BY BRBRPCD.
+4 ;
DISPLAY(BWTITLE,BWHEADER,BWCODE) ;EP
+1 ;---> BWCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
+2 ;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
+3 ;---> BWHEADER=HEADER CALL TO ^BWUTL7
+4 ;---> BWCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
+5 ;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
+6 ;---> BWCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
+7 ;---> BWTAB=6 IF OUTPUT IS TO SCREEN, =3 IF OUTPUT IS TO PRINTER.
+8 ;---> BWPRMT(1,Q)=PROMPTS FOR DIR.
+9 ;
+10 USE IO
+11 SET BWCONF=1
SET BWHEADER=BWHEADER_"^BWUTL7"
+12 DO CENTERT^BWUTL5(.BWTITLE)
+13 SET BWSUBH="SUBHEAD^BWBRPCD1"
+14 SET BWPRMT1=" Press RETURN to continue or '^'to exit, or"
+15 SET BWPRMT=" Select a left column number to edit"
+16 SET BWPRMTQ=" To edit a Procedure, choose a number from the "
+17 SET BWPRMTQ=BWPRMTQ_"left column"
+18 SET (BWPOP,N,Z)=0
+19 DO TOPHEAD^BWUTL7
+20 SET BWTAB=$SELECT(BWCRT:6,1:3)
+21 ;
NOMATCH ;EP
+1 ;---> QUIT IF NO RECORDS MATCH.
+2 IF '$DATA(^TMP("BW",$JOB,1))
Begin DoDot:1
+3 DO @(BWHEADER)
+4 KILL BWPRMT,BWPRMT1,BWPRMTQ,DIR
+5 WRITE !!?5,"No records match the selected criteria.",!
+6 IF BWCRT
DO DIRZ^BWUTL3
WRITE @IOF
DO ^%ZISC
SET BWPOP=1
End DoDot:1
QUIT
+7 ;
DISPLAY1 ;EP
+1 ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
+2 ;---> FROM LINELABEL "END" BELOW.
+3 DO @(BWHEADER)
+4 FOR
SET N=$ORDER(^TMP("BW",$JOB,2,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+5 IF $Y+6>IOSL
IF BWCRT
DO DIRPRMT^BWUTL3
IF BWPOP
QUIT
Begin DoDot:2
+6 SET BWPAGE=BWPAGE+1
+7 DO @(BWHEADER)
SET Z=0
End DoDot:2
+8 SET Y=^TMP("BW",$JOB,2,N)
SET M=N
+9 WRITE !
+10 ;---> DON'T WRITE CHART# AND NAME IF IT MATCHES THE PREVIOUS RECORD.
+11 ;---> DON'T WRITE BROWSE SELECTION#'S IF IO IS NOT A CRT (BRCRT).
+12 IF $PIECE(Y,U)'=Z
Begin DoDot:2
+13 ;BROWSE SELECTION#
WRITE !
IF BWCRT
WRITE $JUSTIFY(N,3),")"
+14 ;CHART#
WRITE ?BWTAB,$PIECE(Y,U)
+15 ;NAME
WRITE ?BWTAB+10,$EXTRACT($PIECE(Y,U,2),1,16)," "
+16 ;CONNECTING DOTS
FOR I=1:1:16-$LENGTH($PIECE(Y,U,2))
WRITE "."
+17 ;ADD DOTS IF NOT A CRT
IF 'BWCRT
WRITE "..."
End DoDot:2
+18 ;IF NEW CHART#...
IF $PIECE(Y,U)=Z
Begin DoDot:2
+19 ;BROWSE SELECTION#
IF BWCRT
WRITE $JUSTIFY(N,3),")"
+20 ;CONNECTING DOTS
WRITE ?BWTAB,". . . . . . . . . . . . ."
End DoDot:2
+21 ;STORE AS PREVIOUS CHART#
SET Z=$PIECE(Y,U)
+22 ;
+23 ;DATE OF PROCEDURE
WRITE ?35,$$SLDT2^BWUTL5($PIECE(Y,U,3))
+24 ;ACCESSION#
WRITE ?45,$PIECE(Y,U,4)
+25 ;STATUS (* IF DELINQ)
WRITE ?55,$SELECT($PIECE(Y,U,7)="D":"*",1:" ")
+26 ;STATUS
WRITE ?56,$PIECE(Y,U,7)
+27 ;RESULTS/DIAGNOSIS
WRITE ?60,$EXTRACT($PIECE(Y,U,5),1,20)
End DoDot:1
+28 ;
END ;EP
+1 IF 'BWCRT
WRITE @IOF
+2 ;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-5 AND START (GOTO)
+3 ;---> DISPLAY1 OVER AGAIN FROM 5 RECORDS PREVIOUS.
+4 IF BWCRT&('$DATA(IO("S")))&('BWPOP)
DO DIRPRMT^BWUTL3
IF N
SET N=N-1
GOTO NOMATCH
+5 DO ^%ZISC
+6 KILL N,Z
+7 QUIT
+8 ;
SUBHEAD ;EP
+1 ;---> SUB HEADER FOR PROCEDURE BROWSE OUTPUT.
+2 WRITE !?BWTAB,$$PNLB^BWUTL5(DUZ(2))
+3 WRITE ?BWTAB+10,"PATIENT",?35,"DATE",?45,"ACC#"
+4 WRITE ?55,"STA",?60,"RESULTS/DIAGNOSIS",!
+5 FOR I=1:1:80
WRITE "-"
+6 QUIT
+7 ;
EDIT ;EP
+1 ;---> FROM BROWSE, BWPOP IN TO EDIT A SINGLE PROCEDURE.
+2 NEW (DT,DTIME,DUZ,M,N,U,X,Z)
DO SETVARS^BWUTL5
+3 SET X=+X
SET DA=$PIECE(^TMP("BW",$JOB,2,X),U,8)
+4 SET BWN=X
NEW X
+5 DO EDIT2^BWPROC1(DA,.BWPOP)
+6 IF 'BWPOP
DO FOLLOWUP^BWPROC1(DA)
+7 ;---> BACK UP 5 RECORDS AFTER EDIT.
+8 SET N=$SELECT(BWN<6:1,1:BWN-5)
SET Z=0
KILL BWN
+9 QUIT
