BWBRNOT.m

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