BWBRNED1 ;IHS/ANMC/MWR - BROWSE TX NEEDS PAST DUE;15-Feb-2003 21:47;PLS
;;2.0;WOMEN'S HEALTH;**5,8**;MAY 16, 1996
;IHS/CMI/LAB - Y2K
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR BROWSING TX NEEDS. CALLED BY BWBRNED.
;
DISPLAY ;EP
;---> BWCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
;---> BWCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
;---> 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
S BWTITLE1=$S(BWB=1:"BY NEED DATE",BWB=2:"ALPHABETICALLY",1:"?")
S BWTITLE="* PATIENTS LISTED "_BWTITLE1_" *"
D CENTERT^BWUTL5(.BWTITLE)
S BWSUBH="SUBHEAD^BWBRNED1"
S BWCODE="D EDIT^BWBRNED1 N N D SORT^BWBRNED,COPYGBL^BWBRNED"
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
;---> *SET BWFAC FOR NOW; MAKE BWFAC SELECTABLE IN FUTURE VERSIONS.
S BWFAC=DUZ(2)
S BWTAB=$S(BWCRT:6,1:3)
;
NOMATCH ;EP
;---> QUIT IF NO RECORDS MATCH.
I '$D(^TMP("BW",$J,1)) D Q
.D HEADER5^BWUTL7
.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.
N M,Y
D HEADER5^BWUTL7
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 HEADER5^BWUTL7
.S Y=^TMP("BW",$J,2,N),M=N
.;---> DON'T WRITE BROWSE SELECTION#'S IF IO IS NOT A CRT (BRCRT).
.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
.;begin Y2K
.W ?34,$E($P($P(Y,U,3),","),1,9) ;CASE MANAGER ;IHS/CMI/LAB Y2000
.W ?44,$P(Y,U,4) ;CERVICAL TX NEED&DATE ;IHS/CMI/LAB Y2000
.W !?44,$P(Y,U,5) ;BREAST TX NEED&DATE ;IHS/CMI/LAB Y2000
.;end Y2K
;
D:'N
.N BWTITLE S BWTITLE="----- End of Report -----"
.D CENTERT^BWUTL5(.BWTITLE) W !!,BWTITLE
;
END ;EP
W:'BWCRT @IOF
;---> IF A PATIENT HAS BEEN EDITED, SET N=N-5 AND START (GOTO)
I BWCRT&('$D(IO("S")))&('BWPOP) D DIRPRMT^BWUTL3 I N S N=N-1 G NOMATCH
D ^%ZISC
Q
;
SUBHEAD ;EP
;---> SUB HEADER FOR PATIENT BROWSE OUTPUT.
;begin Y2K
W !?BWTAB,$$PNLB^BWUTL5(DUZ(2)),?BWTAB+10,"PATIENT",?34,"CASE MGR" ;IHS/CMI/LAB spacing for 4 digit date Y2000
W ?44,"TREATMENT NEED DUE BY DATE",! ;IHS/CMI/LAB Y2000
;end Y2K
F I=1:1:80 W "-"
Q
;
EDIT ;EP
;---> FROM BROWSE, BWPOP IN TO EDIT AN INDIVIDUAL PATIENT.
N (DT,DTIME,DUZ,M,N,U,X,Z) D SETVARS^BWUTL5
S X=+X,BWDFN=$P(^TMP("BW",$J,2,X),U,6)
S BWN=X N X
D SCREEN^BWPATE(BWDFN)
;---> BACK UP 5 RECORDS AFTER EDIT.
S N=$S(BWN<6:1,1:BWN-5) K BWN
Q
BWBRNED1 ;IHS/ANMC/MWR - BROWSE TX NEEDS PAST DUE;15-Feb-2003 21:47;PLS
+1 ;;2.0;WOMEN'S HEALTH;**5,8**;MAY 16, 1996
+2 ;IHS/CMI/LAB - Y2K
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; DISPLAY CODE FOR BROWSING TX NEEDS. CALLED BY BWBRNED.
+5 ;
DISPLAY ;EP
+1 ;---> BWCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
+2 ;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
+3 ;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
+4 ;---> BWCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
+5 ;---> BWCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
+6 ;---> BWTAB=6 IF OUTPUT IS TO SCREEN, =3 IF OUTPUT IS TO PRINTER.
+7 ;---> BWPRMT(1,Q)=PROMPTS FOR DIR.
+8 ;
+9 USE IO
+10 SET BWCONF=1
+11 SET BWTITLE1=$SELECT(BWB=1:"BY NEED DATE",BWB=2:"ALPHABETICALLY",1:"?")
+12 SET BWTITLE="* PATIENTS LISTED "_BWTITLE1_" *"
+13 DO CENTERT^BWUTL5(.BWTITLE)
+14 SET BWSUBH="SUBHEAD^BWBRNED1"
+15 SET BWCODE="D EDIT^BWBRNED1 N N D SORT^BWBRNED,COPYGBL^BWBRNED"
+16 SET BWPRMT1=" Press RETURN to continue or '^'to exit, or"
+17 SET BWPRMT=" Select a left column number to edit"
+18 SET BWPRMTQ=" To edit a Procedure, choose a number from the "
+19 SET BWPRMTQ=BWPRMTQ_"left column"
+20 SET (BWPOP,N,Z)=0
+21 DO TOPHEAD^BWUTL7
+22 ;---> *SET BWFAC FOR NOW; MAKE BWFAC SELECTABLE IN FUTURE VERSIONS.
+23 SET BWFAC=DUZ(2)
+24 SET BWTAB=$SELECT(BWCRT:6,1:3)
+25 ;
NOMATCH ;EP
+1 ;---> QUIT IF NO RECORDS MATCH.
+2 IF '$DATA(^TMP("BW",$JOB,1))
Begin DoDot:1
+3 DO HEADER5^BWUTL7
+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 NEW M,Y
+4 DO HEADER5^BWUTL7
+5 FOR
SET N=$ORDER(^TMP("BW",$JOB,2,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+6 IF $Y+6>IOSL
IF BWCRT
DO DIRPRMT^BWUTL3
IF BWPOP
QUIT
Begin DoDot:2
+7 SET BWPAGE=BWPAGE+1
+8 DO HEADER5^BWUTL7
End DoDot:2
+9 SET Y=^TMP("BW",$JOB,2,N)
SET M=N
+10 ;---> DON'T WRITE BROWSE SELECTION#'S IF IO IS NOT A CRT (BRCRT).
+11 ;BROWSE SELECTION#
WRITE !!
IF BWCRT
WRITE $JUSTIFY(N,3),")"
+12 ;CHART#
WRITE ?BWTAB,$PIECE(Y,U)
+13 ;NAME
WRITE ?BWTAB+10,$EXTRACT($PIECE(Y,U,2),1,16)," "
+14 ;CONNECTING DOTS
FOR I=1:1:16-$LENGTH($PIECE(Y,U,2))
WRITE "."
+15 ;ADD DOTS IF NOT A CRT
IF 'BWCRT
WRITE "..."
+16 ;begin Y2K
+17 ;CASE MANAGER ;IHS/CMI/LAB Y2000
WRITE ?34,$EXTRACT($PIECE($PIECE(Y,U,3),","),1,9)
+18 ;CERVICAL TX NEED&DATE ;IHS/CMI/LAB Y2000
WRITE ?44,$PIECE(Y,U,4)
+19 ;BREAST TX NEED&DATE ;IHS/CMI/LAB Y2000
WRITE !?44,$PIECE(Y,U,5)
+20 ;end Y2K
End DoDot:1
+21 ;
+22 IF 'N
Begin DoDot:1
+23 NEW BWTITLE
SET BWTITLE="----- End of Report -----"
+24 DO CENTERT^BWUTL5(.BWTITLE)
WRITE !!,BWTITLE
End DoDot:1
+25 ;
END ;EP
+1 IF 'BWCRT
WRITE @IOF
+2 ;---> IF A PATIENT HAS BEEN EDITED, SET N=N-5 AND START (GOTO)
+3 IF BWCRT&('$DATA(IO("S")))&('BWPOP)
DO DIRPRMT^BWUTL3
IF N
SET N=N-1
GOTO NOMATCH
+4 DO ^%ZISC
+5 QUIT
+6 ;
SUBHEAD ;EP
+1 ;---> SUB HEADER FOR PATIENT BROWSE OUTPUT.
+2 ;begin Y2K
+3 ;IHS/CMI/LAB spacing for 4 digit date Y2000
WRITE !?BWTAB,$$PNLB^BWUTL5(DUZ(2)),?BWTAB+10,"PATIENT",?34,"CASE MGR"
+4 ;IHS/CMI/LAB Y2000
WRITE ?44,"TREATMENT NEED DUE BY DATE",!
+5 ;end Y2K
+6 FOR I=1:1:80
WRITE "-"
+7 QUIT
+8 ;
EDIT ;EP
+1 ;---> FROM BROWSE, BWPOP IN TO EDIT AN INDIVIDUAL PATIENT.
+2 NEW (DT,DTIME,DUZ,M,N,U,X,Z)
DO SETVARS^BWUTL5
+3 SET X=+X
SET BWDFN=$PIECE(^TMP("BW",$JOB,2,X),U,6)
+4 SET BWN=X
NEW X
+5 DO SCREEN^BWPATE(BWDFN)
+6 ;---> BACK UP 5 RECORDS AFTER EDIT.
+7 SET N=$SELECT(BWN<6:1,1:BWN-5)
KILL BWN
+8 QUIT
