source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVBRNED.m@ 1154

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