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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVBRNED 5535 printed Dec 13, 2024@02:46:43 Page 2
WVBRNED ;HCIOFO/FT,JR-BROWSE TX NEEDS PAST DUE; ;6/1/99 13:42
+1 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; CALLED BY OPTION: "WV BROWSE NEEDS PAST DUE" TO BROWSE AND
+5 ;; EDIT PATIENTS WITH TREATMENT NEEDS PAST DUE.
+6 ;
+7 ;---> USE NODES 1 & 2 IN ^TMP GLOBAL.
+8 ;
BEGIN ;EP
+1 DO SETVARS^WVUTL5
KILL WVRES
+2 DO TITLE^WVUTL5("BREAST & CERVICAL TX NEEDS PAST DUE REPORT")
+3 DO UNDETER
if WVPOP
GOTO EXIT
+4 DO ASKDATE
if WVPOP
GOTO EXIT
+5 DO CMGR
if WVPOP
GOTO EXIT
+6 DO ORDER
if WVPOP
GOTO EXIT
+7 DO DEVICE
if WVPOP
GOTO EXIT
+8 DO SORT
+9 DO COPYGBL
+10 DO ^WVBRNED1
+11 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
+3 ;
+4 ;
UNDETER ;EP
+1 ;---> ASK TO INCLUDE CASES WITH UNDETERMINED OR UNDATED NEEDS.
+2 ;---> WVA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
+3 NEW DIR,DIRUT,Y
+4 WRITE !!?3,"Include patients whose Breast or Cervical Tx Needs are "
+5 WRITE "undetermined?"
+6 NEW DIR
SET DIR("A")=" Enter Yes or No: "
+7 SET WVA=0
SET DIR(0)="YA"
SET DIR("B")="YES"
DO HELP1^WVBRNEDH
+8 DO ^DIR
WRITE !
+9 if $DATA(DIRUT)
SET WVPOP=1
+10 IF Y
SET WVA=1
QUIT
+11 QUIT
+12 ;
+13 ;
ASKDATE ;EP
+1 ;---> ASK FOR DATE BY WHICH NEEDS WILL BE DELINQUENT.
+2 NEW DIR,DIRUT,Y
+3 WRITE !!?3,"Select the date to be checked for patient Tx Needs past due:"
+4 SET DIR(0)="D^::EX"
SET DIR("A")=" Select a date"
+5 SET DIR("B")="TODAY"
DO HELP4^WVBRNEDH
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET WVPOP=1
QUIT
+8 SET WVDDATE=Y
+9 QUIT
+10 ;
+11 ;
CMGR ;EP
+1 ;---> SELECT CASES FOR ONE CASE MANAGER OR ALL.
+2 ;---> DO NOT PROMPT FOR CASE MANAGER IF SITE PARAMETERS SAY NOT TO.
+3 IF '$DATA(^WV(790.02,DUZ(2),0))
SET WVE=1
QUIT
+4 IF '$PIECE(^WV(790.02,DUZ(2),0),U,5)
SET WVE=1
QUIT
+5 WRITE !!?3,"Report on all patients for ONE particular Case Manager,"
+6 WRITE !?3,"or report on all patients for ALL Case Managers?"
+7 NEW DIR,DIRUT,Y
+8 SET DIR("A")=" Select ONE or ALL: "
SET DIR("B")="ALL"
SET WVMGR=""
+9 SET DIR(0)="SAM^o:ONE;a:ALL"
DO HELP3^WVBRNEDH
+10 DO ^DIR
KILL DIR
+11 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+12 ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
+13 IF Y="a"
SET WVE=1
QUIT
+14 ;
+15 WRITE !!," Select the Case Manager whose patients you wish to browse."
+16 DO DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
+17 IF Y<0
SET WVPOP=1
QUIT
+18 ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVMGR=^VA(200 DFN, QUIT.
+19 SET WVMGR=+Y
SET WVE=0
+20 QUIT
+21 ;
+22 ;
ORDER ;EP
+1 ;---> ASK ORDER BY DATE DELINQUENT OR BY PATIENT NAME.
+2 ;---> SORT SEQUENCE IN WVB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
+3 ;---> 3=PRIMARY CARE PROVIDER
+4 NEW DIR,DIRUT,Y
SET WVB=1
+5 WRITE !!?3,"Display Procedures in order of:"
+6 WRITE ?37,"1) DATE DELINQUENT (earliest first)"
+7 WRITE !?37,"2) PATIENT NAME (alphabetically)"
+8 WRITE !?37,"3) PRIMARY CARE PROVIDER (alphabetically)"
+9 SET DIR("A")=" Selection "
SET DIR("B")=1
+10 SET DIR(0)="SAM^1:DATE DELINQUENT;2:PATIENT NAME;3:PRIMARY CARE PROVIDER"
+11 DO HELP2^WVBRNEDH
+12 DO ^DIR
KILL DIR
+13 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+14 SET WVB=Y
+15 QUIT
+16 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^WVBRNED"
+3 FOR WVSV="A","B","E","DDATE","MGR"
Begin DoDot:1
+4 IF $DATA(@("WV"_WVSV))
SET ZTSAVE("WV"_WVSV)=""
End DoDot:1
+5 ;---> SAVE CURRENT COMMUNITY ARRAY.
+6 IF $DATA(WVCC)
NEW N
SET N=0
FOR
SET N=$ORDER(WVCC(N))
if N=""
QUIT
Begin DoDot:1
+7 SET ZTSAVE("WVCC("""_N_""")")=""
End DoDot:1
+8 DO ZIS^WVUTL2(.WVPOP,1,"HOME")
+9 QUIT
+10 ;
SORT ;EP
+1 ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,
+2 ;---> WVA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
+3 ;---> 5 & 8 ARE IENS IN ^WV(790.5, AND ^WV(790.51 GLOBALS FOR "UNDETERMINED".
+4 ;
+5 KILL ^TMP("WV",$JOB)
NEW N,Y,WVBRTXND,WVCXTXND
+6 SET N=0
+7 SET WVBRTXND=$$IEN^WVUTL9(790.51,"Not Indicated")
+8 SET WVCXTXND=$$IEN^WVUTL9(790.5,"Not Indicated")
+9 FOR
SET N=$ORDER(^WV(790,N))
if 'N
QUIT
Begin DoDot:1
+10 SET Y=^WV(790,N,0)
+11 ;---> QUIT IF PATIENT IS INACTIVE.
+12 if $PIECE(Y,U,24)
QUIT
+13 ;---> IF DEAD, SET INACTIVE DATE TO DATE OF DEATH
+14 IF $$DECEASED^WVUTL1($PIECE(Y,U))
Begin DoDot:2
+15 NEW DA,DR,DIE
+16 SET DIE="^WV(790,"
SET DA=$PIECE(Y,U)
+17 ;date only
SET DR=".24////"_$PIECE($$GET1^DIQ(2,DA,.351,"I"),".")
+18 NEW X,Y
+19 DO ^DIE
+20 QUIT
End DoDot:2
+21 ;---> QUIT IF BOTH TX NEEDS ARE "NOT INDICATED"
+22 IF $PIECE(Y,U,18)=WVBRTXND
IF $PIECE(Y,U,11)=WVCXTXND
QUIT
+23 ;---> QUIT IF LOOKING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
+24 IF 'WVE
if $PIECE(Y,U,10)'=WVMGR
QUIT
+25 ;---> IF WVA=0, DON'T INCLUDE BECAUSE OF UNDETERMINED NEEDS.
+26 IF 'WVA
Begin DoDot:2
+27 ;---> ONLY IF IT'S A SPECIFIED NEED AND IT'S DELINQUENT, INCLUDE.
+28 IF 5'[$PIECE(Y,U,11)&($PIECE(Y,U,12)<WVDDATE)
DO SET
QUIT
+29 IF 8'[$PIECE(Y,U,18)&($PIECE(Y,U,19)<WVDDATE)
DO SET
QUIT
End DoDot:2
QUIT
+30 ;---> IF WVA=1, INCLUDE BECAUSE OF UNDETERMINED NEEDS.
+31 IF 5[$PIECE(Y,U,11)!(8[$PIECE(Y,U,18))
DO SET
QUIT
+32 ;---> IF EITHER NEED IS DELINQUENT, INCLUDE.
+33 IF $PIECE(Y,U,12)<WVDDATE!($PIECE(Y,U,19)<WVDDATE)
DO SET
End DoDot:1
+34 QUIT
+35 ;
+36 ;
COPYGBL ;EP
+1 ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.
+2 NEW I,M,N
+3 SET N=-1
SET I=0
+4 FOR
SET N=$ORDER(^TMP("WV",$JOB,1,N))
if N=""
QUIT
Begin DoDot:1
+5 SET M=-1
+6 FOR
SET M=$ORDER(^TMP("WV",$JOB,1,N,M))
if M=""
QUIT
Begin DoDot:2
+7 SET I=I+1
SET ^TMP("WV",$JOB,2,I)=^TMP("WV",$JOB,1,N,M)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SET ;EP
+1 ;---> SORT SEQUENCE IN WVB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
+2 ;---> 3=PRIMARY CARE PROVIDER
+3 NEW Z
SET WVDFN=$PIECE(Y,U)
DO PATVARS^WVUTL3(WVDFN)
+4 SET Z=WVCHRT_U_WVNAME_U_WVCMGR_U_WVCNEED_U_WVBNEED_U_WVDFN
+5 SET WVJPCP=$$PROVI^WVUTL1A(WVDFN)
+6 IF WVB=1
Begin DoDot:1
+7 SET WVPDAT=+$PIECE(Y,U,12)
SET WVMDAT=+$PIECE(Y,U,19)
+8 IF WVPDAT
IF WVMDAT
SET ^TMP("WV",$JOB,1,$SELECT(WVPDAT<WVMDAT:WVPDAT,1:WVMDAT),WVNAME)=Z
QUIT
+9 IF WVPDAT
SET ^TMP("WV",$JOB,1,WVPDAT,WVNAME)=Z
QUIT
+10 SET ^TMP("WV",$JOB,1,WVMDAT,WVNAME)=Z
+11 QUIT
End DoDot:1
QUIT
+12 IF WVB=2
SET ^TMP("WV",$JOB,1,WVNAME,WVDFN)=Z
+13 IF WVB=3
SET ^TMP("WV",$JOB,1,WVJPCP,WVNAME)=Z
+14 QUIT
+15 ;
+16 ;
DEQUEUE ;EP
+1 ;---> TASKMAN QUEUE OF PRINTOUT.
+2 DO SETVARS^WVUTL5
DO SORT
DO COPYGBL
DO ^WVBRNED1
DO EXIT
+3 QUIT
+4 ;
PRINTX ;EP
+1 NEW I,T,X
SET T=$$REPEAT^XLFSTR(" ",WVTAB)
+2 FOR I=1:1
SET X=$TEXT(@WVLINL+I)
if X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+3 QUIT
