source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCODSR.m@ 1270

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

initial load of WorldVistAEHR
File size: 9.3 KB
RevLine 
[613]1ONCODSR ;Hines OIFO/GWB - SURGERY OF PRIMARY SITE; 12/22/00
2 ;;2.11;ONCOLOGY;**1,5,6,7,11,13,15,16,18,27,36,37,42,46,47**;Mar 07, 1995;Build 19
3 ;
4 ;^ONCO(164.2,9,"S",1-10) hold SURGICAL DX/STAGING PROC codes 0-9
5 ;^ONCO(164.2,SITE/GP,"S",11-100) holds surgery coes 10-99
6 ;
7CDSIT ;SURGERY OF PRIMARY SITE (165.5,58.2) INPUT TRANSFORM
8 N T,TOPGRPHY,SS
9 K:$L(X)>2!(X'?1.N) X G EX:'$D(X)
10 I X="00" W " 00 No surgical procedure" G EX
11 S TOPGRPHY=$$TOPGRPHY(D0) G ER:TOPGRPHY=""
12 S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
13 I '$D(^ONCO(164.5,SS,1,X+1,0)) K X G EX
14 I ($P(^ONCO(165.5,D0,0),U,16)>2951231),$E(X,2)=8 K X G EX
15 W " ",^ONCO(164.5,SS,1,X+1,0) G EX
16 ;
17NCDSIT ;SURGICAL DX/STAGING PROC (165.5,58.1) INPUT TRANSFORM
18 I '$D(^ONCO(160.14,"B",X)) K X G EX
19 I $L(X)'=2 K X G EX
20 S NCDSIEN=$O(^ONCO(160.14,"B",X,0))
21 W " ",$P(^ONCO(160.14,NCDSIEN,0),U,2)
22 K NCDSIEN Q
23 ;
24NCDSOT ;SURGICAL DX/STAGING PROC (165.5,58.1) OUTPUT TRANSFORM
25 Q:Y=""
26 S NCDSIEN=$O(^ONCO(160.14,"B",Y,0))
27 I NCDSIEN'="" S Y=Y_" "_$P(^ONCO(160.14,NCDSIEN,0),U,2)
28 G EX
29 ;
30HP0 ;SURGICAL DX/STAGING PROC (165.5,58.1) HELP
31 F XX="00","01","02","03","04","05","06","07","09" S NCDSIEN=$O(^ONCO(160.14,"B",XX,0)) W !," ",$P(^ONCO(160.14,NCDSIEN,0),U,1)," ",$P(^ONCO(160.14,NCDSIEN,0),U,2)
32 W !
33 K NCDSIEN G EX
34 ;
35CDSOT ;SURGERY OF PRIMARY SITE (165.5,58.2) OUTPUT TRANSFORM
36 I Y="00" S Y="00 No surgical procedure" G EX
37 N TOPGRPHY,SS
38 S TOPGRPHY=$$TOPGRPHY(D0) G EX:TOPGRPHY=""
39 S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
40 S Y=Y_" "_$G(^ONCO(164.5,SS,1,Y+1,0)) G EX
41 ;
42HP1 ;SURGERY OF PRIMARY SITE (165.5,58.2) HELP
43 N TOPGRPHY,TPGRPHYR,SS,XX
44 S TOPGRPHY=$$TOPGRPHY(D0) G:TOPGRPHY="" ER
45 S TPGRPHYR=^ONCO(164,TOPGRPHY,0)
46 S SS=$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
47 W !?5,"SURGERY OF PRIMARY SITE Codes for site ",$P(TPGRPHYR,U,2)," "
48 W $P(TPGRPHYR,U),!?5,"(",$P(^ONCO(164.5,SS,0),U),")",!!
49 W " ","00 No surgical procedure",!
50 S XX=10 F S XX=$O(^ONCO(164.5,SS,1,XX)) Q:XX'=+XX D
51 .S XXX=XX-1
52 .I ($P(^ONCO(165.5,D0,0),U,16)<2960000)!($E(XXX,2)'=8) W " ",(XX-1)_" "_^ONCO(164.5,SS,1,XX,0),!
53 G EX
54 ;
55ER ;ERROR
56 W !!,?10,"ICDO CODE NOT defined!! - cannot continue",! G EX
57 ;
58EX ;EXIT
59 K AN,SS,ONCOSR
60 Q
61 ;
62TOPGRPHY(PRIMIX) ; returns ICDO-2 topography code for primary site PRIMIX
63 Q $P($G(^ONCO(165.5,PRIMIX,2)),U)
64 ;
65ESSPIT ;INPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
66 N T,TOPGRPHY,SS
67 K:$L(X)>2!(X'?1.N) X G EX:'$D(X)
68 I X="00" W " No additional surgical procedure" G EX
69 S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G ER:TOPGRPHY=""
70 I TOPGRPHY="C888"!(TOPGRPHY="C999") K X G EX
71 S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
72 S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
73 I '$D(^ONCO(164.5,SS,1,X+1,0)) K X G EX
74 I ($P(^ONCO(165.5,D0,0),U,16)>2951231),$E(X,2)=8 K X G EX
75 W " ",^ONCO(164.5,SS,1,X+1,0) G EX
76 ;
77ESSPOT ;OUTPUT TRANSFORM FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
78 I Y="00" S Y=Y_" No additional surgical procedure" G EX
79 N TOPGRPHY,SS
80 S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G EX:TOPGRPHY=""
81 I TOPGRPHY="C888"!(TOPGRPHY="C999") G EX
82 S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
83 S SS=+$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
84 S Y=Y_" "_$G(^ONCO(164.5,SS,1,Y+1,0)) G EX
85 ;
86ESSHP ;EXECUTABLE HELP FOR EXTRANODAL SITE SURGICAL PROCEDURE #856
87 N TOPGRPHY,TPGRPHYR,SS,XX
88 S TOPGRPHY=$P($G(^ONCO(165.5,D0,"NHL2")),U,10) G ER:TOPGRPHY=""
89 I TOPGRPHY="C888"!(TOPGRPHY="C999") W !,?5,"No extranodal site or unknown extranodal site!!",!!,?5,"00 No additional surgical procedure",! G EX
90 S TOPGRPHY="67"_$E(TOPGRPHY,2,4)
91 S TPGRPHYR=^ONCO(164,TOPGRPHY,0)
92 S SS=$P($G(^ONCO(164,TOPGRPHY,"SR")),U,$$EDITION^ONCOU55(D0))
93 W !!,"SURGERY OF PRIMARY SITE Codes for site ",$P(TPGRPHYR,U,2)," "
94 W $P(TPGRPHYR,U),!,"(",$P(^ONCO(164.5,SS,0),U),")",!!
95 W " ","00 No additional surgical procedure",!
96 S XX=10 F S XX=$O(^ONCO(164.5,SS,1,XX)) Q:XX'=+XX D
97 .S XXX=XX-1
98 .I ($P(^ONCO(165.5,D0,0),U,16)<2960000)!($E(XXX,2)'=8) W " ",(XX-1)_" "_^ONCO(164.5,SS,1,XX,0),!
99 W !,"Enter a code from the above list." G EX
100 Q
101 ;
102FADIT ;DATE OF FIRST CONTACT (165.5,155) Input Transform
103 D NINES Q:'$D(X) Q:X=9999999
104 I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X K %DT(0)
105 Q
106 ;
107DSDTIT ;DATE OF INPATIENT DISCHARGE (165.5,1.1) Input Transform
108 ;Must be >= DATE OF INPATIENT ADMISSION (165.5,1)
109 D ZS9S Q:'$D(X) Q:(X="0000000")!(X=9999999)
110 I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X I $D(X) S FAD=$P($G(^ONCO(165.5,D0,0)),U,8) I FAD'="" K:X<FAD X K %DT(0)
111 Q
112 ;
113DFSPIT ;DATE FIRST SURGICAL PROCEDURE (165.5,170) Input Transform
114 D ZS9S Q:'$D(X) Q:(X="0000000")!(X=9999999)
115 I $D(X) S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X
116 I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3)),U,1) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X W !!?3,"DATE FIRST SURGICAL PROCEDURE later than MOST DEFINITIVE SURG DATE",! K %DT(0),SDT Q
117 I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,8) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X W !!,"DATE FIRST SURGICAL PROCEDURE later than MOST DEFINITIVE SURG @FAC DATE",! K %DT(0),SDT Q
118 I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,22) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X W !!,"DATE FIRST SURGICAL PROCEDURE later than SCOPE OF LN SURGERY DATE",! K %DT(0),SDT Q
119 I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,23) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X W !!,"DATE FIRST SURGICAL PROCEDURE later than SCOPE OF LN SURGERY @FAC DATE",! K %DT(0),SDT Q
120 I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,24) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X W !!,"DATE FIRST SURGICAL PROCEDURE later than SURG PROC/OTHER SITE DATE",!
121 I $D(X) S SDT=$P($G(^ONCO(165.5,D0,3.1)),U,25) I SDT'="",SDT'="0000000",SDT'="9999999" I X>SDT K X W !!,"DATE FIRST SURGICAL PROCEDURE later than SURG PROC/OTHER SITE @FAC DATE",!
122 K %DT(0),SDT
123 Q
124 ;
125DFIT ;INPUT TRANSFORM for date fields
126 ;No future dates and date must be > or = DATE DX (165.5,3)
127 I $G(DIFLD)=124 S NTDD=""
128 D ZS9S Q:ZS9S=1
129 S %DT="EP",%DT(0)="-NOW" D ^%DT
130 S X=Y I Y<1 K X W !!?5,"Future dates are not allowed.",! K %DT(0) Q
131 S X=X,DTDX=$P($G(^ONCO(165.5,D0,0)),U,16),FAIL=""
132 I X<DTDX S FAIL=FAIL_"X"
133 I FAIL'="" D Q
134 .K X
135 .W !!?5,"The date entered must be later than or equal to the"
136 .I FAIL["X" W !?5,"DATE DX which is ",$E(DTDX,4,5)_"/"_$E(DTDX,6,7)_"/"_($E(DTDX,1,3)+1700),$S(FAIL["A":" and the",1:".")
137 .W ! K DTDX
138 S DFSP=$P($G(^ONCO(165.5,D0,3.1)),U,38)
139 I $D(X),$G(DIFLD)=50 D Q
140 .I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X W !!?3,"MOST DEFINITIVE SURG DATE earlier than DATE FIRST SURGICAL PROCEDURE",!
141 I $D(X),$G(DIFLD)=50.3 D Q
142 .I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X W !!?3,"MOST DEFINITIVE SURG @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",!
143 I $D(X),$G(DIFLD)=138.2 D Q
144 .I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X W !!?3,"SCOPE OF LN SURGERY DATE earlier than DATE FIRST SURGICAL PROCEDURE",!
145 I $D(X),$G(DIFLD)=138.3 D Q
146 .I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X W !!?3,"SCOPE OF LN SURGERY @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",!
147 I $D(X),$G(DIFLD)=139.2 D Q
148 .I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X W !!?3,"SURG PROC/OTHER SITE DATE earlier than DATE FIRST SURGICAL PROCEDURE",!
149 I $D(X),$G(DIFLD)=139.3 D Q
150 .I DFSP'="",DFSP'="0000000",DFSP'="9999999" I X<DFSP K X W !!?3,"SURG PROC/OTHER SITE @FAC DATE earlier than DATE FIRST SURGICAL PROCEDURE",!
151 Q
152 ;
153NTIT ;INPUT TRANSFORM FOR DATE OF NO TREATMENT (165.5,124)
154 ;(NO FUTURE DATES AND >= DATE DX)
155 S NTDD=""
156 I (X="00/00/00")!(X="00/00/0000")!(X="00000000") K X Q
157 I (X="99/99/99")!(X="99/99/9999")!(X="99999999") K X Q
158 S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y I Y<1 K X W !!?5,"Future dates are not allowed.",! K %DT(0) Q
159 S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16) I DTDX'="" I X<DTDX K X W !!?5,"This date must be later than or equal to the DATE DX of ",$E(DTDX,4,5)_"/"_$E(DTDX,6,7)_"/"_($E(DTDX,1,3)+1700)_".",! K DTDX Q
160 Q
161 ;
162NT ;DATE OF NO TREATMENT (Input transform for treatment fields)
163 S NTDD=$P($G(^ONCO(165.5,D0,2.1)),U,11)
164 I (NTDD'="")&(X'=V) K X W !!?5,"This primary has a DATE OF NO TREATMENT of ",$E(NTDD,4,5)_"/"_$E(NTDD,6,7)_"/"_($E(NTDD,1,3)+1700)_".",!?5,"Treatments are not allowed unless the DATE OF NO TREATMENT is deleted.",!
165 K NTDD,V Q
166 ;
167DBTS ;DATE BRACHYTHERAPY STARTED INPUT TRANSFORM (NOT FUTURE, DX<=DBS<=DBE)
168 S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X Q:'$D(X)
169 S DBE=$P($G(^ONCO(165.5,D0,"STS2")),U,13),DTDX=$P($G(^ONCO(165.5,D0,0)),U,16)
170 I DBE'="" K:X>DBE X Q:'$D(X)
171 I DTDX'="" K:X<DTDX X K %DT(0)
172 Q
173DBTE ;DATE BRACHYTHERAPY ENDED INPUT TRANSFORM (NOT FUTURE, DBS<=DBE)
174 S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X I $D(X) S DBS=$P($G(^ONCO(165.5,D0,"STS2")),U,12) I DBS'="" K:X<DBS X K %DT(0)
175 Q
176 ;
177ZS9S ;00/00/0000, 88/88/8888 and 99/99/9999 INPUT TRANSFORM
178 S ZS9S=1
179 I X="00/00/00" W *7,!!?5,"'00/00/00' is ambiguous. Enter a 4 digit year." K X Q
180 I X="00/00/0000" S X="0000000" Q
181 I X="00000000" S X="0000000" Q
182 ;
183NINES ;99/99/9999 INPUT TRANSFORM
184 I X="99/99/99" W !!?5,"99/99/99 is ambiguous. Enter a 4 digit year." K X Q
185 I X="99/99/9999" S X=9999999 Q
186 I X="99999999" S X=9999999 Q
187 ;
188EIGHTS ;88/88/8888 INPUT TRANSFORM
189 I $G(DIFLD)'=58.3,$G(DIFLD)'=58.5,$G(DIFLD)'=50,$G(DIFLD)'=50.3,$G(DIFLD)'=138.2,$G(DIFLD)'=138.3,$G(DIFLD)'=139.2,$G(DIFLD)'=139.3,$G(DIFLD)'=435 D K FLD Q:X=8888888
190 .I X="88/88/88" W !!?5,"88/88/88 is ambiguous. Enter a 4 digit year." K X Q
191 .I X="88/88/8888" S X=8888888
192 .I X="88888888" S X=8888888
193 S ZS9S=0
194 Q
Note: See TracBrowser for help on using the repository browser.