BWBRNOT ;IHS/ANMC/MWR - BROWSE NOTIFICATIONS;03-Sep-2003 20:59;PLS
;;2.0;WOMEN'S HEALTH;**8,9**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "BW BROWSE NOTIFICATIONS" TO BROWSE AND EDIT
;; NOTIFICATIONS.
;
;---> VARIABLES:
;---> BWA: 1=ALL PATIENTS, 0=ONE PATIENT
;---> BWDFN: DFN OF SELECTED PATIENT
;---> DATES: BWBEGDT=BEGINNING DATE, BWENDDT=ENDING DATE
;---> BWB: d=DELINQUENT, o=OPEN, q=queued,
;---> e=ERROR, a=ALL (includes CLOSED).
;---> SORT SEQUENCE IN BWC: 1=DATE, PATIENT, PRIORITY
;---> 2=PATIENT, DATE, PRIORITY
;---> 3=PRIORITY, DATE, PATIENT
;---> USE NODES 3 & 4 IN ^TMP GLOBAL.
;
D SETVARS^BWUTL5
D ^BWBRNOT2 G:BWPOP EXIT
D SORT
D COPYGBL
D ^BWBRNOT1
;
EXIT ;EP
D KILLALL^BWUTL8
Q
;
;
SORT ;EP
;---> SORT AND STORE ARRAY IN ^TMP("BW",$J
K ^TMP("BW",$J)
;---> BWBEGDT1=ONE SECOND BEFORE BEGIN DATE.
;---> BWENDDT1=THE LAST SECOND OF END DATE.
S BWBEGDT1=BWBEGDT-.0001,BWENDDT1=BWENDDT+.9999
;
;**************************
;---> BWA=1: ALL PATIENTS
I BWA D Q
.;---> BY DATE GET EITHER ALL OR OPEN ONLY.
.N BWDFN,BWIEN,Y
.S BWXREF=$S("ae"[BWB:"D",BWB="q":"APRT",1:"AOPEN")
.S BWDATE=BWBEGDT1
.F S BWDATE=$O(^BWNOT(BWXREF,BWDATE)) Q:'BWDATE!(BWDATE>BWENDDT1) D
..S BWIEN=0
..F S BWIEN=$O(^BWNOT(BWXREF,BWDATE,BWIEN)) Q:'BWIEN D
...Q:'$D(^BWNOT(BWIEN,0))
...S Y=^BWNOT(BWIEN,0),BWDFN=$P(Y,U)
...;---> QUIT IF SELECTING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
...I 'BWE Q:$P(^BWP(BWDFN,0),U,10)'=BWCMGR
...;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
...I BWB="d" Q:$P(Y,U,13)'<DT!($P(Y,U,13)="")
...I BWB="e" Q:$P(Y,U,14)'="e"
...D STORE
;
;**************************
;---> BWA=0: ONE PATIENT
N BWIEN,Y S BWIEN=0
F S BWIEN=$O(^BWNOT("B",BWDFN,BWIEN)) Q:'BWIEN D
.S Y=^BWNOT(BWIEN,0)
.;---> QUIT IF NOT WITHIN DATE RANGE.
.S BWDATE=$P(Y,U,2)
.Q:BWDATE'>BWBEGDT1!(BWDATE>BWENDDT1)
.;---> QUIT IF "QUEUED" AND THIS NOTIFICATION IS NOT QUEUED.
.I BWB="q" Q:'$P(Y,U,11) Q:'$D(^BWNOT("APRT",$P(Y,U,11),BWIEN))
.;---> QUIT IF "DELINQUENT" OR OPEN ONLY AND THIS ENTRY IS CLOSED.
.Q:"do"[BWB&($P(Y,U,14)="c")
.I BWB="d" Q:$P(Y,U,13)'<DT!($P(Y,U,13)="")
.I BWB="e" Q:$P(Y,U,14)'="e"
.D STORE
Q
;
STORE ;EP
;--->BWDATE IS ALREADY SET FROM LL SORT ABOVE. ;---> DATE
S BWCHRT=$$HRCN^BWUTL1(BWDFN) ;---> CHART#
S BWNAME=$$NAME^BWUTL1(BWDFN) ;---> NAME
S BWACC=$P(Y,U,6) ;---> ACCESSION#
I BWACC]"" S BWACC=$P(^BWPCD(BWACC,0),U)
S BWSTAT=$$STATUS^BWUTL4 ;---> STATUS
S BWPRIO=9
S:$P(Y,U,4)]"" BWPRIO=$P(^BWNOTP($P(Y,U,4),0),U,2) ;---> PRIORITY
;
S X=BWCHRT_U_BWNAME_U_BWDATE_U_BWACC_U_BWSTAT_U_BWPRIO_U_BWIEN
I BWC=1 S ^TMP("BW",$J,3,BWDATE,BWNAME,BWPRIO,BWIEN)=X Q
I BWC=2 S ^TMP("BW",$J,3,BWNAME,BWDATE,BWPRIO,BWIEN)=X Q
I BWC=3 S ^TMP("BW",$J,3,BWPRIO,BWDATE,BWNAME,BWIEN)=X
Q
;
COPYGBL ;EP
;---> COPY ^TMP("BW",$J,3 TO ^TMP("BW",$J,4 TO MAKE IT FLAT.
N I,M,N,P,Q
S N=0,I=0
F S N=$O(^TMP("BW",$J,3,N)) Q:N="" D
.S M=0
.F S M=$O(^TMP("BW",$J,3,N,M)) Q:M="" D
..S P=0
..F S P=$O(^TMP("BW",$J,3,N,M,P)) Q:P="" D
...S Q=0
...F S Q=$O(^TMP("BW",$J,3,N,M,P,Q)) Q:Q="" D
....S I=I+1,^TMP("BW",$J,4,I)=^TMP("BW",$J,3,N,M,P,Q)
Q
;
;
DEQUEUE ;EP
;---> TASKMAN QUEUE OF PRINTOUT.
D SETVARS^BWUTL5,SORT,COPYGBL,^BWBRNOT1,EXIT
Q
;
FOLLOW(BWDFN) ;EP
;---> CALLED FROM PROCEDURE FOLLOWUP MENU.
N (BWDFN,DT,DTIME,DUZ,M,N,U,X,Z) D SETVARS^BWUTL5
S BWA=0,BWB="o",BWBEGDT=(DT-50000),BWC=1,BWE=1,BWENDDT=DT
D DEVICE^BWBRNOT2 Q:BWPOP
S BWLOOP=1
D SORT,COPYGBL,^BWBRNOT1
Q
BWBRNOT ;IHS/ANMC/MWR - BROWSE NOTIFICATIONS;03-Sep-2003 20:59;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8,9**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CALLED BY OPTION: "BW BROWSE NOTIFICATIONS" TO BROWSE AND EDIT
+4 ;; NOTIFICATIONS.
+5 ;
+6 ;---> VARIABLES:
+7 ;---> BWA: 1=ALL PATIENTS, 0=ONE PATIENT
+8 ;---> BWDFN: DFN OF SELECTED PATIENT
+9 ;---> DATES: BWBEGDT=BEGINNING DATE, BWENDDT=ENDING DATE
+10 ;---> BWB: d=DELINQUENT, o=OPEN, q=queued,
+11 ;---> e=ERROR, a=ALL (includes CLOSED).
+12 ;---> SORT SEQUENCE IN BWC: 1=DATE, PATIENT, PRIORITY
+13 ;---> 2=PATIENT, DATE, PRIORITY
+14 ;---> 3=PRIORITY, DATE, PATIENT
+15 ;---> USE NODES 3 & 4 IN ^TMP GLOBAL.
+16 ;
+17 DO SETVARS^BWUTL5
+18 DO ^BWBRNOT2
IF BWPOP
GOTO EXIT
+19 DO SORT
+20 DO COPYGBL
+21 DO ^BWBRNOT1
+22 ;
EXIT ;EP
+1 DO KILLALL^BWUTL8
+2 QUIT
+3 ;
+4 ;
SORT ;EP
+1 ;---> SORT AND STORE ARRAY IN ^TMP("BW",$J
+2 KILL ^TMP("BW",$JOB)
+3 ;---> BWBEGDT1=ONE SECOND BEFORE BEGIN DATE.
+4 ;---> BWENDDT1=THE LAST SECOND OF END DATE.
+5 SET BWBEGDT1=BWBEGDT-.0001
SET BWENDDT1=BWENDDT+.9999
+6 ;
+7 ;**************************
+8 ;---> BWA=1: ALL PATIENTS
+9 IF BWA
Begin DoDot:1
+10 ;---> BY DATE GET EITHER ALL OR OPEN ONLY.
+11 NEW BWDFN,BWIEN,Y
+12 SET BWXREF=$SELECT("ae"[BWB:"D",BWB="q":"APRT",1:"AOPEN")
+13 SET BWDATE=BWBEGDT1
+14 FOR
SET BWDATE=$ORDER(^BWNOT(BWXREF,BWDATE))
IF 'BWDATE!(BWDATE>BWENDDT1)
QUIT
Begin DoDot:2
+15 SET BWIEN=0
+16 FOR
SET BWIEN=$ORDER(^BWNOT(BWXREF,BWDATE,BWIEN))
IF 'BWIEN
QUIT
Begin DoDot:3
+17 IF '$DATA(^BWNOT(BWIEN,0))
QUIT
+18 SET Y=^BWNOT(BWIEN,0)
SET BWDFN=$PIECE(Y,U)
+19 ;---> QUIT IF SELECTING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
+20 IF 'BWE
IF $PIECE(^BWP(BWDFN,0),U,10)'=BWCMGR
QUIT
+21 ;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
+22 IF BWB="d"
IF $PIECE(Y,U,13)'<DT!($PIECE(Y,U,13)="")
QUIT
+23 IF BWB="e"
IF $PIECE(Y,U,14)'="e"
QUIT
+24 DO STORE
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+25 ;
+26 ;**************************
+27 ;---> BWA=0: ONE PATIENT
+28 NEW BWIEN,Y
SET BWIEN=0
+29 FOR
SET BWIEN=$ORDER(^BWNOT("B",BWDFN,BWIEN))
IF 'BWIEN
QUIT
Begin DoDot:1
+30 SET Y=^BWNOT(BWIEN,0)
+31 ;---> QUIT IF NOT WITHIN DATE RANGE.
+32 SET BWDATE=$PIECE(Y,U,2)
+33 IF BWDATE'>BWBEGDT1!(BWDATE>BWENDDT1)
QUIT
+34 ;---> QUIT IF "QUEUED" AND THIS NOTIFICATION IS NOT QUEUED.
+35 IF BWB="q"
IF '$PIECE(Y,U,11)
QUIT
IF '$DATA(^BWNOT("APRT",$PIECE(Y,U,11),BWIEN))
QUIT
+36 ;---> QUIT IF "DELINQUENT" OR OPEN ONLY AND THIS ENTRY IS CLOSED.
+37 IF "do"[BWB&($PIECE(Y,U,14)="c")
QUIT
+38 IF BWB="d"
IF $PIECE(Y,U,13)'<DT!($PIECE(Y,U,13)="")
QUIT
+39 IF BWB="e"
IF $PIECE(Y,U,14)'="e"
QUIT
+40 DO STORE
End DoDot:1
+41 QUIT
+42 ;
STORE ;EP
+1 ;--->BWDATE IS ALREADY SET FROM LL SORT ABOVE. ;---> DATE
+2 ;---> CHART#
SET BWCHRT=$$HRCN^BWUTL1(BWDFN)
+3 ;---> NAME
SET BWNAME=$$NAME^BWUTL1(BWDFN)
+4 ;---> ACCESSION#
SET BWACC=$PIECE(Y,U,6)
+5 IF BWACC]""
SET BWACC=$PIECE(^BWPCD(BWACC,0),U)
+6 ;---> STATUS
SET BWSTAT=$$STATUS^BWUTL4
+7 SET BWPRIO=9
+8 ;---> PRIORITY
IF $PIECE(Y,U,4)]""
SET BWPRIO=$PIECE(^BWNOTP($PIECE(Y,U,4),0),U,2)
+9 ;
+10 SET X=BWCHRT_U_BWNAME_U_BWDATE_U_BWACC_U_BWSTAT_U_BWPRIO_U_BWIEN
+11 IF BWC=1
SET ^TMP("BW",$JOB,3,BWDATE,BWNAME,BWPRIO,BWIEN)=X
QUIT
+12 IF BWC=2
SET ^TMP("BW",$JOB,3,BWNAME,BWDATE,BWPRIO,BWIEN)=X
QUIT
+13 IF BWC=3
SET ^TMP("BW",$JOB,3,BWPRIO,BWDATE,BWNAME,BWIEN)=X
+14 QUIT
+15 ;
COPYGBL ;EP
+1 ;---> COPY ^TMP("BW",$J,3 TO ^TMP("BW",$J,4 TO MAKE IT FLAT.
+2 NEW I,M,N,P,Q
+3 SET N=0
SET I=0
+4 FOR
SET N=$ORDER(^TMP("BW",$JOB,3,N))
IF N=""
QUIT
Begin DoDot:1
+5 SET M=0
+6 FOR
SET M=$ORDER(^TMP("BW",$JOB,3,N,M))
IF M=""
QUIT
Begin DoDot:2
+7 SET P=0
+8 FOR
SET P=$ORDER(^TMP("BW",$JOB,3,N,M,P))
IF P=""
QUIT
Begin DoDot:3
+9 SET Q=0
+10 FOR
SET Q=$ORDER(^TMP("BW",$JOB,3,N,M,P,Q))
IF Q=""
QUIT
Begin DoDot:4
+11 SET I=I+1
SET ^TMP("BW",$JOB,4,I)=^TMP("BW",$JOB,3,N,M,P,Q)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;
DEQUEUE ;EP
+1 ;---> TASKMAN QUEUE OF PRINTOUT.
+2 DO SETVARS^BWUTL5
DO SORT
DO COPYGBL
DO ^BWBRNOT1
DO EXIT
+3 QUIT
+4 ;
FOLLOW(BWDFN) ;EP
+1 ;---> CALLED FROM PROCEDURE FOLLOWUP MENU.
+2 NEW (BWDFN,DT,DTIME,DUZ,M,N,U,X,Z)
DO SETVARS^BWUTL5
+3 SET BWA=0
SET BWB="o"
SET BWBEGDT=(DT-50000)
SET BWC=1
SET BWE=1
SET BWENDDT=DT
+4 DO DEVICE^BWBRNOT2
IF BWPOP
QUIT
+5 SET BWLOOP=1
+6 DO SORT
DO COPYGBL
DO ^BWBRNOT1
+7 QUIT
