source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOCFP.m@ 901

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1ONCOCFP ;Hines OIFO/GWB - PTF CASEFINDING ;8/11/93
2 ;;2.11;ONCOLOGY;**22,23,25,26,27,28,29,34,43,46**;Mar 07, 1995;Build 39
3 ;
4 W @IOF
5 W !!!?10,"****************** PTF CASEFINDING ******************",!
6 W !?10,"This option will search the PRINCIPLE DIAGNOSIS and"
7 W !?10,"SECONDARY DIAGNOSIS fields of the PTF file for ICD-9"
8 W !?10,"codes which identify cases to be added to the Suspense"
9 W !?10,"list."
10 ;
11T ;Start Date/End Date
12 W !
13 S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
14 S SDDEF=$P(^ONCO(160.1,OSP,0),U,7)
15 I SDDEF="" S SDDEF=DT
16 S SDDEF=$E(SDDEF,4,5)_"-"_$E(SDDEF,6,7)_"-"_($E(SDDEF,1,3)+1700)
17SD K DIR
18 S DIR(0)="D"
19 S DIR("A")=" Start Date"
20 S DIR("B")=SDDEF
21 D ^DIR
22 G EX:(Y="")!(Y[U)
23 I (Y>DT) W *7," Future dates not allowed" G SD
24 S (SD,X)=Y D DD^%DT W " ",Y
25ED K DIR
26 S DIR(0)="D"
27 S DIR("A")=" End Date"
28 D ^DIR
29 G EX:(Y="")!(Y[U)
30 I (Y<SD) W *7," Invalid date sequence" G T
31 I (Y>DT) W *7," Future dates not allowed" G ED
32 S $P(^ONCO(160.1,OSP,0),U,7)=Y
33 S (ED,X)=Y D DD^%DT W " ",Y
34 W !
35 K DIR
36 S DIR(0)="Y"
37 S DIR("A")=" Dates OK"
38 S DIR("B")="Y"
39 D ^DIR
40 G EX:(Y="")!(Y[U)
41 G T:'Y
42 S ONCO("SD")=SD,ONCO("ED")=ED
43 W !!?3,"The following ICD-9 codes will be searched for:"
44 W !
45 W !?3,"140-239 NEOPLASMS"
46 W !?3," (excluding benign neoplasms 210-229 unless listed below)"
47 W !?3,"042.2 HIV WITH SPECIFIED MALIGNANT NEOPLASMS"
48 W !?3,"225.0-225.9 BENIGN NEOPLASMS OF BRAIN AND OTHER PARTS OF NERVOUS SYSTEM"
49 W !?3,"227.3 BENIGN NEOPLASM OF PITUITARY GLAND AND CRANIOPHARYNGEAL DUCT"
50 W !?3,"227.4 BENIGN NEOPLASM OF PINEAL GLAND"
51 W !?3,"259.2 CARCINOID SYNDROME"
52 W !?3,"273.1-273.9 DISORDERS OF PLASMA PROTEIN METABOLISM"
53 W !?3,"284.9 ANAPLASTIC ANEMIA, UNSPECIFIED"
54 W !?3,"285.0 SIDEROBLASTIC ANEMIA"
55 W !?3,"288.3 EOSINOPHILIA"
56 W !?3,"289.8 OTHER SPECIFIED DISEASES OF BLOOD AND BLOOD-FORMING ORGANS"
57 W !?3,"V07.3 NEED FOR OTHER PROPHYLACTIC CHEMOTHERAPY"
58 W !?3,"V07.8 NEED FOR OTHER SPECIFIED PROPHYLACTIC MEASURE"
59 W !?3,"V10.00-V10.09 GASTROINTESINAL TRACT"
60 W !?3,"V58.0-V58.1 ENCOUNTER FOR RADIOTHERAPY/CHEMOTHERAPY"
61 W !?3,"V66.1-V66.2 CONVALESCENCE FOLLOWING RADIOTHERAPY/CHEMOTHERAPY"
62 W !?3,"V67.1-V67.2 FOLLOW-UP EXAMINATION FOLLOWING RADIOTHERAPY/CHEMOTHERAPY"
63 W !?3,"V71.1 OBSV-SUSPCT MAL NEOPLASM"
64 W !?3,"V76.0-V76.9 SPECIAL SCREENING FOR MALIGNANT NEOPLASMS"
65 W !
66 K IO("Q") S %ZIS="Q" D ^%ZIS I POP G EX
67 I '$D(IO("Q")) D SER^ONCOCFP G EX
68 S ZTRTN="SER^ONCOCFP",ZTSAVE("ONCO*")="",ZTDESC="ONCOLOGY PTF SEARCH"
69 D ^%ZTLOAD
70 G EX
71 ;
72SER ;Search PTF (45) file
73 S AFFDIV=$G(DUZ(2)),ONCDIVSP=$O(^ONCO(160.1,"C",AFFDIV,""))
74 I ONCDIVSP="" W !!,"User does not have an associated DIVISION",!! G EX
75 F Z=0:0 S Z=$O(^ONCO(160.1,ONCDIVSP,6,Z)) Q:Z'>0 S AFFDIV=AFFDIV_U_$G(^ONCO(160.1,ONCDIVSP,6,Z,0))
76 K ^TMP("ONCO",$J)
77 S XDT=ONCO("SD")-.1111111
78 S XED=ONCO("ED")+.9999999
79 S ^TMP("ONCO",$J,0)=0
80 F S XDT=$O(^DGPT("ADS",XDT)) Q:(XDT>XED)!(XDT="") S D0=$O(^(XDT,0)),X70=$G(^DGPT(D0,70)),X71=$G(^DGPT(D0,71)) I X70'="" D IC
81 I $G(^TMP("ONCO",$J,0))=0 G WP
82 E D
83 .S DIC="^ONCO(160,"
84 .S BY="@75,INTERNAL(#3),75,.01"
85 .S FR=DUZ(2)_","_ONCO("SD"),TO=DUZ(2)_","_ONCO("ED")
86 .S FLDS="[ONCO PTF-CASEFINDING RPT]"
87 S L=0,IOP=ION,DIOEND="D WP^ONCOCFP"
88 D EN1^DIP G EX
89 ;
90WP ;Wrap-up report
91 W !?3,$G(^TMP("ONCO",$J,0))_" PTF cases added to Suspense"
92 Q
93 ;
94IC ;Search for ICD9 codes
95 K HT,IC9,IC,ICD,ICP
96 S P="",CI=0
97 F F=10,16:1:24 S ICP=+$P(X70,U,F) I ICP S ICD=$G(^ICD9(ICP,0)),IC9=$P(ICD,U,1) D FD Q:CI=1
98 I X71'="",CI=0 F F=1,2,3,4 S ICP=+$P(X71,U,F) I ICP S ICD=$G(^ICD9(ICP,0)),IC9=$P(ICD,U,1) D FD Q:CI=1
99 Q:CI=0 G CK
100 ;
101FD I ((IC9>139.9)&(IC9<210)) S CI=1 Q
102 I ((IC9>224.9)&(IC9<226)) S CI=1 Q
103 I (IC9=227.3)!(IC9=227.4) S CI=1 Q
104 I ((IC9>229.9)&(IC9<240)) S CI=1 Q
105 I (IC9=259.2)!(IC9=273.1)!(IC9=273.2)!(IC9=273.3)!(IC9=273.9)!(IC9=284.9)!(IC9=288.3)!(IC9=289.8)!(IC9="042.2")!(IC9="285.0") S CI=1 Q
106 I $E(IC9)="V" S CD=$E(IC9,2,5) I ((CD>9)&(CD<11))!(CD=58.0)!(CD=58.1)!(CD=66.1)!(CD=66.2)!(CD=67.1)!(CD=67.2)!(CD=71.1)!(CD="07.3")!(CD="07.8")!($E(CD,1,2)=76) S CI=1 Q
107 Q
108 ;
109CK ;Check ONCOLOGY PATIENT (160) file
110 Q:IC9=""
111 D DIV Q:DVMTCH=0
112 S X=^DGPT(D0,0),ADT=$P($P(X,U,2),"."),X=$P(X,U)_";DPT("
113 S XD0=$O(^ONCO(160,"B",X,0)),ONCIEN=XD0 I XD0="" G MR
114 I XD0'="" S ONCDIVS="",ONCS="" F S ONCS=$O(^ONCO(160,XD0,"SUS","C",ONCS)) Q:ONCS'>0 S ONCDIVS=ONCDIVS_U_ONCS
115 I ONCDIVS[DUZ(2) Q
116 S DA=XD0 I '$D(^ONCO(165.5,"C",XD0)) G N2
117 ;
118CKP ;Check ONCOLOGY PRIMARY (165.5) file
119 S XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
120 .S XDX=$P($G(^ONCO(165.5,XD1,0)),U,16) I XDT>(ADT-1)&(XDX<($P(XDT,".")+1)) S HT=1 Q
121 .S XDX=$P($G(^ONCO(165.5,XD1,1)),U,10) I XDX=XDT S HT=1 Q
122 Q
123 ;
124MR ;Creat ONCOLOGY PATIENT (160) record
125 Q:$D(HT)
126 S DIC="^ONCO(160,",DIC(0)="Z" D FILE^DICN
127 S (ONCIEN,XD0,DA)=+Y
128 ;
129N2 ;Create SUSPENSE (160.075) record
130 K DD,DO
131 S X1=ADT,X2=1 D C^%DTC S SDT=X
132 S X1=ONCO("SD"),X2=1 D C^%DTC S WSD=X
133 S DA(1)=ONCIEN,DIC="^ONCO(160,"_DA(1)_",""SUS"","
134 S DIC(0)="L",DIC("P")=$P(^DD(160,75,0),U,2),X=$S(SDT<WSD:WSD,1:SDT)
135 D FILE^DICN
136 K DIE S DA(1)=ONCIEN,DIE="^ONCO(160,"_DA(1)_",""SUS"","
137 S (ONCSUB,DA)=+Y,PTFDT=$P(XDT,".")
138 S DR="1///^S X=DT;2///^S X=""PT"";3////^S X=DUZ(2);7///^S X=PTFDT;8////^S X=ICP"
139 D ^DIE
140 S ^TMP("ONCO",$J,0)=^TMP("ONCO",$J,0)+1
141 Q
142 ;
143DIV ;DIVISION match
144 S DVMTCH=1,INST=""
145 S PTFD0=D0,PTMV=$O(^DGPM("APTF",PTFD0,"")) I PTMV="" Q
146 S WL=$P($G(^DGPM(PTMV,0)),U,6) I WL="" Q
147 S MCDV=$P($G(^DIC(42,WL,0)),U,11) I MCDV="" Q
148 S INST=$P($G(^DG(40.8,MCDV,0)),U,7) I INST="" Q
149 I AFFDIV'[INST S DVMTCH=0 Q
150 Q
151 ;
152EX ;EXIT
153 K %DT,%T
154 K ADT,AFFDIV,CD,CI,D0,DIR,DR,DVMTCH,ED,GLO,IC,ICP,INST,MCDV,NM,O2
155 K ONCDIVS,ONCDIVSP,ONCIEN,ONCO,ONCS,ONCSUB,OSP,P,SD,WED,WSD,X70,X71
156 K ^TMP("ONCO",$J)
157 D ^%ZISC
158 Q
Note: See TracBrowser for help on using the repository browser.