source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCACD0.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1ONCACD0 ;Hines OIFO/GWB - NAACCR extract driver ;06/11/01
2 ;;2.11;Oncology;**9,12,20,24,25,28,29,30,36,37,38,40,41,44,45,47**;Mar 07, 1995;Build 19
3 ;
4EN1(DEVICE,STEXT) ;Select extract from ONCOLOGY DATA EXTRACT FORMAT (160.16)
5EN2 N EXTRACT,HDRIEN,STAT,STAT1,STAT2,DATE,YESNO,BDT,SDT,EDT,QUEUE
6 K ^TMP($J)
7 S DEVICE=$G(DEVICE,0),STEXT=$G(STEXT,0),(EXTRACT,QUEUE)=0,EXT=""
8 I STEXT=0 S EXTRACT=$O(^ONCO(160.16,"B","NCDB EXTRACT V11.1",0))
9 S (STAT,DATE,OUT,SDT,EDT)=0
10 S HDRIEN=EXTRACT
11 D DISPLAY
12 I STEXT=1 D GETREC(.EXTRACT,.OUT)
13 I 'OUT S STAT=$$GETHOSP
14 I 'STAT S OUT=1
15 I 'OUT S STAT1=$P(STAT,U,1),STAT2=$P(STAT,U,2)
16 I 'OUT D GETDATE(.DATE,.OUT)
17 I 'OUT,STEXT D GETDT(.SDT,.EDT,DATE,.OUT)
18 I 'OUT D VERIFY(STAT,DATE,SDT,EDT,STEXT,.YESNO,.OUT)
19 I 'OUT G:'YESNO EN2
20 I 'OUT D DEVICE(DEVICE,.OUT)
21 I 'OUT D:'QUEUE PRINT(DEVICE,.OUT)
22 D EXIT
23 Q
24 ;
25GETREC(EXTRACT,OUT) ;Select record layout
26 W !!," Available record layouts:",!
27 W !," 1) VACCR Record Layout v11.1 (VA Registry)"
28 W !," 2) NAACCR State Record Layout v11.1"
29 W !
30 N DIR,X,Y
31 S DIR(0)="SAO^1:VACCR Record Layout v11.1;2:NAACCR State Record Layout v11.1"
32 S DIR("A")=" Select record layout: "
33 S DIR("?")="Select the record layout to use"
34 D ^DIR
35 I $D(DIRUT) S OUT=1 Q
36 I +Y<1 S OUT=1 Q
37 I Y=1 S EXT="VACCR",EXTRACT=$O(^ONCO(160.16,"B","VACCR EXTRACT V11.1",0))
38 I Y=2 S EXT="STATE",EXTRACT=$O(^ONCO(160.16,"B","STATE EXTRACT V11.1",0))
39 S HDRIEN=EXTRACT
40 Q
41 ;
42DISPLAY ;Display on-line instructions
43 N X,DIR,Y
44 S DIR("A")=" DISPLAY/PRINT on-line instructions"
45 S DIR("B")="No"
46 S DIR(0)="Y"
47 D ^DIR I ($D(DIRUT))!(+Y<1) Q
48 I X=0 Q
49 I X<0 S OUT=1 Q
50 W ! S DIC="^ONCO(160.2,",L=0,DHD="@"
51 S FLDS="1",BY="@.01"
52 I STEXT S (FR,TO)="STATE REPORTING ACOS INFOA"
53 E S (FR,TO)="PRIMARY ACOS INFO (850)"
54 D EN1^DIP
55 S:'($D(DTOUT)+$D(DUOUT)=0) OUT=1
56 S X=$$ASKY^ONCOU("Continue")
57 S:X<1 OUT=1
58 Q
59 ;
60GETDT(SDT,EDT,DATE,OUT) ; Select a date range
61 K DIR
62 S DIR(0)="SAO^1:Date Case Completed;2:Date Case Last Changed"
63 S DIR("A")=" Select date field to be used for Start/End range: "
64 S DIR("?")="Select the date field you wish to use for this download's Start/End range prompts."
65 D ^DIR
66 I $D(DIRUT) S OUT=1 Q
67 I Y<1 S OUT=1 Q
68 I +Y=2 S STEXT=2
69 K DIR
70 S DIR(0)="D^::X"
71 I STEXT=1 D
72 .S DIR("A")=" Start, Date Case Completed"
73 .S DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
74 .S DIR("?",2)=" FIRST abstract you would like to report."
75 I STEXT=2 D
76 .S DIR("A")=" Start, Date Case Last Changed"
77 .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
78 .S DIR("?",2)=" FIRST abstract you would like to report."
79 S DIR("?")=" "
80 D ^DIR I $D(DIRUT) S OUT=1 Q
81 S (SDT,BDT)=Y
82 S DIR(0)="D^::X"
83 I STEXT=1 D
84 .S DIR("A")=" End, Date Case Completed"
85 .S DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
86 .S DIR("?",2)=" LAST abstract you would like to report."
87 I STEXT=2 D
88 .S DIR("A")=" End, Date Case Last Changed"
89 .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
90 .S DIR("?",2)=" LAST abstract you would like to report."
91 D ^DIR I $D(DIRUT) S OUT=1 Q
92 S EDT=Y
93 I EXT="" Q
94 I EXT="VACCR" S ACO=1 Q
95 K DIR
96 S DIR("A")=" Analytic cases only"
97 S DIR("B")="YES"
98 S DIR(0)="Y"
99 S DIR("?")=" "
100 S DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 0-2) extracted."
101 S DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) extracted."
102 D ^DIR
103 I $D(DIRUT) S OUT=1 Q
104 S ACO=Y
105 Q
106 ;
107PRINT(DEVICE,OUT) ;Capture output data
108 I 'DEVICE D Q:OUT
109 .N X
110 .W !!
111 .W !,?6,"--------------------------------------------------------------"
112 .W !,?6,"|Please activate your PC capture program. The data will be |"
113 .W !,?6,"|sent in 2 minutes or when you press the return key. |"
114 .W !,?6,"--------------------------------------------------------------"
115 .W !!!
116 .R X:120
117 .I X="^" S OUT=1
118 U IO D EN1^ONCACD1
119 Q
120 ;
121EXIT ;Exit
122 K D0,DI,DIC,DISYS,DQ,FIL,ONCOM,ONCOT,ONCOYR,OUT,ST,STGIND,X,Y
123 I '$D(^TMP($J)) W !?3,"No records extracted." G EX
124 W !
125 S DIC="^ONCO(165.5,",L=0,FLDS="[ONC EXTRACT]",BY(0)="^TMP($J,",L(0)=1
126 S:DEVICE IOP=ION
127 I STEXT=0 S DHD=$P(^ONCO(160.16,HDRIEN,0),U,1) W !
128 I (STEXT=1)!(STEXT=2) S DHD=$P(^ONCO(160.16,HDRIEN,0),U,1)_" "_$$FMTE^XLFDT(BDT,"2D")_" - "_$$FMTE^XLFDT(EDT,"2D")
129 D EN1^DIP
130 I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR Q:'Y
131EX K ^TMP($J)
132 K %ZIS
133 D ^%ZISC
134 Q
135 ;
136DEVICE(DEVICE,OUT) ;Select output device
137 Q:'DEVICE
138 S %ZIS="Q"
139 D ^%ZIS
140 I POP S OUT=1 Q
141 I $D(IO("Q")) D
142 .S ZTRTN="PRINT^ONCACD0(DEVICE,.OUT)"
143 .S ZTDESC=$S('STEXT:"ONC NCDB Extract",STEXT:"ONC State Extract",1:"")
144 .S ZTSAVE("STAT1")=""
145 .S ZTSAVE("DATE")=""
146 .S ZTSAVE("STEXT")=""
147 .S ZTSAVE("DEVICE")=""
148 .S ZTSAVE("OUT")=""
149 .S ZTSAVE("BDT")=""
150 .S ZTSAVE("SDT")=""
151 .S ZTSAVE("EDT")=""
152 .S ZTSAVE("EXTRACT")=""
153 .S ZTSAVE("HDRIEN")=""
154 .D ^%ZTLOAD
155 .I $D(ZTSK)[0 S OUT=1 W !!,?20,"Report Canceled!"
156 .E W !!,?20,"Report Queued!" S QUEUE=1
157 .D HOME^%ZIS
158 Q
159 ;
160VERIFY(STAT,DATE,SDT,EDT,STEXT,YESNO,OUT) ;Verify settings
161 N DIR,Y
162 S RL=$P(^ONCO(160.16,HDRIEN,0),U,1)
163 W !!," These are your current settings:"
164 W !
165 W !," Record layout.......................: ",RL
166 W !," Facility Identification Number (FIN): ",STAT1
167 I EXT="STATE" D
168 .W !," State to be extracted...............: ",STATE
169 I STEXT=0 W !," Accession Year......................: ",DATE
170 I (STEXT=1)!(STEXT=2) D
171 .W !," Start date..........................: ",$$FMTE^XLFDT(SDT,"2D")
172 .W !," End date............................: ",$$FMTE^XLFDT(EDT,"2D")
173 I EXT="STATE" D
174 .W !," Analytic cases only.................: ",$S(ACO=1:"YES",1:"NO")
175 W !
176 S DIR("A")=" Are these settings correct"
177 S DIR("B")="YES"
178 S DIR(0)="Y"
179 D ^DIR
180 I $D(DIRUT) S OUT=1 Q
181 S YESNO=Y
182 Q
183 ;
184GETDATE(DATE,OUT) ;Select ACCESSION YEAR
185 Q:STEXT=1
186 N CYR,DIR,SCREEN,Y
187 S DATE=0
188 S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
189 S DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN
190 S DIR("A")=" Accession Year: "
191 D ^DIR
192 I $D(DIRUT) S OUT=1 Q
193 S DATE=Y
194 Q
195 ;
196GETHOSP() ;Facility Identification Number (FIN)
197 N STAT,STATI,ALLOK
198 S STAT=0,ALLOK=$$GETDXH(.STAT)
199 I STAT S STATI=6_STAT_0,STAT=STAT_"^"_STATI
200 Q STAT
201 ;
202GETDXH(DXH) ;INSTITUTION ID NUMBER (160.1,27)
203 N OKHERE,DIE,DA,DR,ONCOL
204 W !
205 S DIE=160.1
206 S DA=$O(^ONCO(160.1,"C",DUZ(2),0))
207 I DA="" S DA=$O(^ONCO(160.1,0))
208 S DR=27_$J("",1)_"Facility Identification Number (FIN)"
209 S ONCOL=0
210 L +^ONCO(160.1,DA):0 I $T D ^DIE L -^ONCO(160.1,DA) S ONCOL=1
211 I 'ONCOL W !,"This site paramaters record is being edited by another user."
212 K ONCOL,DIE
213 I $D(Y)=0 S DXH=$$GET1^DIQ(160.19,X,.01,"I")
214 I X'="" S STATE=$P($G(^ONCO(160.19,X,0)),U,4)
215 S OKHERE=($D(Y)=0)
216 Q OKHERE
Note: See TracBrowser for help on using the repository browser.