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

WVBRNED.m

Go to the documentation of this file.
  1. WVBRNED ;HCIOFO/FT,JR-BROWSE TX NEEDS PAST DUE; ;6/1/99 13:42
  1. ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
  1. ;; Original routine created by IHS/ANMC/MWR
  1. ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1. ;; CALLED BY OPTION: "WV 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^WVUTL5 K WVRES
  1. D TITLE^WVUTL5("BREAST & CERVICAL TX NEEDS PAST DUE REPORT")
  1. D UNDETER G:WVPOP EXIT
  1. D ASKDATE G:WVPOP EXIT
  1. D CMGR G:WVPOP EXIT
  1. D ORDER G:WVPOP EXIT
  1. D DEVICE G:WVPOP EXIT
  1. D SORT
  1. D COPYGBL
  1. D ^WVBRNED1
  1. ;
  1. EXIT ;EP
  1. D KILLALL^WVUTL8
  1. Q
  1. ;
  1. ;
  1. UNDETER ;EP
  1. ;---> ASK TO INCLUDE CASES WITH UNDETERMINED OR UNDATED NEEDS.
  1. ;---> WVA=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 WVA=0,DIR(0)="YA",DIR("B")="YES" D HELP1^WVBRNEDH
  1. D ^DIR W !
  1. S:$D(DIRUT) WVPOP=1
  1. I Y S WVA=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^WVBRNEDH
  1. D ^DIR
  1. I $D(DIRUT) S WVPOP=1 Q
  1. S WVDDATE=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(^WV(790.02,DUZ(2),0)) S WVE=1 Q
  1. I '$P(^WV(790.02,DUZ(2),0),U,5) S WVE=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",WVMGR=""
  1. S DIR(0)="SAM^o:ONE;a:ALL" D HELP3^WVBRNEDH
  1. D ^DIR K DIR
  1. I Y=-1!($D(DIRUT)) S WVPOP=1 Q
  1. ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
  1. I Y="a" S WVE=1 Q
  1. ;
  1. W !!," Select the Case Manager whose patients you wish to browse."
  1. D DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
  1. I Y<0 S WVPOP=1 Q
  1. ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVMGR=^VA(200 DFN, QUIT.
  1. S WVMGR=+Y,WVE=0
  1. Q
  1. ;
  1. ;
  1. ORDER ;EP
  1. ;---> ASK ORDER BY DATE DELINQUENT OR BY PATIENT NAME.
  1. ;---> SORT SEQUENCE IN WVB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
  1. ;---> 3=PRIMARY CARE PROVIDER
  1. N DIR,DIRUT,Y S WVB=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. W !?37,"3) PRIMARY CARE PROVIDER (alphabetically)"
  1. S DIR("A")=" Selection ",DIR("B")=1
  1. S DIR(0)="SAM^1:DATE DELINQUENT;2:PATIENT NAME;3:PRIMARY CARE PROVIDER"
  1. D HELP2^WVBRNEDH
  1. D ^DIR K DIR
  1. I Y=-1!($D(DIRUT)) S WVPOP=1 Q
  1. S WVB=Y
  1. Q
  1. ;
  1. DEVICE ;EP
  1. ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
  1. S ZTRTN="DEQUEUE^WVBRNED"
  1. F WVSV="A","B","E","DDATE","MGR" D
  1. .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
  1. ;---> SAVE CURRENT COMMUNITY ARRAY.
  1. I $D(WVCC) N N S N=0 F S N=$O(WVCC(N)) Q:N="" D
  1. .S ZTSAVE("WVCC("""_N_""")")=""
  1. D ZIS^WVUTL2(.WVPOP,1,"HOME")
  1. Q
  1. ;
  1. SORT ;EP
  1. ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,
  1. ;---> WVA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
  1. ;---> 5 & 8 ARE IENS IN ^WV(790.5, AND ^WV(790.51 GLOBALS FOR "UNDETERMINED".
  1. ;
  1. K ^TMP("WV",$J) N N,Y,WVBRTXND,WVCXTXND
  1. S N=0
  1. S WVBRTXND=$$IEN^WVUTL9(790.51,"Not Indicated")
  1. S WVCXTXND=$$IEN^WVUTL9(790.5,"Not Indicated")
  1. F S N=$O(^WV(790,N)) Q:'N D
  1. .S Y=^WV(790,N,0)
  1. .;---> QUIT IF PATIENT IS INACTIVE.
  1. .Q:$P(Y,U,24)
  1. .;---> IF DEAD, SET INACTIVE DATE TO DATE OF DEATH
  1. .I $$DECEASED^WVUTL1($P(Y,U)) D
  1. ..N DA,DR,DIE
  1. ..S DIE="^WV(790,",DA=$P(Y,U)
  1. ..S DR=".24////"_$P($$GET1^DIQ(2,DA,.351,"I"),".") ;date only
  1. ..N X,Y
  1. ..D ^DIE
  1. ..Q
  1. .;---> QUIT IF BOTH TX NEEDS ARE "NOT INDICATED"
  1. .I $P(Y,U,18)=WVBRTXND,$P(Y,U,11)=WVCXTXND Q
  1. .;---> QUIT IF LOOKING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
  1. .I 'WVE Q:$P(Y,U,10)'=WVMGR
  1. .;---> IF WVA=0, DON'T INCLUDE BECAUSE OF UNDETERMINED NEEDS.
  1. .I 'WVA 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)<WVDDATE) D SET Q
  1. ..I 8'[$P(Y,U,18)&($P(Y,U,19)<WVDDATE) D SET Q
  1. .;---> IF WVA=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)<WVDDATE!($P(Y,U,19)<WVDDATE) D SET
  1. Q
  1. ;
  1. ;
  1. COPYGBL ;EP
  1. ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.
  1. N I,M,N
  1. S N=-1,I=0
  1. F S N=$O(^TMP("WV",$J,1,N)) Q:N="" D
  1. .S M=-1
  1. .F S M=$O(^TMP("WV",$J,1,N,M)) Q:M="" D
  1. ..S I=I+1,^TMP("WV",$J,2,I)=^TMP("WV",$J,1,N,M)
  1. Q
  1. ;
  1. SET ;EP
  1. ;---> SORT SEQUENCE IN WVB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
  1. ;---> 3=PRIMARY CARE PROVIDER
  1. N Z S WVDFN=$P(Y,U) D PATVARS^WVUTL3(WVDFN)
  1. S Z=WVCHRT_U_WVNAME_U_WVCMGR_U_WVCNEED_U_WVBNEED_U_WVDFN
  1. S WVJPCP=$$PROVI^WVUTL1A(WVDFN)
  1. I WVB=1 D Q
  1. .S WVPDAT=+$P(Y,U,12),WVMDAT=+$P(Y,U,19)
  1. .I WVPDAT,WVMDAT S ^TMP("WV",$J,1,$S(WVPDAT<WVMDAT:WVPDAT,1:WVMDAT),WVNAME)=Z Q
  1. .I WVPDAT S ^TMP("WV",$J,1,WVPDAT,WVNAME)=Z Q
  1. .S ^TMP("WV",$J,1,WVMDAT,WVNAME)=Z
  1. .Q
  1. I WVB=2 S ^TMP("WV",$J,1,WVNAME,WVDFN)=Z
  1. I WVB=3 S ^TMP("WV",$J,1,WVJPCP,WVNAME)=Z
  1. Q
  1. ;
  1. ;
  1. DEQUEUE ;EP
  1. ;---> TASKMAN QUEUE OF PRINTOUT.
  1. D SETVARS^WVUTL5,SORT,COPYGBL,^WVBRNED1,EXIT
  1. Q
  1. ;
  1. PRINTX ;EP
  1. N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
  1. F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
  1. Q