- 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
