BWPROF3 ;IHS/ANMC/MWR - DISPLAY PATIENT PROFILE; [ 09/17/2001 7:54 AM ]
;;2.0;WOMEN'S HEALTH;**5,8**;MAY 16, 1996
;IHS/CMI/LAB - Y2K
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; DISPLAY CODE FOR PATIENT PROFILE. CALLED BY BWPROF1.
;
NOMATCH ;EP
;---> QUIT IF NO RECORDS MATCH.
I '$D(^TMP("BW",$J,1)) D Q
.D HEADER2^BWUTL7
.K BWPRMT,BWPRMT1,BWPRMTQ,DIR
.W !!?5,"No records match the selected criteria.",!
.D:BWCRT DIRZ^BWUTL3 W @IOF D ^%ZISC:'$G(BWEXT) S BWPOP=1 ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
;
;---> BWD=1:DETAILED DISPLAY, BWD=0:BRIEF DISPLAY.
I BWD D DISPLAY1 Q
D DISPLAY2
Q
;
;
DISPLAY1 ;EP
;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
;---> FROM LINELABEL "END" BELOW.
D HEADER2^BWUTL7
F S N=$O(^TMP("BW",$J,2,N)) Q:'N!(BWPOP) D
.I $Y+9>IOSL D:BWCRT DIRPRMT^BWUTL3 Q:BWPOP D
..S BWPAGE=BWPAGE+1
..D HEADER2^BWUTL7 S (BWACCP,Z)=0
.S Y=^TMP("BW",$J,2,N),M=N
.W !
.;
.;---> **********************
.;---> DISPLAY PROCEDURES
.;---> IF PIECE 1=1 DISPLAY AS A PROCEDURE.
.I $P(Y,U)=1 D Q
..W !,"------------------------------< "
..W "PROCEDURE: ",$P(Y,U,5)," >" ;PROCEDURE ABBREVIATION
..F I=1:1:(6-$L($P(Y,U,5))) W "-"
..W "-----------------------------"
..W ! W:BWCRT $J(N,3),")" W ?BWTAB ;BROWSE SELECTION#
..W $P(Y,U,6) ;ACCESSION#
..;begin Y2K
..W ?16,$P(Y,U,4) ;DATE OF PROCEDURE ;IHS/CMI/LAB 17 to 16 Y2000
..;end Y2K
..W ?27,"Res/Diag: ",$P(Y,U,7) ;RESULTS/DIAGNOSIS
..W !?27,"Provider: ",$E($P(Y,U,8),1,14) ;PROVIDER
..W ?62,"Status: ",$P(Y,U,9) ;STATUS
..S BWACCP=$P(Y,U,6) ;STORE AS PREVIOUS ACCESS#
.;
.;---> **********************
.;---> DISPLAY NOTIFICATIONS
.;---> IF PIECE 1=2 DISPLAY AS A NOTIFICATION.
.I $P(Y,U)=2 D Q
..S BWACC=$P(Y,U,5)
..I BWACC'=Z D
...;begin Y2K
...W ! W:BWACC["NO ACC#" "-----------------" W ?16 ;IHS/CMI/LAB 17 to 16 Y2000
...;end Y2K
...W "-------------< NOTIFICATIONS >---------------------------------"
..W ! W:BWCRT $J(N,3),")" W ?BWTAB ;BROWSE SELECTION#
..W:BWACC'=BWACCP!(BWACC["NO ACC#") BWACC ;ACCESSION#
..;begin Y2K
..W ?16,$P(Y,U,4) ;DATE OF PROCEDURE;IHS/CMI/LAB 17 to 16 Y2000
..;end Y2K
..W ?27,$E($P(Y,U,6)_": "_$P(Y,U,7),1,53) ;TYPE AND PURPOSE
..W !?27,"Outcome: ",$E($P(Y,U,8),1,23) ;OUTCOME OF NOTIFICATION
..W ?62,"Status: ",$P(Y,U,9) ;STATUS
..S (BWACCP,Z)=BWACC ;STORE AS PREVIOUS ACC#
..;
..;---> TWO VARIABLES (BWACCP & Z) USED ABOVE: "Z" SAYS "IF THIS NOTIF
..;---> ACC# IS NOT THE SAME AS THE LAST ONE, DISPLAY --<NOT>-- BANNER.
..;---> "BWACCP" SAYS "IF THIS NOTIF ACC# MATCHES THE LAST PROCEDURE'S
..;---> ACC#, DON'T DISPLAY THE ACCESSION#."
..;---> BOTH VARIABLES ARE RESET AFTER A FORMFEED, IN ORDER TO DISPLAY
..;---> ON THE NEW PAGE.
.;
.;---> **********************
.;---> DISPLAY PAP REGIMENS
.;---> IF PIECE 1=3 DISPLAY AS A PAP REGIMEN.
.I $P(Y,U)=3 D Q
..W !,"------------------------------< PAP REGIMEN CHANGE"
..W " >----------------------------"
..;begin Y2K
..W !?9,"Began:" ;IHS/CMI/LAB - 10 to 9 Y2000
..W ?16,$P(Y,U,4) ;DATE OF REGIMEN ENTRY ;IHS/CMI/LAB 17 to 16 Y2000
..;end Y2K
..W ?27,"Regimen: ",$P(Y,U,5) ;PAP REGIMEN
.;
.;---> **********************
.;---> DISPLAY PREGNANCIES
.;---> IF PIECE 1=4 DISPLAY AS A PREGNANCY.
.I $P(Y,U)=4 D Q
..W !,"------------------------------< PREGNANCY STATUS"
..W " >------------------------------"
..;begin Y2K
..W !?6,"Entered:" ;IHS/CMI/LAB - 8 to 6 patch 5 Y2000
..W ?15,$P(Y,U,4) ;DATE OF PREGNANCY EDIT. ;IHS/CMI/LAB - 17 to 15 Y2000
..;end Y2K
..W ?27,$P(Y,U,5) ;PREGNANT/NOT
..W:$P(Y,U,6)]"" ?50,"EDC: ",$P(Y,U,6) ;EDC
;
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:'$G(BWEXT) ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
K N,Z
Q
;
;
;
DISPLAY2 ;EP
;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
;---> FROM LINELABEL "END" BELOW.
S BWSUBH="SUBHEAD^BWPROF1"
D HEADER2^BWUTL7
F S N=$O(^TMP("BW",$J,2,N)) Q:'N!(BWPOP) D
.I $Y+9>IOSL D:BWCRT DIRPRMT^BWUTL3 Q:BWPOP D
..S BWPAGE=BWPAGE+1
..D HEADER2^BWUTL7 S (BWACCP,Z)=0
.S Y=^TMP("BW",$J,2,N),M=N
.;---> QUIT IF NOT A PROCEDURE (PIECE 1'=1).
.Q:$P(Y,U)'=1
.W ! W:BWCRT $J(N,3),")" W ?BWTAB ;BROWSE SELECTION#
.W $P(Y,U,4) ;DATE OF PROCEDURE
.W ?17,$P(Y,U,5) ;PROCEDURE ABBREVIATION
.W ?27,$P(Y,U,7) ;RESULT
.W ?71,$P(Y,U,9) ;STATUS
.S BWACCP=$P(Y,U,6) ;STORE AS PREVIOUS ACCESS#
END2 ;EP
W:'BWCRT @IOF
;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-1 AND START (GOTO)
;---> DISPLAY2 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:'$G(BWEXT) ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
K N,Z
Q
BWPROF3 ;IHS/ANMC/MWR - DISPLAY PATIENT PROFILE; [ 09/17/2001 7:54 AM ]
+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 PATIENT PROFILE. CALLED BY BWPROF1.
+5 ;
NOMATCH ;EP
+1 ;---> QUIT IF NO RECORDS MATCH.
+2 IF '$DATA(^TMP("BW",$JOB,1))
Begin DoDot:1
+3 DO HEADER2^BWUTL7
+4 KILL BWPRMT,BWPRMT1,BWPRMTQ,DIR
+5 WRITE !!?5,"No records match the selected criteria.",!
+6 ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
IF BWCRT
DO DIRZ^BWUTL3
WRITE @IOF
IF '$GET(BWEXT)
DO ^%ZISC
SET BWPOP=1
End DoDot:1
QUIT
+7 ;
+8 ;---> BWD=1:DETAILED DISPLAY, BWD=0:BRIEF DISPLAY.
+9 IF BWD
DO DISPLAY1
QUIT
+10 DO DISPLAY2
+11 QUIT
+12 ;
+13 ;
DISPLAY1 ;EP
+1 ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
+2 ;---> FROM LINELABEL "END" BELOW.
+3 DO HEADER2^BWUTL7
+4 FOR
SET N=$ORDER(^TMP("BW",$JOB,2,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+5 IF $Y+9>IOSL
IF BWCRT
DO DIRPRMT^BWUTL3
IF BWPOP
QUIT
Begin DoDot:2
+6 SET BWPAGE=BWPAGE+1
+7 DO HEADER2^BWUTL7
SET (BWACCP,Z)=0
End DoDot:2
+8 SET Y=^TMP("BW",$JOB,2,N)
SET M=N
+9 WRITE !
+10 ;
+11 ;---> **********************
+12 ;---> DISPLAY PROCEDURES
+13 ;---> IF PIECE 1=1 DISPLAY AS A PROCEDURE.
+14 IF $PIECE(Y,U)=1
Begin DoDot:2
+15 WRITE !,"------------------------------< "
+16 ;PROCEDURE ABBREVIATION
WRITE "PROCEDURE: ",$PIECE(Y,U,5)," >"
+17 FOR I=1:1:(6-$LENGTH($PIECE(Y,U,5)))
WRITE "-"
+18 WRITE "-----------------------------"
+19 ;BROWSE SELECTION#
WRITE !
IF BWCRT
WRITE $JUSTIFY(N,3),")"
WRITE ?BWTAB
+20 ;ACCESSION#
WRITE $PIECE(Y,U,6)
+21 ;begin Y2K
+22 ;DATE OF PROCEDURE ;IHS/CMI/LAB 17 to 16 Y2000
WRITE ?16,$PIECE(Y,U,4)
+23 ;end Y2K
+24 ;RESULTS/DIAGNOSIS
WRITE ?27,"Res/Diag: ",$PIECE(Y,U,7)
+25 ;PROVIDER
WRITE !?27,"Provider: ",$EXTRACT($PIECE(Y,U,8),1,14)
+26 ;STATUS
WRITE ?62,"Status: ",$PIECE(Y,U,9)
+27 ;STORE AS PREVIOUS ACCESS#
SET BWACCP=$PIECE(Y,U,6)
End DoDot:2
QUIT
+28 ;
+29 ;---> **********************
+30 ;---> DISPLAY NOTIFICATIONS
+31 ;---> IF PIECE 1=2 DISPLAY AS A NOTIFICATION.
+32 IF $PIECE(Y,U)=2
Begin DoDot:2
+33 SET BWACC=$PIECE(Y,U,5)
+34 IF BWACC'=Z
Begin DoDot:3
+35 ;begin Y2K
+36 ;IHS/CMI/LAB 17 to 16 Y2000
WRITE !
IF BWACC["NO ACC#"
WRITE "-----------------"
WRITE ?16
+37 ;end Y2K
+38 WRITE "-------------< NOTIFICATIONS >---------------------------------"
End DoDot:3
+39 ;BROWSE SELECTION#
WRITE !
IF BWCRT
WRITE $JUSTIFY(N,3),")"
WRITE ?BWTAB
+40 ;ACCESSION#
IF BWACC'=BWACCP!(BWACC["NO ACC#")
WRITE BWACC
+41 ;begin Y2K
+42 ;DATE OF PROCEDURE;IHS/CMI/LAB 17 to 16 Y2000
WRITE ?16,$PIECE(Y,U,4)
+43 ;end Y2K
+44 ;TYPE AND PURPOSE
WRITE ?27,$EXTRACT($PIECE(Y,U,6)_": "_$PIECE(Y,U,7),1,53)
+45 ;OUTCOME OF NOTIFICATION
WRITE !?27,"Outcome: ",$EXTRACT($PIECE(Y,U,8),1,23)
+46 ;STATUS
WRITE ?62,"Status: ",$PIECE(Y,U,9)
+47 ;STORE AS PREVIOUS ACC#
SET (BWACCP,Z)=BWACC
+48 ;
+49 ;---> TWO VARIABLES (BWACCP & Z) USED ABOVE: "Z" SAYS "IF THIS NOTIF
+50 ;---> ACC# IS NOT THE SAME AS THE LAST ONE, DISPLAY --<NOT>-- BANNER.
+51 ;---> "BWACCP" SAYS "IF THIS NOTIF ACC# MATCHES THE LAST PROCEDURE'S
+52 ;---> ACC#, DON'T DISPLAY THE ACCESSION#."
+53 ;---> BOTH VARIABLES ARE RESET AFTER A FORMFEED, IN ORDER TO DISPLAY
+54 ;---> ON THE NEW PAGE.
End DoDot:2
QUIT
+55 ;
+56 ;---> **********************
+57 ;---> DISPLAY PAP REGIMENS
+58 ;---> IF PIECE 1=3 DISPLAY AS A PAP REGIMEN.
+59 IF $PIECE(Y,U)=3
Begin DoDot:2
+60 WRITE !,"------------------------------< PAP REGIMEN CHANGE"
+61 WRITE " >----------------------------"
+62 ;begin Y2K
+63 ;IHS/CMI/LAB - 10 to 9 Y2000
WRITE !?9,"Began:"
+64 ;DATE OF REGIMEN ENTRY ;IHS/CMI/LAB 17 to 16 Y2000
WRITE ?16,$PIECE(Y,U,4)
+65 ;end Y2K
+66 ;PAP REGIMEN
WRITE ?27,"Regimen: ",$PIECE(Y,U,5)
End DoDot:2
QUIT
+67 ;
+68 ;---> **********************
+69 ;---> DISPLAY PREGNANCIES
+70 ;---> IF PIECE 1=4 DISPLAY AS A PREGNANCY.
+71 IF $PIECE(Y,U)=4
Begin DoDot:2
+72 WRITE !,"------------------------------< PREGNANCY STATUS"
+73 WRITE " >------------------------------"
+74 ;begin Y2K
+75 ;IHS/CMI/LAB - 8 to 6 patch 5 Y2000
WRITE !?6,"Entered:"
+76 ;DATE OF PREGNANCY EDIT. ;IHS/CMI/LAB - 17 to 15 Y2000
WRITE ?15,$PIECE(Y,U,4)
+77 ;end Y2K
+78 ;PREGNANT/NOT
WRITE ?27,$PIECE(Y,U,5)
+79 ;EDC
IF $PIECE(Y,U,6)]""
WRITE ?50,"EDC: ",$PIECE(Y,U,6)
End DoDot:2
QUIT
End DoDot:1
+80 ;
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 ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
IF '$GET(BWEXT)
DO ^%ZISC
+6 KILL N,Z
+7 QUIT
+8 ;
+9 ;
+10 ;
DISPLAY2 ;EP
+1 ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
+2 ;---> FROM LINELABEL "END" BELOW.
+3 SET BWSUBH="SUBHEAD^BWPROF1"
+4 DO HEADER2^BWUTL7
+5 FOR
SET N=$ORDER(^TMP("BW",$JOB,2,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+6 IF $Y+9>IOSL
IF BWCRT
DO DIRPRMT^BWUTL3
IF BWPOP
QUIT
Begin DoDot:2
+7 SET BWPAGE=BWPAGE+1
+8 DO HEADER2^BWUTL7
SET (BWACCP,Z)=0
End DoDot:2
+9 SET Y=^TMP("BW",$JOB,2,N)
SET M=N
+10 ;---> QUIT IF NOT A PROCEDURE (PIECE 1'=1).
+11 IF $PIECE(Y,U)'=1
QUIT
+12 ;BROWSE SELECTION#
WRITE !
IF BWCRT
WRITE $JUSTIFY(N,3),")"
WRITE ?BWTAB
+13 ;DATE OF PROCEDURE
WRITE $PIECE(Y,U,4)
+14 ;PROCEDURE ABBREVIATION
WRITE ?17,$PIECE(Y,U,5)
+15 ;RESULT
WRITE ?27,$PIECE(Y,U,7)
+16 ;STATUS
WRITE ?71,$PIECE(Y,U,9)
+17 ;STORE AS PREVIOUS ACCESS#
SET BWACCP=$PIECE(Y,U,6)
End DoDot:1
END2 ;EP
+1 IF 'BWCRT
WRITE @IOF
+2 ;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-1 AND START (GOTO)
+3 ;---> DISPLAY2 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 ;IHS/CMI/THL PATCH 8 DON'T CLOSE WHEN EXTERNAL CALL
IF '$GET(BWEXT)
DO ^%ZISC
+6 KILL N,Z
+7 QUIT
