Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWBRNED

BWBRNED.m

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