- 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 Feb 19, 2025@00:13:10 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