159 lines
5.7 KiB
Mathematica
159 lines
5.7 KiB
Mathematica
ONCOCFP ;Hines OIFO/GWB - PTF CASEFINDING ;8/11/93
|
|
;;2.11;ONCOLOGY;**22,23,25,26,27,28,29,34,43,46**;Mar 07, 1995;Build 39
|
|
;
|
|
W @IOF
|
|
W !!!?10,"****************** PTF CASEFINDING ******************",!
|
|
W !?10,"This option will search the PRINCIPLE DIAGNOSIS and"
|
|
W !?10,"SECONDARY DIAGNOSIS fields of the PTF file for ICD-9"
|
|
W !?10,"codes which identify cases to be added to the Suspense"
|
|
W !?10,"list."
|
|
;
|
|
T ;Start Date/End Date
|
|
W !
|
|
S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
S SDDEF=$P(^ONCO(160.1,OSP,0),U,7)
|
|
I SDDEF="" S SDDEF=DT
|
|
S SDDEF=$E(SDDEF,4,5)_"-"_$E(SDDEF,6,7)_"-"_($E(SDDEF,1,3)+1700)
|
|
SD K DIR
|
|
S DIR(0)="D"
|
|
S DIR("A")=" Start Date"
|
|
S DIR("B")=SDDEF
|
|
D ^DIR
|
|
G EX:(Y="")!(Y[U)
|
|
I (Y>DT) W *7," Future dates not allowed" G SD
|
|
S (SD,X)=Y D DD^%DT W " ",Y
|
|
ED K DIR
|
|
S DIR(0)="D"
|
|
S DIR("A")=" End Date"
|
|
D ^DIR
|
|
G EX:(Y="")!(Y[U)
|
|
I (Y<SD) W *7," Invalid date sequence" G T
|
|
I (Y>DT) W *7," Future dates not allowed" G ED
|
|
S $P(^ONCO(160.1,OSP,0),U,7)=Y
|
|
S (ED,X)=Y D DD^%DT W " ",Y
|
|
W !
|
|
K DIR
|
|
S DIR(0)="Y"
|
|
S DIR("A")=" Dates OK"
|
|
S DIR("B")="Y"
|
|
D ^DIR
|
|
G EX:(Y="")!(Y[U)
|
|
G T:'Y
|
|
S ONCO("SD")=SD,ONCO("ED")=ED
|
|
W !!?3,"The following ICD-9 codes will be searched for:"
|
|
W !
|
|
W !?3,"140-239 NEOPLASMS"
|
|
W !?3," (excluding benign neoplasms 210-229 unless listed below)"
|
|
W !?3,"042.2 HIV WITH SPECIFIED MALIGNANT NEOPLASMS"
|
|
W !?3,"225.0-225.9 BENIGN NEOPLASMS OF BRAIN AND OTHER PARTS OF NERVOUS SYSTEM"
|
|
W !?3,"227.3 BENIGN NEOPLASM OF PITUITARY GLAND AND CRANIOPHARYNGEAL DUCT"
|
|
W !?3,"227.4 BENIGN NEOPLASM OF PINEAL GLAND"
|
|
W !?3,"259.2 CARCINOID SYNDROME"
|
|
W !?3,"273.1-273.9 DISORDERS OF PLASMA PROTEIN METABOLISM"
|
|
W !?3,"284.9 ANAPLASTIC ANEMIA, UNSPECIFIED"
|
|
W !?3,"285.0 SIDEROBLASTIC ANEMIA"
|
|
W !?3,"288.3 EOSINOPHILIA"
|
|
W !?3,"289.8 OTHER SPECIFIED DISEASES OF BLOOD AND BLOOD-FORMING ORGANS"
|
|
W !?3,"V07.3 NEED FOR OTHER PROPHYLACTIC CHEMOTHERAPY"
|
|
W !?3,"V07.8 NEED FOR OTHER SPECIFIED PROPHYLACTIC MEASURE"
|
|
W !?3,"V10.00-V10.09 GASTROINTESINAL TRACT"
|
|
W !?3,"V58.0-V58.1 ENCOUNTER FOR RADIOTHERAPY/CHEMOTHERAPY"
|
|
W !?3,"V66.1-V66.2 CONVALESCENCE FOLLOWING RADIOTHERAPY/CHEMOTHERAPY"
|
|
W !?3,"V67.1-V67.2 FOLLOW-UP EXAMINATION FOLLOWING RADIOTHERAPY/CHEMOTHERAPY"
|
|
W !?3,"V71.1 OBSV-SUSPCT MAL NEOPLASM"
|
|
W !?3,"V76.0-V76.9 SPECIAL SCREENING FOR MALIGNANT NEOPLASMS"
|
|
W !
|
|
K IO("Q") S %ZIS="Q" D ^%ZIS I POP G EX
|
|
I '$D(IO("Q")) D SER^ONCOCFP G EX
|
|
S ZTRTN="SER^ONCOCFP",ZTSAVE("ONCO*")="",ZTDESC="ONCOLOGY PTF SEARCH"
|
|
D ^%ZTLOAD
|
|
G EX
|
|
;
|
|
SER ;Search PTF (45) file
|
|
S AFFDIV=$G(DUZ(2)),ONCDIVSP=$O(^ONCO(160.1,"C",AFFDIV,""))
|
|
I ONCDIVSP="" W !!,"User does not have an associated DIVISION",!! G EX
|
|
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))
|
|
K ^TMP("ONCO",$J)
|
|
S XDT=ONCO("SD")-.1111111
|
|
S XED=ONCO("ED")+.9999999
|
|
S ^TMP("ONCO",$J,0)=0
|
|
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
|
|
I $G(^TMP("ONCO",$J,0))=0 G WP
|
|
E D
|
|
.S DIC="^ONCO(160,"
|
|
.S BY="@75,INTERNAL(#3),75,.01"
|
|
.S FR=DUZ(2)_","_ONCO("SD"),TO=DUZ(2)_","_ONCO("ED")
|
|
.S FLDS="[ONCO PTF-CASEFINDING RPT]"
|
|
S L=0,IOP=ION,DIOEND="D WP^ONCOCFP"
|
|
D EN1^DIP G EX
|
|
;
|
|
WP ;Wrap-up report
|
|
W !?3,$G(^TMP("ONCO",$J,0))_" PTF cases added to Suspense"
|
|
Q
|
|
;
|
|
IC ;Search for ICD9 codes
|
|
K HT,IC9,IC,ICD,ICP
|
|
S P="",CI=0
|
|
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
|
|
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
|
|
Q:CI=0 G CK
|
|
;
|
|
FD I ((IC9>139.9)&(IC9<210)) S CI=1 Q
|
|
I ((IC9>224.9)&(IC9<226)) S CI=1 Q
|
|
I (IC9=227.3)!(IC9=227.4) S CI=1 Q
|
|
I ((IC9>229.9)&(IC9<240)) S CI=1 Q
|
|
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
|
|
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
|
|
Q
|
|
;
|
|
CK ;Check ONCOLOGY PATIENT (160) file
|
|
Q:IC9=""
|
|
D DIV Q:DVMTCH=0
|
|
S X=^DGPT(D0,0),ADT=$P($P(X,U,2),"."),X=$P(X,U)_";DPT("
|
|
S XD0=$O(^ONCO(160,"B",X,0)),ONCIEN=XD0 I XD0="" G MR
|
|
I XD0'="" S ONCDIVS="",ONCS="" F S ONCS=$O(^ONCO(160,XD0,"SUS","C",ONCS)) Q:ONCS'>0 S ONCDIVS=ONCDIVS_U_ONCS
|
|
I ONCDIVS[DUZ(2) Q
|
|
S DA=XD0 I '$D(^ONCO(165.5,"C",XD0)) G N2
|
|
;
|
|
CKP ;Check ONCOLOGY PRIMARY (165.5) file
|
|
S XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
|
|
.S XDX=$P($G(^ONCO(165.5,XD1,0)),U,16) I XDT>(ADT-1)&(XDX<($P(XDT,".")+1)) S HT=1 Q
|
|
.S XDX=$P($G(^ONCO(165.5,XD1,1)),U,10) I XDX=XDT S HT=1 Q
|
|
Q
|
|
;
|
|
MR ;Creat ONCOLOGY PATIENT (160) record
|
|
Q:$D(HT)
|
|
S DIC="^ONCO(160,",DIC(0)="Z" D FILE^DICN
|
|
S (ONCIEN,XD0,DA)=+Y
|
|
;
|
|
N2 ;Create SUSPENSE (160.075) record
|
|
K DD,DO
|
|
S X1=ADT,X2=1 D C^%DTC S SDT=X
|
|
S X1=ONCO("SD"),X2=1 D C^%DTC S WSD=X
|
|
S DA(1)=ONCIEN,DIC="^ONCO(160,"_DA(1)_",""SUS"","
|
|
S DIC(0)="L",DIC("P")=$P(^DD(160,75,0),U,2),X=$S(SDT<WSD:WSD,1:SDT)
|
|
D FILE^DICN
|
|
K DIE S DA(1)=ONCIEN,DIE="^ONCO(160,"_DA(1)_",""SUS"","
|
|
S (ONCSUB,DA)=+Y,PTFDT=$P(XDT,".")
|
|
S DR="1///^S X=DT;2///^S X=""PT"";3////^S X=DUZ(2);7///^S X=PTFDT;8////^S X=ICP"
|
|
D ^DIE
|
|
S ^TMP("ONCO",$J,0)=^TMP("ONCO",$J,0)+1
|
|
Q
|
|
;
|
|
DIV ;DIVISION match
|
|
S DVMTCH=1,INST=""
|
|
S PTFD0=D0,PTMV=$O(^DGPM("APTF",PTFD0,"")) I PTMV="" Q
|
|
S WL=$P($G(^DGPM(PTMV,0)),U,6) I WL="" Q
|
|
S MCDV=$P($G(^DIC(42,WL,0)),U,11) I MCDV="" Q
|
|
S INST=$P($G(^DG(40.8,MCDV,0)),U,7) I INST="" Q
|
|
I AFFDIV'[INST S DVMTCH=0 Q
|
|
Q
|
|
;
|
|
EX ;EXIT
|
|
K %DT,%T
|
|
K ADT,AFFDIV,CD,CI,D0,DIR,DR,DVMTCH,ED,GLO,IC,ICP,INST,MCDV,NM,O2
|
|
K ONCDIVS,ONCDIVSP,ONCIEN,ONCO,ONCS,ONCSUB,OSP,P,SD,WED,WSD,X70,X71
|
|
K ^TMP("ONCO",$J)
|
|
D ^%ZISC
|
|
Q
|