BWPROF1 ;IHS/ANMC/MWR - DISPLAY PATIENT PROFILE;15-Feb-2003 22:08;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; SETUP AND EDIT CODE FOR DISPLAYING PATIENT PROFILE.
;; CALLED BY BWPROF.
;
D DISPLAY Q:BWPOP
D ^BWPROF3
Q
;
;
DISPLAY ;EP
;---> BWCONF=DISPLAY "CONFIDENTIAL PATIENT INFO" BANNER.
;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
;---> BWCHAGE=DISPLAY CHART AND AGE IN 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
I '$D(BWDFN)!('$D(BWNAME))!('$D(BWCHRT)) D Q
.W !!,"INSUFFICIENT PATIENT INFORMATION.",!!
.D DIRZ^BWUTL3 S BWPOP=1
;
S BWCONF=1,BWCHAGE=1
S BWTITLE="* * * Patient Profile * * *" D CENTERT^BWUTL5(.BWTITLE)
S BWCODE="Q:'$D(^TMP(""BW"",$J,2,+X)) "
S BWCODE=BWCODE_"D EDIT^BWPROF1 N X D SORT^BWPROF2,COPYGBL^BWPROF"
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 or Notification, choose "
S BWPRMTQ=BWPRMTQ_"a number from the left-most column."
;---> IF PROFILE IS BEING ACCESSED BY A USER FROM OUTSIDE OF THE
;---> PACKAGE (NOT WOMEN'S HEALTH STAFF), THEN OFFER DISPLAY/PRINT
;---> OF PROCEDURE; DO NOT OFFER EDIT OF PROCEDURE.
D:$G(BWPUSER)
.S BWCODE="D PRINTPCD^BWPROF1"
.S BWPRMT=" Select a left column number to display/print"
.S BWPRMTQ=" To display or print a Procedure in detail, choose "
.S BWPRMTQ=BWPRMTQ_"a number from the left-most column."
S (BWACCP,N,BWPOP,Z)=0
D TOPHEAD^BWUTL7
S BWTAB=$S(BWCRT:6,1:3)
Q
;
;
EDIT ;EP
;---> FROM BROWSE, BWPOP IN TO EDIT A SINGLE PROCEDURE.
;---> NOTE: PIECE 10 OF EACH TMP NODE IS THE IEN FOR THAT ENTRY
;---> IN ITS RESPECTIVE FILE (PROCDURE FILE OR NOTIFICATION FILE).
N (DT,DTIME,DUZ,IOF,M,N,U,X,Z) D SETVARS^BWUTL5
S X=+X,DA=$P(^TMP("BW",$J,2,X),U,10)
S BWNN=X N X D
.I $P(^TMP("BW",$J,2,BWNN),U)=1 D Q
..D EDIT2^BWPROC1(DA,.BWPOP) Q:BWPOP D FOLLOWUP^BWPROC1(DA)
.I $P(^TMP("BW",$J,2,BWNN),U)=2 D EDIT2^BWNOTIF(DA) Q
.W !!?3,*7,"This is neither a PROCEDURE nor a NOTIFICATION. "
.W "It cannot be edited here."
.D DIRZ^BWUTL3 Q
;---> BACK UP 5 RECORDS AFTER EDIT.
S N=$S(BWNN<6:1,1:BWNN-5),Z=0 K BWNN
Q
;
;
PRINTPCD ;EP
;---> FROM BROWSE, PRINT THIS PROCEDURE.
;---> NOTE: PIECE 10 OF EACH TMP NODE IS THE IEN FOR THAT ENTRY
;---> IN ITS RESPECTIVE FILE (PROCDURE FILE OR NOTIFICATION FILE).
N (DT,DTIME,DUZ,M,N,U,X,Z) D SETVARS^BWUTL5
S X=+X,DA=$P(^TMP("BW",$J,2,X),U,10)
S BWN=X N X D
.I $P(^TMP("BW",$J,2,BWN),U)=1 D TOP^BWPRPCD(DA) Q
.W !!?3,*7,"This is not a PROCEDURE. "
.D DIRZ^BWUTL3 Q
;---> BACK UP 5 RECORDS AFTER EDIT.
S N=$S(BWN<6:1,1:BWN-5),Z=0 K BWN
Q
;
;
SUBHEAD ;EP
;---> SUB HEADER FOR BRIEF DISPLAY OF PROCEDURES ONLY.
W !?BWTAB,"DATE",?16,"PROCEDURE",?27,"RESULTS/DIAGNOSIS",?71,"STATUS",!
W ?BWTAB,"--------",?16,"---------",?27,"----------------------------"
W ?71,"------"
Q
BWPROF1 ;IHS/ANMC/MWR - DISPLAY PATIENT PROFILE;15-Feb-2003 22:08;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; SETUP AND EDIT CODE FOR DISPLAYING PATIENT PROFILE.
+4 ;; CALLED BY BWPROF.
+5 ;
+6 DO DISPLAY
IF BWPOP
QUIT
+7 DO ^BWPROF3
+8 QUIT
+9 ;
+10 ;
DISPLAY ;EP
+1 ;---> BWCONF=DISPLAY "CONFIDENTIAL PATIENT INFO" BANNER.
+2 ;---> BWTITLE=TITLE AT TOP OF DISPLAY HEADER.
+3 ;---> BWCHAGE=DISPLAY CHART AND AGE IN HEADER.
+4 ;---> BWSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
+5 ;---> BWCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
+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 IF '$DATA(BWDFN)!('$DATA(BWNAME))!('$DATA(BWCHRT))
Begin DoDot:1
+12 WRITE !!,"INSUFFICIENT PATIENT INFORMATION.",!!
+13 DO DIRZ^BWUTL3
SET BWPOP=1
End DoDot:1
QUIT
+14 ;
+15 SET BWCONF=1
SET BWCHAGE=1
+16 SET BWTITLE="* * * Patient Profile * * *"
DO CENTERT^BWUTL5(.BWTITLE)
+17 SET BWCODE="Q:'$D(^TMP(""BW"",$J,2,+X)) "
+18 SET BWCODE=BWCODE_"D EDIT^BWPROF1 N X D SORT^BWPROF2,COPYGBL^BWPROF"
+19 SET BWPRMT1=" Press RETURN to continue or '^'to exit, or"
+20 SET BWPRMT=" Select a left column number to edit"
+21 SET BWPRMTQ=" To edit a Procedure or Notification, choose "
+22 SET BWPRMTQ=BWPRMTQ_"a number from the left-most column."
+23 ;---> IF PROFILE IS BEING ACCESSED BY A USER FROM OUTSIDE OF THE
+24 ;---> PACKAGE (NOT WOMEN'S HEALTH STAFF), THEN OFFER DISPLAY/PRINT
+25 ;---> OF PROCEDURE; DO NOT OFFER EDIT OF PROCEDURE.
+26 IF $GET(BWPUSER)
Begin DoDot:1
+27 SET BWCODE="D PRINTPCD^BWPROF1"
+28 SET BWPRMT=" Select a left column number to display/print"
+29 SET BWPRMTQ=" To display or print a Procedure in detail, choose "
+30 SET BWPRMTQ=BWPRMTQ_"a number from the left-most column."
End DoDot:1
+31 SET (BWACCP,N,BWPOP,Z)=0
+32 DO TOPHEAD^BWUTL7
+33 SET BWTAB=$SELECT(BWCRT:6,1:3)
+34 QUIT
+35 ;
+36 ;
EDIT ;EP
+1 ;---> FROM BROWSE, BWPOP IN TO EDIT A SINGLE PROCEDURE.
+2 ;---> NOTE: PIECE 10 OF EACH TMP NODE IS THE IEN FOR THAT ENTRY
+3 ;---> IN ITS RESPECTIVE FILE (PROCDURE FILE OR NOTIFICATION FILE).
+4 NEW (DT,DTIME,DUZ,IOF,M,N,U,X,Z)
DO SETVARS^BWUTL5
+5 SET X=+X
SET DA=$PIECE(^TMP("BW",$JOB,2,X),U,10)
+6 SET BWNN=X
NEW X
Begin DoDot:1
+7 IF $PIECE(^TMP("BW",$JOB,2,BWNN),U)=1
Begin DoDot:2
+8 DO EDIT2^BWPROC1(DA,.BWPOP)
IF BWPOP
QUIT
DO FOLLOWUP^BWPROC1(DA)
End DoDot:2
QUIT
+9 IF $PIECE(^TMP("BW",$JOB,2,BWNN),U)=2
DO EDIT2^BWNOTIF(DA)
QUIT
+10 WRITE !!?3,*7,"This is neither a PROCEDURE nor a NOTIFICATION. "
+11 WRITE "It cannot be edited here."
+12 DO DIRZ^BWUTL3
QUIT
End DoDot:1
+13 ;---> BACK UP 5 RECORDS AFTER EDIT.
+14 SET N=$SELECT(BWNN<6:1,1:BWNN-5)
SET Z=0
KILL BWNN
+15 QUIT
+16 ;
+17 ;
PRINTPCD ;EP
+1 ;---> FROM BROWSE, PRINT THIS PROCEDURE.
+2 ;---> NOTE: PIECE 10 OF EACH TMP NODE IS THE IEN FOR THAT ENTRY
+3 ;---> IN ITS RESPECTIVE FILE (PROCDURE FILE OR NOTIFICATION FILE).
+4 NEW (DT,DTIME,DUZ,M,N,U,X,Z)
DO SETVARS^BWUTL5
+5 SET X=+X
SET DA=$PIECE(^TMP("BW",$JOB,2,X),U,10)
+6 SET BWN=X
NEW X
Begin DoDot:1
+7 IF $PIECE(^TMP("BW",$JOB,2,BWN),U)=1
DO TOP^BWPRPCD(DA)
QUIT
+8 WRITE !!?3,*7,"This is not a PROCEDURE. "
+9 DO DIRZ^BWUTL3
QUIT
End DoDot:1
+10 ;---> BACK UP 5 RECORDS AFTER EDIT.
+11 SET N=$SELECT(BWN<6:1,1:BWN-5)
SET Z=0
KILL BWN
+12 QUIT
+13 ;
+14 ;
SUBHEAD ;EP
+1 ;---> SUB HEADER FOR BRIEF DISPLAY OF PROCEDURES ONLY.
+2 WRITE !?BWTAB,"DATE",?16,"PROCEDURE",?27,"RESULTS/DIAGNOSIS",?71,"STATUS",!
+3 WRITE ?BWTAB,"--------",?16,"---------",?27,"----------------------------"
+4 WRITE ?71,"------"
+5 QUIT
