BWBRNED ;IHS/ANMC/MWR - BROWSE TX NEEDS PAST DUE;11-Feb-2003 13:36;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "BW BROWSE NEEDS PAST DUE" TO BROWSE AND
;; EDIT PATIENTS WITH TREATMENT NEEDS PAST DUE.
;
;---> USE NODES 1 & 2 IN ^TMP GLOBAL.
;
BEGIN ;EP
D SETVARS^BWUTL5 K BWRES
D TITLE^BWUTL5("BREAST & CERVICAL TX NEEDS PAST DUE REPORT")
D UNDETER G:BWPOP EXIT
D ASKDATE G:BWPOP EXIT
D CMGR G:BWPOP EXIT
D CURCOM G:BWPOP EXIT
D ORDER G:BWPOP EXIT
D DEVICE G:BWPOP EXIT
D SORT
D COPYGBL
D ^BWBRNED1
;
EXIT ;EP
D KILLALL^BWUTL8
Q
;
;
UNDETER ;EP
;---> ASK TO INCLUDE CASES WITH UNDETERMINED OR UNDATED NEEDS.
;---> BWA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
N DIR,DIRUT,Y
W !!?3,"Include patients whose Breast or Cervical Tx Needs are "
W "undetermined?"
N DIR S DIR("A")=" Enter Yes or No: "
S BWA=0,DIR(0)="YA",DIR("B")="YES" D HELP1^BWBRNEDH
D ^DIR W !
S:$D(DIRUT) BWPOP=1
I Y S BWA=1 Q
Q
;
;
ASKDATE ;EP
;---> ASK FOR DATE BY WHICH NEEDS WILL BE DELINQUENT.
N DIR,DIRUT,Y
W !!?3,"Select the date to be checked for patient Tx Needs past due:"
S DIR(0)="D^::EX",DIR("A")=" Select a date"
S DIR("B")="TODAY" D HELP4^BWBRNEDH
D ^DIR
I $D(DIRUT) S BWPOP=1 Q
S BWDDATE=Y
Q
;
;
CMGR ;EP
;---> SELECT CASES FOR ONE CASE MANAGER OR ALL.
;---> DO NOT PROMPT FOR CASE MANAGER IF SITE PARAMETERS SAY NOT TO.
I '$D(^BWSITE(DUZ(2),0)) S BWE=1 Q
I '$P(^BWSITE(DUZ(2),0),U,5) S BWE=1 Q
W !!?3,"Report on all patients for ONE particular Case Manager,"
W !?3,"or report on all patients for ALL Case Managers?"
N DIR,DIRUT,Y
S DIR("A")=" Select ONE or ALL: ",DIR("B")="ALL",BWMGR=""
S DIR(0)="SAM^o:ONE;a:ALL" D HELP3^BWBRNEDH
D ^DIR K DIR
I Y=-1!($D(DIRUT)) S BWPOP=1 Q
;---> IF ALL CASE MANAGERS, S BWE=1 AND QUIT.
I Y="a" S BWE=1 Q
;
W !!," Select the Case Manager whose patients you wish to browse."
D DIC^BWFMAN(9002086.01,"QEMA",.Y," Select CASE MANAGER: ")
I Y<0 S BWPOP=1 Q
;---> FOR ONE CASE MANAGER, SET BWE=0 AND BWMGR=^VA(200 DFN, QUIT.
S BWMGR=+Y,BWE=0
Q
;
;
CURCOM ;EP
;---> SELECT CASES FOR ONE OR MORE CURRENT COMMUNITY (OR ALL).
;---> DO NOT PROMPT FOR CURRENT COMMUNITY IF THIS IS A VA SITE.
I $$AGENCY^BWUTL5(DUZ(2))'="i" S BWCC("ALL")="" Q ;VAMOD
;---> SELECT CURRENT COMMUNITY(S).
D TEXT1
D SELECT^BWSELECT("Current Community",9999999.05,"BWCC","","",.BWPOP)
Q
;
ORDER ;EP
;---> ASK ORDER BY DATE DELINQUENT OR BY PATIENT NAME.
;---> SORT SEQUENCE IN BWB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
N DIR,DIRUT,Y S BWB=1
W !!?3,"Display Procedures in order of:"
W ?37,"1) DATE DELINQUENT (earliest first)"
W !?37,"2) PATIENT NAME (alphabetically)"
S DIR("A")=" Select 1 or 2: ",DIR("B")=1
S DIR(0)="SAM^1:DATE DELINQUENT;2:PATIENT NAME" D HELP2^BWBRNEDH
D ^DIR K DIR
I Y=-1!($D(DIRUT)) S BWPOP=1 Q
S BWB=Y
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DEQUEUE^BWBRNED"
F BWSV="A","B","E","DDATE","MGR" D
.I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""
;---> SAVE CURRENT COMMUNITY ARRAY.
I $D(BWCC) N N S N=0 F S N=$O(BWCC(N)) Q:N="" D
.S ZTSAVE("BWCC("""_N_""")")=""
D ZIS^BWUTL2(.BWPOP,1,"HOME")
Q
;
SORT ;EP
;---> SORT AND STORE LOCAL ARRAY IN ^TMP("BW",$J,1,
;---> BWA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
;---> 5 & 8 ARE IENS IN ^BWCUR AND ^BWMAMT GLOBALS FOR "UNDETERMINED".
;
K ^TMP("BW",$J) N N,Y
S N=0
F S N=$O(^BWP(N)) Q:'N D
.S Y=^BWP(N,0)
.;---> QUIT IF PATIENT IS INACTIVE.
.Q:$P(Y,U,24)
.;---> QUIT IF LOOKING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
.I 'BWE Q:$P(Y,U,10)'=BWMGR
.;---> QUIT IF NOT SELECTING ALL CURRENT COMMUNITIES AND IF THIS
.;---> IS NOT ONE OF THE SELECETED.
.I '$D(BWCC("ALL")) S X=$$CURCOM^BWUTL1(N) Q:'X Q:'$D(BWCC(X))
.;---> IF BWA=0, DON'T INCLUDE BECAUSE OF UNDETERMINED NEEDS.
.I 'BWA D Q
..;---> ONLY IF IT'S A SPECIFIED NEED AND IT'S DELINQUENT, INCLUDE.
..I 5'[$P(Y,U,11)&($P(Y,U,12)<BWDDATE) D SET Q
..I 8'[$P(Y,U,18)&($P(Y,U,19)<BWDDATE) D SET Q
.;---> IF BWA=1, INCLUDE BECAUSE OF UNDETERMINED NEEDS.
.I 5[$P(Y,U,11)!(8[$P(Y,U,18)) D SET Q
.;---> IF EITHER NEED IS DELINQUENT, INCLUDE.
.I $P(Y,U,12)<BWDDATE!($P(Y,U,19)<BWDDATE) D SET
Q
;
;
COPYGBL ;EP
;---> COPY ^TMP("BW",$J,1 TO ^TMP("BW",$J,2 TO MAKE IT FLAT.
N I,M,N
S N=-1,I=0
F S N=$O(^TMP("BW",$J,1,N)) Q:N="" D
.S M=-1
.F S M=$O(^TMP("BW",$J,1,N,M)) Q:M="" D
..S I=I+1,^TMP("BW",$J,2,I)=^TMP("BW",$J,1,N,M)
Q
;
SET ;EP
;---> SORT SEQUENCE IN BWB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
N Z S BWDFN=$P(Y,U) D PATVARS^BWUTL3(BWDFN)
S Z=BWCHRT_U_BWNAME_U_BWCMGR_U_BWCNEED_U_BWBNEED_U_BWDFN
I BWB=1 D Q
.S BWPDAT=+$P(Y,U,12),BWMDAT=+$P(Y,U,19)
.S ^TMP("BW",$J,1,$S(BWPDAT<BWMDAT:BWPDAT,1:BWMDAT),BWNAME)=Z
S ^TMP("BW",$J,1,BWNAME,BWDFN)=Z
Q
;
;
DEQUEUE ;EP
;---> TASKMAN QUEUE OF PRINTOUT.
D SETVARS^BWUTL5,SORT,COPYGBL,^BWBRNED1,EXIT
Q
;
TEXT1 ;EP
;;
;;You may browse needs for patients living in one or more specific
;;communities, or you may select all communities. "Community" in this
;;context refers to the patient's "Current Community" as displayed and
;;edited in the IHS Registration software.
S BWTAB=3,BWLINL="TEXT1" D PRINTX
Q
;
PRINTX ;EP
N I,T,X S T="" F I=1:1:BWTAB S T=T_" "
F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
BWBRNED ;IHS/ANMC/MWR - BROWSE TX NEEDS PAST DUE;11-Feb-2003 13:36;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CALLED BY OPTION: "BW BROWSE NEEDS PAST DUE" TO BROWSE AND
+4 ;; EDIT PATIENTS WITH TREATMENT NEEDS PAST DUE.
+5 ;
+6 ;---> USE NODES 1 & 2 IN ^TMP GLOBAL.
+7 ;
BEGIN ;EP
+1 DO SETVARS^BWUTL5
KILL BWRES
+2 DO TITLE^BWUTL5("BREAST & CERVICAL TX NEEDS PAST DUE REPORT")
+3 DO UNDETER
IF BWPOP
GOTO EXIT
+4 DO ASKDATE
IF BWPOP
GOTO EXIT
+5 DO CMGR
IF BWPOP
GOTO EXIT
+6 DO CURCOM
IF BWPOP
GOTO EXIT
+7 DO ORDER
IF BWPOP
GOTO EXIT
+8 DO DEVICE
IF BWPOP
GOTO EXIT
+9 DO SORT
+10 DO COPYGBL
+11 DO ^BWBRNED1
+12 ;
EXIT ;EP
+1 DO KILLALL^BWUTL8
+2 QUIT
+3 ;
+4 ;
UNDETER ;EP
+1 ;---> ASK TO INCLUDE CASES WITH UNDETERMINED OR UNDATED NEEDS.
+2 ;---> BWA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
+3 NEW DIR,DIRUT,Y
+4 WRITE !!?3,"Include patients whose Breast or Cervical Tx Needs are "
+5 WRITE "undetermined?"
+6 NEW DIR
SET DIR("A")=" Enter Yes or No: "
+7 SET BWA=0
SET DIR(0)="YA"
SET DIR("B")="YES"
DO HELP1^BWBRNEDH
+8 DO ^DIR
WRITE !
+9 IF $DATA(DIRUT)
SET BWPOP=1
+10 IF Y
SET BWA=1
QUIT
+11 QUIT
+12 ;
+13 ;
ASKDATE ;EP
+1 ;---> ASK FOR DATE BY WHICH NEEDS WILL BE DELINQUENT.
+2 NEW DIR,DIRUT,Y
+3 WRITE !!?3,"Select the date to be checked for patient Tx Needs past due:"
+4 SET DIR(0)="D^::EX"
SET DIR("A")=" Select a date"
+5 SET DIR("B")="TODAY"
DO HELP4^BWBRNEDH
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET BWPOP=1
QUIT
+8 SET BWDDATE=Y
+9 QUIT
+10 ;
+11 ;
CMGR ;EP
+1 ;---> SELECT CASES FOR ONE CASE MANAGER OR ALL.
+2 ;---> DO NOT PROMPT FOR CASE MANAGER IF SITE PARAMETERS SAY NOT TO.
+3 IF '$DATA(^BWSITE(DUZ(2),0))
SET BWE=1
QUIT
+4 IF '$PIECE(^BWSITE(DUZ(2),0),U,5)
SET BWE=1
QUIT
+5 WRITE !!?3,"Report on all patients for ONE particular Case Manager,"
+6 WRITE !?3,"or report on all patients for ALL Case Managers?"
+7 NEW DIR,DIRUT,Y
+8 SET DIR("A")=" Select ONE or ALL: "
SET DIR("B")="ALL"
SET BWMGR=""
+9 SET DIR(0)="SAM^o:ONE;a:ALL"
DO HELP3^BWBRNEDH
+10 DO ^DIR
KILL DIR
+11 IF Y=-1!($DATA(DIRUT))
SET BWPOP=1
QUIT
+12 ;---> IF ALL CASE MANAGERS, S BWE=1 AND QUIT.
+13 IF Y="a"
SET BWE=1
QUIT
+14 ;
+15 WRITE !!," Select the Case Manager whose patients you wish to browse."
+16 DO DIC^BWFMAN(9002086.01,"QEMA",.Y," Select CASE MANAGER: ")
+17 IF Y<0
SET BWPOP=1
QUIT
+18 ;---> FOR ONE CASE MANAGER, SET BWE=0 AND BWMGR=^VA(200 DFN, QUIT.
+19 SET BWMGR=+Y
SET BWE=0
+20 QUIT
+21 ;
+22 ;
CURCOM ;EP
+1 ;---> SELECT CASES FOR ONE OR MORE CURRENT COMMUNITY (OR ALL).
+2 ;---> DO NOT PROMPT FOR CURRENT COMMUNITY IF THIS IS A VA SITE.
+3 ;VAMOD
IF $$AGENCY^BWUTL5(DUZ(2))'="i"
SET BWCC("ALL")=""
QUIT
+4 ;---> SELECT CURRENT COMMUNITY(S).
+5 DO TEXT1
+6 DO SELECT^BWSELECT("Current Community",9999999.05,"BWCC","","",.BWPOP)
+7 QUIT
+8 ;
ORDER ;EP
+1 ;---> ASK ORDER BY DATE DELINQUENT OR BY PATIENT NAME.
+2 ;---> SORT SEQUENCE IN BWB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
+3 NEW DIR,DIRUT,Y
SET BWB=1
+4 WRITE !!?3,"Display Procedures in order of:"
+5 WRITE ?37,"1) DATE DELINQUENT (earliest first)"
+6 WRITE !?37,"2) PATIENT NAME (alphabetically)"
+7 SET DIR("A")=" Select 1 or 2: "
SET DIR("B")=1
+8 SET DIR(0)="SAM^1:DATE DELINQUENT;2:PATIENT NAME"
DO HELP2^BWBRNEDH
+9 DO ^DIR
KILL DIR
+10 IF Y=-1!($DATA(DIRUT))
SET BWPOP=1
QUIT
+11 SET BWB=Y
+12 QUIT
+13 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^BWBRNED"
+3 FOR BWSV="A","B","E","DDATE","MGR"
Begin DoDot:1
+4 IF $DATA(@("BW"_BWSV))
SET ZTSAVE("BW"_BWSV)=""
End DoDot:1
+5 ;---> SAVE CURRENT COMMUNITY ARRAY.
+6 IF $DATA(BWCC)
NEW N
SET N=0
FOR
SET N=$ORDER(BWCC(N))
IF N=""
QUIT
Begin DoDot:1
+7 SET ZTSAVE("BWCC("""_N_""")")=""
End DoDot:1
+8 DO ZIS^BWUTL2(.BWPOP,1,"HOME")
+9 QUIT
+10 ;
SORT ;EP
+1 ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("BW",$J,1,
+2 ;---> BWA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
+3 ;---> 5 & 8 ARE IENS IN ^BWCUR AND ^BWMAMT GLOBALS FOR "UNDETERMINED".
+4 ;
+5 KILL ^TMP("BW",$JOB)
NEW N,Y
+6 SET N=0
+7 FOR
SET N=$ORDER(^BWP(N))
IF 'N
QUIT
Begin DoDot:1
+8 SET Y=^BWP(N,0)
+9 ;---> QUIT IF PATIENT IS INACTIVE.
+10 IF $PIECE(Y,U,24)
QUIT
+11 ;---> QUIT IF LOOKING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
+12 IF 'BWE
IF $PIECE(Y,U,10)'=BWMGR
QUIT
+13 ;---> QUIT IF NOT SELECTING ALL CURRENT COMMUNITIES AND IF THIS
+14 ;---> IS NOT ONE OF THE SELECETED.
+15 IF '$DATA(BWCC("ALL"))
SET X=$$CURCOM^BWUTL1(N)
IF 'X
QUIT
IF '$DATA(BWCC(X))
QUIT
+16 ;---> IF BWA=0, DON'T INCLUDE BECAUSE OF UNDETERMINED NEEDS.
+17 IF 'BWA
Begin DoDot:2
+18 ;---> ONLY IF IT'S A SPECIFIED NEED AND IT'S DELINQUENT, INCLUDE.
+19 IF 5'[$PIECE(Y,U,11)&($PIECE(Y,U,12)<BWDDATE)
DO SET
QUIT
+20 IF 8'[$PIECE(Y,U,18)&($PIECE(Y,U,19)<BWDDATE)
DO SET
QUIT
End DoDot:2
QUIT
+21 ;---> IF BWA=1, INCLUDE BECAUSE OF UNDETERMINED NEEDS.
+22 IF 5[$PIECE(Y,U,11)!(8[$PIECE(Y,U,18))
DO SET
QUIT
+23 ;---> IF EITHER NEED IS DELINQUENT, INCLUDE.
+24 IF $PIECE(Y,U,12)<BWDDATE!($PIECE(Y,U,19)<BWDDATE)
DO SET
End DoDot:1
+25 QUIT
+26 ;
+27 ;
COPYGBL ;EP
+1 ;---> COPY ^TMP("BW",$J,1 TO ^TMP("BW",$J,2 TO MAKE IT FLAT.
+2 NEW I,M,N
+3 SET N=-1
SET I=0
+4 FOR
SET N=$ORDER(^TMP("BW",$JOB,1,N))
IF N=""
QUIT
Begin DoDot:1
+5 SET M=-1
+6 FOR
SET M=$ORDER(^TMP("BW",$JOB,1,N,M))
IF M=""
QUIT
Begin DoDot:2
+7 SET I=I+1
SET ^TMP("BW",$JOB,2,I)=^TMP("BW",$JOB,1,N,M)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SET ;EP
+1 ;---> SORT SEQUENCE IN BWB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
+2 NEW Z
SET BWDFN=$PIECE(Y,U)
DO PATVARS^BWUTL3(BWDFN)
+3 SET Z=BWCHRT_U_BWNAME_U_BWCMGR_U_BWCNEED_U_BWBNEED_U_BWDFN
+4 IF BWB=1
Begin DoDot:1
+5 SET BWPDAT=+$PIECE(Y,U,12)
SET BWMDAT=+$PIECE(Y,U,19)
+6 SET ^TMP("BW",$JOB,1,$SELECT(BWPDAT<BWMDAT:BWPDAT,1:BWMDAT),BWNAME)=Z
End DoDot:1
QUIT
+7 SET ^TMP("BW",$JOB,1,BWNAME,BWDFN)=Z
+8 QUIT
+9 ;
+10 ;
DEQUEUE ;EP
+1 ;---> TASKMAN QUEUE OF PRINTOUT.
+2 DO SETVARS^BWUTL5
DO SORT
DO COPYGBL
DO ^BWBRNED1
DO EXIT
+3 QUIT
+4 ;
TEXT1 ;EP
+1 ;;
+2 ;;You may browse needs for patients living in one or more specific
+3 ;;communities, or you may select all communities. "Community" in this
+4 ;;context refers to the patient's "Current Community" as displayed and
+5 ;;edited in the IHS Registration software.
+6 SET BWTAB=3
SET BWLINL="TEXT1"
DO PRINTX
+7 QUIT
+8 ;
PRINTX ;EP
+1 NEW I,T,X
SET T=""
FOR I=1:1:BWTAB
SET T=T_" "
+2 FOR I=1:1
SET X=$TEXT(@BWLINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+3 QUIT
