source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCACD1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1ONCACD1 ;Hines OIFO/GWB - Annual Call for Data; 06/11/01
2 ;;2.11;Oncology;**9,12,14,18,20,22,24,25,26,28,29,31,36,37,41,43,47**;Mar 07, 1995;Build 19
3 ;;
4EN1 ;Main entry point
5 S EXPORT="YES"
6 K ^TMP($J)
7 N PAGE,OIEN
8 S PAGE=1
9 S OIEN=0
10 D SETUP
11 I DEVICE S:$D(ZTQUEUED) ZTREQ="@" Q
12 I 'DEVICE W $C(26) H 30
13 K EXPORT
14 Q
15 ;
16HEAD(IEN,OUT) ;Header print
17 N FLG
18 I IEN=OIEN S FLG=0
19 I IEN'=OIEN S OIEN=IEN,FLG=1
20 I 'FLG Q:$Y+4<IOSL
21 I PAGE'=1 D Q:OUT
22 .Q:$E(IOST,1)'="C"
23 .N DIR,Y
24 .S DIR("A")="Press ENTER to Continue or ""^"" to Quit: "
25 .S DIR(0)="EA" D ^DIR
26 .I 'Y S OUT=1 Q
27 D HEADER
28 Q
29 ;
30HEADER ;Master header
31 I PAGE'=1 W @IOF
32 I PAGE=1,$E(IOST,1)="C" W @IOF
33 W !,$P(^ONCO(160.16,HDRIEN,0),U),?70,"Page: ",PAGE S PAGE=PAGE+1
34 W !,"Patient: ",$$GET1^DIQ(160,ACD160,.01,"E")
35 W ?55,"SSN: ",$$GET1^DIQ(160,ACD160,2,"E")
36 W !,"Col#",?5,"Data item",?51,"Data Value",!
37 F I=1:1:79 W "="
38 Q
39 ;
40SETUP ;Setup the data to be verified.
41 N IEN,BLANK,NINE,ZERO,ZNINE,X
42 I 'DEVICE S X=0 X ^%ZOSF("RM") ;disable autowrap
43 S BLANK=" "
44 S (IEN,ZERO)=0
45 S NINE=9
46 S ZNINE="09"
47 S OUT=$G(OUT,0)
48 I STEXT=0 F S IEN=$O(^ONCO(165.5,"AY",DATE,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT
49 .Q:$G(^ONCO(165.5,IEN,0))=""
50 .D LOOP
51 I STEXT=1 S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AAD",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AAD",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT
52 .Q:$G(^ONCO(165.5,IEN,0))=""
53 .D LOOP
54 I STEXT=2 S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AAE",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AAE",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT
55 .Q:$G(^ONCO(165.5,IEN,0))=""
56 .D LOOP
57 Q
58 ;
59LOOP ;Loop though the data that was given
60 N LINE,RULES,VALID,JUMP
61 S RULES=0
62 F S RULES=$O(^ONCO(160.16,EXTRACT,"RULES",RULES)) Q:RULES<1 D
63 .S LINE=^ONCO(160.16,EXTRACT,"RULES",RULES,0)
64 .X LINE
65 Q:'VALID
66 S ^TMP($J,IEN)=""
67 D OUTPUT(IEN,EXTRACT,JUMP,.OUT)
68 I 'DEVICE W !
69 Q
70OUTPUT(IEN,EXTRACT,JUMP,OUT) ;Output the data
71 N POS
72 S ACD160=$P(^ONCO(165.5,IEN,0),U,2)
73 I DEVICE D HEAD(IEN,.OUT) Q:OUT
74 S POS=0
75 F S POS=$O(^ONCO(160.16,EXTRACT,"FIELD","B",POS)) Q:POS<1 D Q:OUT
76 .N NODE
77 .S NODE=0
78 .F S NODE=$O(^ONCO(160.16,EXTRACT,"FIELD","B",POS,NODE)) Q:NODE<1 D Q:OUT
79 ..N STRING,DEFAULT,FILL,LEN
80 ..Q:$G(^ONCO(160.16,EXTRACT,"FIELD",NODE,0))=""
81 ..D DISPLAY(DEVICE,$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,1)_U_$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,4),.OUT)
82 ..Q:OUT
83 ..S STRING=$TR(^ONCO(160.16,EXTRACT,"FIELD",NODE,1),"~","^")
84 ..S DEFAULT=^ONCO(160.16,EXTRACT,"FIELD",NODE,2)
85 ..S FILL=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,3),U,1)
86 ..S LEN=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,2)
87 ..D DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS)
88 ..I $G(^ONCO(160.16,EXTRACT,0))["NCDB" D
89 ...I $O(^ONCO(160.16,EXTRACT,"FIELD","B",POS))>1 Q ; Search for last
90 ...N EXTRACT,NODE,POS
91 ...;============================================
92 ...;| This Code is to support the PCE Extract. |
93 ...;============================================
94 ...S EXTRACT=100,JUMP=0
95 ...;S:$D(^ONCO(165.5,"APCE","BLA",IEN)) EXTRACT=1
96 ...; ^==== Bladder 95,90,85
97 ...;S:$D(^ONCO(165.5,"APCE","THY",IEN)) EXTRACT=2
98 ...; ^==== Thyroid 96,91,86
99 ...;S:$D(^ONCO(165.5,"APCE","STS",IEN)) EXTRACT=3
100 ...; ^==== Soft Tissue 96,91,86
101 ...;S:$D(^ONCO(165.5,"APCE","COL",IEN)) EXTRACT=4
102 ...; ^==== Colorectal 97,92,87
103 ...;S:$D(^ONCO(165.5,"APCE","NHL",IEN)) EXTRACT=5
104 ...; ^==== Non-Hodgkins 97,92,87
105 ...;S:$D(^ONCO(165.5,"APCE","BRE",IEN)) EXTRACT=6
106 ...; ^==== Breast 98,93,88
107 ...;S:$D(^ONCO(165.5,"APCE","PRO2",IEN)) EXTRACT=7
108 ...; ^==== Prostate 98,93,88
109 ...;S:$D(^ONCO(165.5,"APCE","MEL",IEN)) EXTRACT=8
110 ...; ^==== Melanoma 99,94,89
111 ...;S:$D(^ONCO(165.5,"APCE","HEP",IEN)) EXTRACT=9
112 ...; ^==== Hepatocellular Cancers 00,95,90
113 ...;S:$D(^ONCO(165.5,"APCE","CNS",IEN)) EXTRACT=10
114 ...; ^==== Primary Intracranial/CNS Tumors 00,95,90
115 ...;S:$D(^ONCO(165.5,"APCE","LNG",IEN)) EXTRACT=11
116 ...; ^==== Lung (NSCLC) 01,96,91
117 ...;S:$D(^ONCO(165.5,"APCE","GAS",IEN)) EXTRACT=12
118 ...; ^==== Gastric Cancers 01,96,91
119 ...S POS=0
120 ...F S POS=$O(^ONCO(160.17,EXTRACT,"FIELD","B",POS)) Q:POS<1 D Q:OUT
121 ....N NODE
122 ....S NODE=0
123 ....F S NODE=$O(^ONCO(160.17,EXTRACT,"FIELD","B",POS,NODE)) Q:NODE<1 D Q:OUT
124 .....N STRING,DEFAULT,FILL,LEN
125 .....Q:$G(^ONCO(160.17,EXTRACT,"FIELD",NODE,0))=""
126 .....D DISPLAY(DEVICE,$P(^ONCO(160.17,EXTRACT,"FIELD",NODE,0),U,1)_U_$P(^ONCO(160.17,EXTRACT,"FIELD",NODE,0),U,4),.OUT)
127 .....Q:OUT
128 .....S STRING=$TR(^ONCO(160.17,EXTRACT,"FIELD",NODE,1),"~","^")
129 .....S DEFAULT=^ONCO(160.17,EXTRACT,"FIELD",NODE,2)
130 .....S FILL=^ONCO(160.17,EXTRACT,"FIELD",NODE,3)
131 .....S LEN=$P(^ONCO(160.17,EXTRACT,"FIELD",NODE,0),U,2)
132 .....D DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS)
133 Q
134DISPLAY(DEVICE,WRITE,OUT) ; Display Data
135 Q:'DEVICE
136 N DOTS,COL,ITEM
137 I DEVICE,($Y+5)>IOSL D HEAD(0,.OUT) Q:OUT
138 S COL=$P(WRITE,U,1)
139 S COL=$S($L(COL)=1:" "_COL,$L(COL)=2:" "_COL,$L(COL)=3:" "_COL,1:COL)
140 S ITEM=$P(WRITE,U,2),ITEM=$E(ITEM,1,45)
141 S DOTS=(46-$L(ITEM))
142 W !,COL,?5,ITEM
143 F I=1:1:DOTS W "."
144 Q
145 ;
146DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS) ; Data print
147 N ACDANS,EXIT
148 S EXIT=0
149 I JUMP'="0" D
150 .I POS<$P(JUMP,U) Q
151 .I POS>$P(JUMP,U,2) Q
152 .N I
153 .S EXIT=1
154 .F I=1:1:LEN W BLANK
155 Q:EXIT
156 X STRING
157 I ACDANS="" D Q
158 .N X,I
159 .S X=""
160 .I DEFAULT=8 D Q
161 ..F I=1:1:LEN W DEFAULT
162 .I @DEFAULT="09" W @DEFAULT Q
163 .F I=1:1:LEN W @DEFAULT
164 I $L(ACDANS)=LEN W ACDANS Q
165 I $L(ACDANS)>LEN W $E(ACDANS,1,LEN) Q
166 E D Q
167 .N JUST,STUFF,I,REM,CAL
168 .S JUST=$P(FILL,","),STUFF=$P(FILL,",",2)
169 .S REM=LEN-$L(ACDANS)
170 .I JUST="R" W ACDANS
171 .F I=1:1:REM W @STUFF
172 .I JUST="L" W ACDANS
173 Q
Note: See TracBrowser for help on using the repository browser.