177 lines
5.2 KiB
Mathematica
177 lines
5.2 KiB
Mathematica
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
|