source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOES.m@ 847

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1ONCOES ;Hines OIFO/GWB - ONCOLOGY PATIENT (160) computed fields ;08/10/00
2 ;;2.11;ONCOLOGY;**1,5,6,11,15,16,18,26,27,33,34,35,36,44,46**;Mar 07, 1995;Build 39
3 ;
4SETUP ;SETUP INITIAL PARAMETERS
5 S X="",ONCON=^ONCO(160,D0,0),ONCOX=$P(ONCON,U),ONCOX1="^"_$P(ONCOX,";",2)_+ONCOX_",0)"
6 Q
7SETUP1 I $D(^ONCO(160,D0,0)) D SETUP S ONCOX1=$P(ONCOX,";",2)_+ONCOX_",.11)",ONCOX1=U_ONCOX1
8 Q
9SETUP2 I $D(^ONCO(160,D0,0)) D SETUP S ONCOX1=$P(ONCOX,";",2)_+ONCOX_",.13)",ONCOX1=U_ONCOX1
10 Q
11SETUP3 I $D(^ONCO(160,D0,0)) D SETUP S ONCOX1=$P(ONCOX,";",2)_+ONCOX_",.321)",ONCOX1=U_ONCOX1
12 Q
13SSN ;SSN (160,2)
14 S X="" Q:'$D(^ONCO(160,D0,0)) D SETUP
15 S X=$S($D(@ONCOX1):$P(@ONCOX1,U,9),1:"") G:X="" END1
16 I X?9N S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
17 G END1
18 ;
19TRM ;TERMINAL DIGIT FILING, TO SORT BY FOR MEDICAL RECORDS
20 I $D(^ONCO(160,D0,0)) D SETUP S X=$S($D(@ONCOX1):$P(@ONCOX1,U,9),1:"") I X'="" S X="T"_$E(X,8,9)_$E(X,6,7)_$E(X,4,5)_$E(X,1,3)
21 G END1
22DOB ;DOB
23 I $D(^ONCO(160,D0,0)) D SETUP S X=$S($D(@ONCOX1):$P(@ONCOX1,U,3),1:"")
24 D DATEOT S Y=X
25 G END1
26 ;
27RACE ;RACE 1 (160,8) default
28 I $D(^ONCO(160,D0,0)) D SETUP
29 I ONCOX["DPT" S DFN=$P(ONCOX,";",1) D DEM^VADPT
30 S X=$P($G(VADM(12,1)),U,2)
31 I X="" S X=$P($G(VADM(8)),U,2)
32 G END1
33 ;
34DATEOT ;Date output transform
35 I X="0000000" D DD Q
36 I $E(X,4,5)="00" S $E(X,4,5)=99
37 I $E(X,6,7)="00" S $E(X,6,7)=99
38 D DD
39 Q
40 ;
41DOB1 ;date of birth returned in X in File Manager format
42 I $D(^ONCO(160,D0,0)) D SETUP S X=$S($D(@ONCOX1):$P(@ONCOX1,U,3),1:"")
43 G END
44MS ;
45 I $D(^ONCO(160,D0,0)) D SETUP S ONCOX2=$S($D(@ONCOX1):$P(@ONCOX1,U,5),1:""),X=$S((ONCOX2>0):$P(^DIC(11,ONCOX2,0),U,1),1:"")
46 G END
47REL ;
48 I $D(^ONCO(160,D0,0)) D SETUP S ONCOX2=$S($D(@ONCOX1):$P(@ONCOX1,U,8),1:""),X=$S((ONCOX2>0):$P(^DIC(13,ONCOX2,0),U,1),1:"")
49 G END
50 ;
51OCC ;Current Occupation from MAS
52 I $D(^ONCO(160,D0,0)) D SETUP S X=$S($D(@ONCOX1):$P(@ONCOX1,U,7),1:"")
53 G END
54 ;
55ALIAS ;ALIAS (160,1)
56 S X=""
57 Q:'$D(^ONCO(160,D0,0))
58 D SETUP Q:$P(ONCOX,";",2)'="DPT(" S XD0=$P(ONCOX,";")
59 ;S XD1=0 F S XD1=$O(^DPT(XD0,.01,XD1)) Q:XD1'>0 W !,$P(^(XD1,0),U)
60 S XD1=0 F S XD1=$O(^DPT(XD0,.01,XD1)) Q:XD1'>0 S X=$P(^(XD1,0),U)
61 Q
62 ;
63SA1 ;
64 D SETUP1 S X=$S($D(@ONCOX1):$P(@ONCOX1,U,1),1:"")
65 G END
66SA2 ;
67 D SETUP1 S X=$S($D(@ONCOX1):$P(@ONCOX1,U,2),1:"")
68 G END
69SA3 ;
70 D SETUP1 S X=$S($D(@ONCOX1):$P(@ONCOX1,U,3),1:"")
71 G END
72NOTE ;NONE OF THE COMPUTED FIELDS BELOW USING ZIPCODE FILE CAN BE USED SO LONG AS MAS DOES NOT USE THE ZICODE FILE;THE ZIPCODE PICKED WILL BE THE FIRST IF THE LIST IF MORE THAN ONE SELECTION
73ZIPCT ;gets City, State ZIP County
74 D ZIP1 S X=Z_" "_$P($G(^VIC(5.1,+($P($G(^VIC(5.11,+Y,0)),U,3)),0)),U)
75 G END
76 ;
77ADD ;Address from MAS
78 D SETUP1 S X=$G(@ONCOX1),X=$P(X,U)_" "_$P(X,U,2)
79 S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
80 G END
81ZIP ;gets City, State ZIP
82 ;get fields from MAS fields
83 I $D(^ONCO(160,D0,0)) D SETUP1 S Y=$S($D(@ONCOX1):$P(@ONCOX1,U,4,6),1:""),X=$P(Y,U,2),X=$S(X="":"",1:", "_$P(^DIC(5,X,0),U,2)),X=$P(Y,U)_X_" "_$P(Y,U,3)
84 G END
85 ;
86CTY ;County from MAS (State file)
87 I $D(^ONCO(160,D0,0)) D SETUP1 S Y=$S($D(@ONCOX1):$P(@ONCOX1,U,5,7),1:""),X=$P(Y,U),Y=+$P(Y,U,3),X=$S(X="":"",1:$P($G(^DIC(5,X,1,Y,0)),U))
88 G END
89ZIP1 I $D(^ONCO(160,D0,0)) D SETUP1 S X=$S($D(@ONCOX1):$P(@ONCOX1,U,6),1:"")
90 S Y=$O(^VIC(5.11,"B",X_" ",0)),Z=$S(Y="":Y,$D(^VIC(5.11,Y,0))#2:$P(^(0),U,2)_","_$P(^DIC(5,$P(^VIC(5.1,$P(^VIC(5.11,Y,0),U,3),0),U,2),0),U,2)_" "_$P(^VIC(5.11,Y,0),U,1),1:"") Q
91 G END
92CT ;Get County from Zipcode
93 I $D(^ONCO(160,D0,0)) D SETUP1 S X=$S($D(@ONCOX1):$P(@ONCOX1,U,6),1:"") Q:X="" S X=$O(^VIC(5.11,"B",X_" ",0)) Q:X="" S X=$P(^VIC(5.1,$P(^VIC(5.11,X,0),U,3),0),U)
94 G END
95ZCTY ;Gets County from Zipcode
96 D ZIP1 S X=$P(^VIC(5.1,$P(^VIC(5.11,Y,0),U,3),0),U)
97 G END
98ST ;gets State #.11:5
99 I $D(^ONCO(160,D0,0)) D SETUP1 S Y=$P($G(@ONCOX1),U,5),X=$P($G(^DIC(5,+Y,0)),U,2)
100 G END
101PH ;
102 S X="" Q:'$D(^ONCO(160,D0,0)) D SETUP2 S X=$S($D(@ONCOX1):$P(@ONCOX1,U,1),1:9999999999)
103 G END
104 ;
105EMP ;Employment Status
106 I $D(^ONCO(160,D0,0)) D SETUP S X1=$P(ONCOX1,";",2) G END:X1="LRT(" S X1="^DPT("_$P(ONCOX,";")_",.311)",X=$P($G(@X1),U,15),X=$P($P($P(^DD(2,.31115,0),U,3),";",X),":",2) G END
107 ;
108ENVIRON ;Environmental exposure defaults
109 I $P(^ONCO(160,D0,0),U,1)["LRT(67," S (AOE,IRE,PGS,SS,MES)="" Q
110 S DPTIEN=$P(^ONCO(160,D0,0),";",1)
111 S AOE=$$GET1^DIQ(2,DPTIEN,.32102,"E") ;Agent Orange Exposure
112 S IRE=$$GET1^DIQ(2,DPTIEN,.32103,"E") ;Ionizing Radiation Exposure
113 S PGS=$$GET1^DIQ(2,DPTIEN,.32201,"E") ;Persian Gulf Service
114 S SS=$$GET1^DIQ(2,DPTIEN,.322016,"E") ;Somalia Service
115 S MES=$$GET1^DIQ(2,DPTIEN,.3221,"E") ;Middle East Service
116 K DPTIEN
117 Q
118 ;
119DD S (X,Y)=$S(X="":"",X="0000000":"00/00/0000",X=8888888:"88/88/8888",X=9999999:"99/99/9999",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3)))
120 Q
121END ;
122 K ONCON,ONCOX,ONCOX1,ONCOX2,ONCODIWL,Z
123END1 ;
124 K ONCOX1
125 Q
126EXIT ;
127 S X="" G END
128AAD ;ADDRESS AT DX
129 S PCAD=$P($G(^ONCO(165.5,D0,1)),U,2)
130 S SADP=$P($G(^ONCO(165.5,D0,1)),U,4)
131 S SAD="" I SADP'="" S SAD=$P($G(^ONCO(160.15,SADP,0)),U,1)
132 S CTAD=$P($G(^ONCO(165.5,D0,1)),U,12)
133 S AAD=CTAD_" "_SAD_" "_PCAD
134 S AAD=$$LCASE^ONCOU(AAD)
135 Q
136W17AAD W !,?21,AAD G AADEX
137W9AAD W !,?9,AAD G AADEX
138AADEX K PCAD,SADP,SAD,CTAD,AAD
139 Q
140TLEEOT ;TUMOR LEVEL FROM ENDOSCOPIC EXAM OUTPUT TRANSFORM
141 S:$L(Y)=1 Y="0"_Y
142 I Y="00" S Y="Endoscopic exam not performed" Q
143 I Y=61 S Y="Splenic flexure" Q
144 I Y=62 S Y="Transverse colon" Q
145 I Y=63 S Y="Hepatic flexure" Q
146 I Y=64 S Y="Ascending colon" Q
147 I Y=65 S Y="Cecum" Q
148 I Y=70 S Y="Endoscopic exam, tumor not visualized" Q
149 I Y=80 S Y="Endoscopic exam, results unknown" Q
150 I Y=99 S Y="Unknown if exam done" Q
151 S Y=Y_" centimeters" Q
152ASPIT ;ADDITIONAL SURGICAL PROCEDURES INPUT TRANSFORM
153 I X<10 K X Q
154 I "10^20^30^40^41^42^43^44^50^60^88^99"'[X K X Q
155 S Y=X D ASPOT W " ",Y K Y Q
156 ;
157ASPOT ;ADDITIONAL SURGICAL PROCEDURES OUTPUT TRANSFORM
158 D SETASP
159 I Y'="" S Y=ASP(Y) K ASP Q
160 Q
161 ;
162ASPHP D SETASP
163 F ASPX=0:0 S ASPX=$O(ASP(ASPX)) Q:ASPX'>0 W !," ",ASPX," ",ASP(ASPX)
164 W ! K ASP,ASPX Q
165SETASP ;
166 S ASP(10)="Transanal excision"
167 S ASP(20)="Posterior sacral"
168 S ASP(30)="Anterior resection w/o anastomosis"
169 S ASP(40)="Anterior resection w anastomosis, NOS"
170 S ASP(41)="Anterior resection w simple anastomosis"
171 S ASP(42)="Ant res w colo pouch coloanal anastomosis"
172 S ASP(43)="Anterior resection w ilioanal anastomosis"
173 S ASP(44)="Anterior resection w coloanal anastomosis"
174 S ASP(50)="Colostomy w/o resection"
175 S ASP(60)="Abdomino perineal resection (APR)"
176 S ASP(88)="NA, none performed"
177 S ASP(99)="Unknown if performed" Q
178 ;
179PTRDOT ;PRIMARY TUMOR RAD DOSE (cGy) OUTPUT TRANSFORM
180 S Y=$S($L(Y)=1:"0000"_Y,$L(Y)=2:"000"_Y,$L(Y)=3:"00"_Y,$L(Y)=4:"0"_Y,1:Y)
181 I Y="00000" S Y="No radiation therapy"
182 I Y="88888" S Y="Received radiation therapy, dose unknown"
183 I Y="99999" S Y="Unknown if received radiation therapy"
184 Q
Note: See TracBrowser for help on using the repository browser.