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

Last change on this file since 1487 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1WVBRNED ;HCIOFO/FT,JR-BROWSE TX NEEDS PAST DUE; ;6/1/99 13:42
2 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; CALLED BY OPTION: "WV BROWSE NEEDS PAST DUE" TO BROWSE AND
6 ;; EDIT PATIENTS WITH TREATMENT NEEDS PAST DUE.
7 ;
8 ;---> USE NODES 1 & 2 IN ^TMP GLOBAL.
9 ;
10BEGIN ;EP
11 D SETVARS^WVUTL5 K WVRES
12 D TITLE^WVUTL5("BREAST & CERVICAL TX NEEDS PAST DUE REPORT")
13 D UNDETER G:WVPOP EXIT
14 D ASKDATE G:WVPOP EXIT
15 D CMGR G:WVPOP EXIT
16 D ORDER G:WVPOP EXIT
17 D DEVICE G:WVPOP EXIT
18 D SORT
19 D COPYGBL
20 D ^WVBRNED1
21 ;
22EXIT ;EP
23 D KILLALL^WVUTL8
24 Q
25 ;
26 ;
27UNDETER ;EP
28 ;---> ASK TO INCLUDE CASES WITH UNDETERMINED OR UNDATED NEEDS.
29 ;---> WVA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
30 N DIR,DIRUT,Y
31 W !!?3,"Include patients whose Breast or Cervical Tx Needs are "
32 W "undetermined?"
33 N DIR S DIR("A")=" Enter Yes or No: "
34 S WVA=0,DIR(0)="YA",DIR("B")="YES" D HELP1^WVBRNEDH
35 D ^DIR W !
36 S:$D(DIRUT) WVPOP=1
37 I Y S WVA=1 Q
38 Q
39 ;
40 ;
41ASKDATE ;EP
42 ;---> ASK FOR DATE BY WHICH NEEDS WILL BE DELINQUENT.
43 N DIR,DIRUT,Y
44 W !!?3,"Select the date to be checked for patient Tx Needs past due:"
45 S DIR(0)="D^::EX",DIR("A")=" Select a date"
46 S DIR("B")="TODAY" D HELP4^WVBRNEDH
47 D ^DIR
48 I $D(DIRUT) S WVPOP=1 Q
49 S WVDDATE=Y
50 Q
51 ;
52 ;
53CMGR ;EP
54 ;---> SELECT CASES FOR ONE CASE MANAGER OR ALL.
55 ;---> DO NOT PROMPT FOR CASE MANAGER IF SITE PARAMETERS SAY NOT TO.
56 I '$D(^WV(790.02,DUZ(2),0)) S WVE=1 Q
57 I '$P(^WV(790.02,DUZ(2),0),U,5) S WVE=1 Q
58 W !!?3,"Report on all patients for ONE particular Case Manager,"
59 W !?3,"or report on all patients for ALL Case Managers?"
60 N DIR,DIRUT,Y
61 S DIR("A")=" Select ONE or ALL: ",DIR("B")="ALL",WVMGR=""
62 S DIR(0)="SAM^o:ONE;a:ALL" D HELP3^WVBRNEDH
63 D ^DIR K DIR
64 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
65 ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
66 I Y="a" S WVE=1 Q
67 ;
68 W !!," Select the Case Manager whose patients you wish to browse."
69 D DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
70 I Y<0 S WVPOP=1 Q
71 ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVMGR=^VA(200 DFN, QUIT.
72 S WVMGR=+Y,WVE=0
73 Q
74 ;
75 ;
76ORDER ;EP
77 ;---> ASK ORDER BY DATE DELINQUENT OR BY PATIENT NAME.
78 ;---> SORT SEQUENCE IN WVB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
79 ;---> 3=PRIMARY CARE PROVIDER
80 N DIR,DIRUT,Y S WVB=1
81 W !!?3,"Display Procedures in order of:"
82 W ?37,"1) DATE DELINQUENT (earliest first)"
83 W !?37,"2) PATIENT NAME (alphabetically)"
84 W !?37,"3) PRIMARY CARE PROVIDER (alphabetically)"
85 S DIR("A")=" Selection ",DIR("B")=1
86 S DIR(0)="SAM^1:DATE DELINQUENT;2:PATIENT NAME;3:PRIMARY CARE PROVIDER"
87 D HELP2^WVBRNEDH
88 D ^DIR K DIR
89 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
90 S WVB=Y
91 Q
92 ;
93DEVICE ;EP
94 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
95 S ZTRTN="DEQUEUE^WVBRNED"
96 F WVSV="A","B","E","DDATE","MGR" D
97 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
98 ;---> SAVE CURRENT COMMUNITY ARRAY.
99 I $D(WVCC) N N S N=0 F S N=$O(WVCC(N)) Q:N="" D
100 .S ZTSAVE("WVCC("""_N_""")")=""
101 D ZIS^WVUTL2(.WVPOP,1,"HOME")
102 Q
103 ;
104SORT ;EP
105 ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,
106 ;---> WVA=1 SAYS INCLUDE PATIENTS WITH UNDETERMINED NEEDS.
107 ;---> 5 & 8 ARE IENS IN ^WV(790.5, AND ^WV(790.51 GLOBALS FOR "UNDETERMINED".
108 ;
109 K ^TMP("WV",$J) N N,Y,WVBRTXND,WVCXTXND
110 S N=0
111 S WVBRTXND=$$IEN^WVUTL9(790.51,"Not Indicated")
112 S WVCXTXND=$$IEN^WVUTL9(790.5,"Not Indicated")
113 F S N=$O(^WV(790,N)) Q:'N D
114 .S Y=^WV(790,N,0)
115 .;---> QUIT IF PATIENT IS INACTIVE.
116 .Q:$P(Y,U,24)
117 .;---> IF DEAD, SET INACTIVE DATE TO DATE OF DEATH
118 .I $$DECEASED^WVUTL1($P(Y,U)) D
119 ..N DA,DR,DIE
120 ..S DIE="^WV(790,",DA=$P(Y,U)
121 ..S DR=".24////"_$P($$GET1^DIQ(2,DA,.351,"I"),".") ;date only
122 ..N X,Y
123 ..D ^DIE
124 ..Q
125 .;---> QUIT IF BOTH TX NEEDS ARE "NOT INDICATED"
126 .I $P(Y,U,18)=WVBRTXND,$P(Y,U,11)=WVCXTXND Q
127 .;---> QUIT IF LOOKING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
128 .I 'WVE Q:$P(Y,U,10)'=WVMGR
129 .;---> IF WVA=0, DON'T INCLUDE BECAUSE OF UNDETERMINED NEEDS.
130 .I 'WVA D Q
131 ..;---> ONLY IF IT'S A SPECIFIED NEED AND IT'S DELINQUENT, INCLUDE.
132 ..I 5'[$P(Y,U,11)&($P(Y,U,12)<WVDDATE) D SET Q
133 ..I 8'[$P(Y,U,18)&($P(Y,U,19)<WVDDATE) D SET Q
134 .;---> IF WVA=1, INCLUDE BECAUSE OF UNDETERMINED NEEDS.
135 .I 5[$P(Y,U,11)!(8[$P(Y,U,18)) D SET Q
136 .;---> IF EITHER NEED IS DELINQUENT, INCLUDE.
137 .I $P(Y,U,12)<WVDDATE!($P(Y,U,19)<WVDDATE) D SET
138 Q
139 ;
140 ;
141COPYGBL ;EP
142 ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.
143 N I,M,N
144 S N=-1,I=0
145 F S N=$O(^TMP("WV",$J,1,N)) Q:N="" D
146 .S M=-1
147 .F S M=$O(^TMP("WV",$J,1,N,M)) Q:M="" D
148 ..S I=I+1,^TMP("WV",$J,2,I)=^TMP("WV",$J,1,N,M)
149 Q
150 ;
151SET ;EP
152 ;---> SORT SEQUENCE IN WVB: 1=DELINQ DATE (DEFAULT), 2=PATIENT NAME
153 ;---> 3=PRIMARY CARE PROVIDER
154 N Z S WVDFN=$P(Y,U) D PATVARS^WVUTL3(WVDFN)
155 S Z=WVCHRT_U_WVNAME_U_WVCMGR_U_WVCNEED_U_WVBNEED_U_WVDFN
156 S WVJPCP=$$PROVI^WVUTL1A(WVDFN)
157 I WVB=1 D Q
158 .S WVPDAT=+$P(Y,U,12),WVMDAT=+$P(Y,U,19)
159 .I WVPDAT,WVMDAT S ^TMP("WV",$J,1,$S(WVPDAT<WVMDAT:WVPDAT,1:WVMDAT),WVNAME)=Z Q
160 .I WVPDAT S ^TMP("WV",$J,1,WVPDAT,WVNAME)=Z Q
161 .S ^TMP("WV",$J,1,WVMDAT,WVNAME)=Z
162 .Q
163 I WVB=2 S ^TMP("WV",$J,1,WVNAME,WVDFN)=Z
164 I WVB=3 S ^TMP("WV",$J,1,WVJPCP,WVNAME)=Z
165 Q
166 ;
167 ;
168DEQUEUE ;EP
169 ;---> TASKMAN QUEUE OF PRINTOUT.
170 D SETVARS^WVUTL5,SORT,COPYGBL,^WVBRNED1,EXIT
171 Q
172 ;
173PRINTX ;EP
174 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
175 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
176 Q
Note: See TracBrowser for help on using the repository browser.