Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWBRPCD1

BWBRPCD1.m

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