source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVGETALL.m@ 1006

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

initial load of WorldVistAEHR

File size: 6.5 KB
Line 
1WVGETALL ;HCIOFO/FT,JR-AUTOLOAD FEMALE PATIENTS ;4/7/00 15:59
2 ;;1.0;WOMEN'S HEALTH;**3,7,10**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; AUTOMATICALLY LOADS WOMENS PATIENTS FROM THE MAIN PATIENT FILE,
6 ;; LIMITED BY AGE AND CURRENT COMMUNITY.
7 ;
8EN ;
9 N WVPARM,WVEC
10 S WVPARM=$G(^WV(790.02,+$G(DUZ(2)),0)),WVEC=""
11 I WVPARM="" D CHECK^WVLOGO Q ;no site parameter entry
12 ; Stop if no default case manager
13 I '$P(WVPARM,U,2) D NODCM^WVUTL9 Q
14 D SETVARS^WVUTL5
15 D INTRO G:WVPOP EXIT
16 D SELECT G:WVPOP EXIT
17 D EC^WVGETAL1 G:WVPOP EXIT
18 D DEVICE G:WVPOP EXIT
19 D LOAD
20 ;
21EXIT ;EP
22 D KILLALL^WVUTL8 K WVJSDT,WVJEDT,WVN,WVST
23 Q
24 ;
25 ;
26INTRO ;EP
27 ;---> INTRODUCTORY SCREENS.
28 S WVTITLE="AUTOLOAD PATIENTS"
29 D TITLE^WVUTL5(WVTITLE)
30 D TEXT1,DIRZ^WVUTL3
31 Q:WVPOP
32 D TITLE^WVUTL5(WVTITLE)
33 D TEXT2,DIRZ^WVUTL3
34 Q
35 ;
36SELECT ;EP
37 ;---> SELECT AGE.
38 D TITLE^WVUTL5(WVTITLE)
39 ;---> SELECT AGE.
40 K DIR
41 W !?5,"Select the age below which patients should NOT be added:"
42 S DIR("A")=" Enter AGE: ",DIR("B")=19
43 S DIR(0)="NOA^10:99" D HELP1
44 D ^DIR K DIR
45 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
46 S WVAGE=+Y
47 W !!?5,"Define Active Patient for Patient file download."
48 W !?5,"If the patient has had no activity (visits or admissions) between"
49 W !?5,"the start and end dates you enter here, she will not be included"
50 W !?5,"in this Patient file download.",!
51STD S DIR(0)="DAO^::E",DIR("A")=" Start Date of Patient Activity to Include: "
52 S Y=DT-30000,Y=$$DATECHK^WVEXPTRA(Y)
53 D DD^%DT S DIR("B")=Y
54 S DIR("?",1)=" If the patient has not had a Visit or Admission after this start date,"
55 S DIR("?",2)=" they will not be included in the auto-load."
56 S DIR("?")=" This date can be up to 3 years prior to todays date."
57 D ^DIR K DIR I Y'>0 W !!!! K WVJRDT S WVPOP=1 Q
58 S WVJSDT=Y
59K S DIR(0)="DAO^::E",DIR("A")=" End Date of Patient Activity to Include: "
60 S DIR("?")=" "
61 S DIR("?",1)=" If the patient has not had a Visit or Admission before this date,"
62 S DIR("?",2)=" they will not be included in the auto-load."
63 S DIR("?",3)=" This date may be up to 3 years prior to todays date, but must be"
64 S DIR("?",4)=" after the start date."
65 S Y=DT D DD^%DT S DIR("B")=Y
66 D ^DIR K DIR I Y'>0 W !!!! K WVJSDT S WVPOP=1 Q
67 I Y<WVJSDT W !!!," END DATE MUST BE AFTER START DATE",!!! K WVJSDT G STD
68 S WVJEDT=$P(Y,".",1)_".9999"
69 Q
70 ;
71DEVICE ;EP
72 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
73 S ZTRTN="LOAD^WVGETALL"
74 S ZTSAVE("WVAGE")="",ZTSAVE("WVJSDT")="",ZTSAVE("WVJEDT")=""
75 S ZTSAVE("WVEC(")=""
76 D ZIS^WVUTL2(.WVPOP,1)
77 Q
78 ;
79LOAD ;EP
80 ;---> AUTOLOAD OF PATIENTS
81 N WVCOUNT,WVERROR,N,X,Y D SETVARS^WVUTL5
82 D TOPHEAD^WVUTL7 S WVCONF=1
83 S WVTITLE="* AUTOLOAD OF WOMEN PATIENTS *"
84 D CENTERT^WVUTL5(.WVTITLE)
85 U IO
86 W:$Y>0 @IOF D HEADER7^WVUTL7
87 S (WVCOUNT,N)=0
88 S WVN=0 F S WVN=$O(^DPT("ASX","F",WVN)) Q:'WVN Q:WVPOP D
89 .S Y=^DPT(WVN,0)
90 .;---> QUIT IF NOT FEMALE.
91 .Q:$P(Y,U,2)'="F"
92 .;---> QUIT IF DECEASED OR LESS THAN WVAGE.
93 .Q:+$$AGE^WVUTL1(WVN)<WVAGE
94 .Q:$D(^WV(790,WVN,0))
95 .; Quit if patient not a veteran or doesn't have selected eligibility
96 .; code
97 .Q:'$$VECCHK^WVGETAL1(WVN)
98 .;Q:$$GET1^DIQ(2,WVN,1901,"I")'="Y"
99 .;Quit if not active patient
100 .Q:$$HOS(WVN)<1
101 .I $Y+5>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER7^WVUTL7
102 .W !?3,$$NAME^WVUTL1(WVN),?30,$$SSN^WVUTL1(WVN)
103 .W ?45,$$SLDT2^WVUTL5($$DOB^WVUTL1(WVN))
104 .D AUTOADD^WVPATE(WVN,DUZ(2),.WVERROR)
105 .I WVERROR<0 W ?60,"FAILED" Q
106 .S WVCOUNT=WVCOUNT+1 W ?60,"ADDED" ;,?70,WVN
107 .W !?3,"Age: "_$$AGE^WVUTL9(WVN)_" / Veteran: "_$$VET^WVUTL1A(WVN)_" / Elig Code: "_$P($$ELIG^WVUTL9(WVN),U,2),!
108 W !!?5,"TOTAL: ",WVCOUNT," PATIENT",$S(WVCOUNT=1:"",1:"S")
109 W " ADDED TO THE WOMEN'S HEALTH DATABASE.",!
110 I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
111 K TEST1,TEST2 D ^%ZISC
112 Q
113 ;
114 ;
115TEXT1 ;EP
116 ;;This utility will examine the VISTA Patient file (#2) for ALL
117 ;;WOMEN VETERANS or WOMEN patients with an ELIGIBILITY CODE you
118 ;;select over a given age who were seen in the date range selected,
119 ;;and add them to the Women's Health Database.
120 ;;
121 ;;You will be asked to select a cutoff age (e.g., 40 and over),
122 ;;Start and End Activity dates and Eligibility Code(s).
123 ;;Patients not having a visit or admission between these dates
124 ;;will not be added to the file. These dates can be no more
125 ;;than 3 years prior to today's date.
126 ;;
127 ;;Women already in the Women's Health Database will not be added twice.
128 ;;Women who are deceased will not be added. Women added to the Women's
129 ;;Health Database will be given Breast and Cervical Treatment Needs of
130 ;;"Undetermined", with no due dates.
131 ;;
132 ;;This utility may be run at any time, as often as desired. It may be
133 ;;useful to run it on a monthly basis in order to pick up new women who
134 ;;are added to the Patient Database.
135 S WVTAB=5,WVLINL="TEXT1" D PRINTX
136 Q
137 ;
138 ;
139TEXT2 ;EP
140 ;;Before the program begins, you will be prompted for a "DEVICE:".
141 ;;The name, social security number, and date of birth of each
142 ;;patient added to the Women's Health Database will be displayed
143 ;;on the DEVICE.
144 ;;This DEVICE may be a printer, or you may enter "HOME" to have the
145 ;;information simply display on your screen.
146 ;;
147 ;;If the DEVICE you select is a printer, it may be preferable
148 ;;to "queue" the job, in order to free up your terminal.
149 ;;See your computer sitemanager for assistance with queuing jobs.
150 ;;
151 ;;WARNING: The first time this utility is run, it may add several
152 ;;thousand patients to the Women's Health Database. It may take
153 ;;several minutes or even hours to run, depending on the size of the
154 ;;database and speed of the computer. Subsequent runs should be much
155 ;;quicker.
156 ;;
157 ;;You may type "^" at anytime to quit before the program begins.
158 S WVTAB=5,WVLINL="TEXT2" D PRINTX
159 Q
160 ;
161HELP1 ;EP
162 ;;Enter a two-digit number that will be the lowest age of patients
163 ;;added to the Women's Health Database. For example, if you enter 15,
164 ;;all women age 15 and older will be included, 14 and under will not.
165 S WVTAB=5,WVLINL="HELP1" D HELPTX
166 Q
167 ;
168 ;
169PRINTX ;EP
170 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
171 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
172 Q
173 ;
174HELPTX ;EP
175 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
176 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
177 S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
178 Q
179HOS(WVN) ;Comes here to determine if visit/adm. is current
180 ;WVN=DFN, WVJSDT=Selected earliest date for consideration.
181 S WVST="ADFN"_WVN
182 S TEST1=$O(^DGPM(WVST,WVJSDT)) I TEST1>WVJSDT I TEST1<WVJEDT Q 1
183 S TEST2=$O(^SCE("ADFN",WVN,WVJSDT)) I TEST2>WVJSDT I TEST2<WVJEDT Q 1
184 Q 0
Note: See TracBrowser for help on using the repository browser.