source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVBRNED.m@ 846

WVBRNED ;HCIOFO/FT,JR-BROWSE TX NEEDS PAST DUE; ;6/1/99  13:42

 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998

 ;;  Original routine created by IHS/ANMC/MWR

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  CALLED BY OPTION: "WV 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^WVUTL5 K WVRES

 D TITLE^WVUTL5("BREAST & CERVICAL TX NEEDS PAST DUE REPORT")

 D UNDETER G:WVPOP EXIT

 D ASKDATE G:WVPOP EXIT

 D CMGR    G:WVPOP EXIT

 D ORDER   G:WVPOP EXIT

 D DEVICE  G:WVPOP EXIT

 D SORT

 D COPYGBL

 D ^WVBRNED1

 ;

EXIT ;EP

 D KILLALL^WVUTL8

 Q

 ;

 ;

UNDETER ;EP

 ;---> ASK TO INCLUDE CASES WITH UNDETERMINED OR UNDATED NEEDS.

 ;---> WVA=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 WVA=0,DIR(0)="YA",DIR("B")="YES" D HELP1^WVBRNEDH

 D ^DIR W !

 S:$D(DIRUT) WVPOP=1

 I Y S WVA=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^WVBRNEDH

 D ^DIR

 I $D(DIRUT) S WVPOP=1 Q

 S WVDDATE=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(^WV(790.02,DUZ(2),0)) S WVE=1 Q

 I '$P(^WV(790.02,DUZ(2),0),U,5) S WVE=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",WVMGR=""

 S DIR(0)="SAM^o:ONE;a:ALL" D HELP3^WVBRNEDH

 D ^DIR K DIR

 I Y=-1!($D(DIRUT)) S WVPOP=1 Q

 ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.

 I Y="a" S WVE=1 Q

 ;

 W !!,"   Select the Case Manager whose patients you wish to browse."

 D DIC^WVFMAN(790.01,"QEMA",.Y,"   Select CASE MANAGER: ")

 I Y<0 S WVPOP=1 Q

 ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVMGR=^VA(200 DFN, QUIT.

 S WVMGR=+Y,WVE=0

 Q

 ;

 ;

ORDER ;EP

 ;---> ASK ORDER BY DATE DELINQUENT OR BY PATIENT NAME.

 ;---> SORT SEQUENCE IN WVB:  1=DELINQ DATE (DEFAULT), 2=PATIENT NAME

 ;---> 3=PRIMARY CARE PROVIDER

 N DIR,DIRUT,Y S WVB=1

 W !!?3,"Display Procedures in order of:"

 W ?37,"1) DATE DELINQUENT (earliest first)"

 W !?37,"2) PATIENT NAME (alphabetically)"

 W !?37,"3) PRIMARY CARE PROVIDER (alphabetically)"

 S DIR("A")="   Selection ",DIR("B")=1

 S DIR(0)="SAM^1:DATE DELINQUENT;2:PATIENT NAME;3:PRIMARY CARE PROVIDER"

 D HELP2^WVBRNEDH

 D ^DIR K DIR

 I Y=-1!($D(DIRUT)) S WVPOP=1 Q

 S WVB=Y

 Q

 ;

DEVICE ;EP

 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 S ZTRTN="DEQUEUE^WVBRNED"

 F WVSV="A","B","E","DDATE","MGR" D

 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""

 ;---> SAVE CURRENT COMMUNITY ARRAY.

 I $D(WVCC) N N S N=0 F  S N=$O(WVCC(N)) Q:N=""  D

 .S ZTSAVE("WVCC("""_N_""")")=""

 D ZIS^WVUTL2(.WVPOP,1,"HOME")

 Q

 ;

SORT ;EP

 ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,

 ;---> WVA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.

 ;---> 5 & 8 ARE IENS IN ^WV(790.5, AND ^WV(790.51 GLOBALS FOR "UNDETERMINED".

 ;

 K ^TMP("WV",$J) N N,Y,WVBRTXND,WVCXTXND

 S N=0

 S WVBRTXND=$$IEN^WVUTL9(790.51,"Not Indicated")

 S WVCXTXND=$$IEN^WVUTL9(790.5,"Not Indicated")

 F  S N=$O(^WV(790,N)) Q:'N  D

 .S Y=^WV(790,N,0)

 .;---> QUIT IF PATIENT IS INACTIVE.

 .Q:$P(Y,U,24)

 .;---> IF DEAD, SET INACTIVE DATE TO DATE OF DEATH

 .I $$DECEASED^WVUTL1($P(Y,U)) D

 ..N DA,DR,DIE

 ..S DIE="^WV(790,",DA=$P(Y,U)

 ..S DR=".24////"_$P($$GET1^DIQ(2,DA,.351,"I"),".") ;date only

 ..N X,Y

 ..D ^DIE

 ..Q

 .;---> QUIT IF BOTH TX NEEDS ARE "NOT INDICATED"

 .I $P(Y,U,18)=WVBRTXND,$P(Y,U,11)=WVCXTXND Q

 .;---> QUIT IF LOOKING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.

 .I 'WVE Q:$P(Y,U,10)'=WVMGR

 .;---> IF WVA=0, DON'T INCLUDE BECAUSE OF UNDETERMINED NEEDS.

 .I 'WVA D  Q

 ..;---> ONLY IF IT'S A SPECIFIED NEED AND IT'S DELINQUENT, INCLUDE.

 ..I 5'[$P(Y,U,11)&($P(Y,U,12)<WVDDATE) D SET Q

 ..I 8'[$P(Y,U,18)&($P(Y,U,19)<WVDDATE) D SET Q

 .;---> IF WVA=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)<WVDDATE!($P(Y,U,19)<WVDDATE) D SET

 Q

 ;

 ;

COPYGBL ;EP

 ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.

 N I,M,N

 S N=-1,I=0

 F  S N=$O(^TMP("WV",$J,1,N)) Q:N=""  D

 .S M=-1

 .F  S M=$O(^TMP("WV",$J,1,N,M)) Q:M=""  D

 ..S I=I+1,^TMP("WV",$J,2,I)=^TMP("WV",$J,1,N,M)

 Q

 ;

SET ;EP

 ;---> SORT SEQUENCE IN WVB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME

 ;---> 3=PRIMARY CARE PROVIDER

 N Z S WVDFN=$P(Y,U) D PATVARS^WVUTL3(WVDFN)

 S Z=WVCHRT_U_WVNAME_U_WVCMGR_U_WVCNEED_U_WVBNEED_U_WVDFN

 S WVJPCP=$$PROVI^WVUTL1A(WVDFN)

 I WVB=1 D  Q

 .S WVPDAT=+$P(Y,U,12),WVMDAT=+$P(Y,U,19)

 .I WVPDAT,WVMDAT S ^TMP("WV",$J,1,$S(WVPDAT<WVMDAT:WVPDAT,1:WVMDAT),WVNAME)=Z Q

 .I WVPDAT S ^TMP("WV",$J,1,WVPDAT,WVNAME)=Z Q

 .S ^TMP("WV",$J,1,WVMDAT,WVNAME)=Z

 .Q

 I WVB=2 S ^TMP("WV",$J,1,WVNAME,WVDFN)=Z

 I WVB=3 S ^TMP("WV",$J,1,WVJPCP,WVNAME)=Z

 Q

 ;

 ;

DEQUEUE ;EP

 ;---> TASKMAN QUEUE OF PRINTOUT.

 D SETVARS^WVUTL5,SORT,COPYGBL,^WVBRNED1,EXIT

 Q

 ;

PRINTX ;EP

 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)

 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)

 Q