Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOCFP

ONCOCFP.m

Go to the documentation of this file.
  1. ONCOCFP ;HINES OIFO/GWB - [PT Automatic Casefinding-PTF Search] ;05/03/12
  1. ;;2.2;ONCOLOGY;**1,7,5,13**;Jul 31, 2013;Build 7
  1. ;
  1. ; rvd - 0403/12 p56. Use ICD API (#3990) instead of direct global call
  1. ; P2.2*7 - icd10 CASEFINDING
  1. W @IOF
  1. W !!!?10,"****************** PTF CASEFINDING ******************",!
  1. W !?10,"This option will search the PRINCIPLE DIAGNOSIS and"
  1. W !?10,"SECONDARY DIAGNOSIS fields of the PTF file for ICD"
  1. W !?10,"codes which identify cases to be added to the Suspense"
  1. W !?10,"list."
  1. ;
  1. T ;Start Date/End Date
  1. N SDDEF
  1. W !
  1. S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
  1. I OSP="" D Q
  1. .W !?10,"Casefinding requires an ONCOLOGY SITE PARAMETER"
  1. .W !?10,"entry which matches the user's login DIVISION."
  1. .W !?10,"There is no ONCOLOGY SITE PARAMETER for DIVISION:"
  1. .W !?10,$P($G(^DIC(4,DUZ(2),0)),U,1)
  1. S SDDEF=$P(^ONCO(160.1,OSP,0),U,7)
  1. I SDDEF="" S SDDEF=DT
  1. S SDDEF=$E(SDDEF,4,5)_"-"_$E(SDDEF,6,7)_"-"_($E(SDDEF,1,3)+1700)
  1. SD K DIR
  1. S DIR(0)="D"
  1. S DIR("A")=" Start Date"
  1. S DIR("B")=SDDEF
  1. D ^DIR
  1. G EX:(Y="")!(Y[U)
  1. I (Y>DT) W " Future dates not allowed" G SD
  1. S (SD,X)=Y D DD^%DT W " ",Y
  1. ED K DIR
  1. S DIR(0)="D"
  1. S DIR("A")=" End Date"
  1. D ^DIR
  1. G EX:(Y="")!(Y[U)
  1. I (Y<SD) W " Invalid date sequence" G T
  1. I (Y>DT) W " Future dates not allowed" G ED
  1. S $P(^ONCO(160.1,OSP,0),U,7)=Y
  1. S (ED,X)=Y D DD^%DT W " ",Y
  1. W !
  1. K DIR
  1. S DIR(0)="Y"
  1. S DIR("A")=" Dates OK"
  1. S DIR("B")="Y"
  1. D ^DIR
  1. G EX:(Y="")!(Y[U)
  1. G T:'Y
  1. S ONCO("SD")=SD,ONCO("ED")=ED
  1. ;
  1. ;Include Squamous and Basal cell neoplasms (Y/N?)
  1. W !
  1. ;S SBCIND="NO"
  1. ;K DIR
  1. ;S DIR(0)="Y"
  1. ;S DIR("A")=" Include Squamous and Basal cell neoplasms"
  1. ;S DIR("B")="Yes"
  1. ;S DIR("?")=" "
  1. ;S DIR("?",1)=" Answer 'YES' if you want to include squamous and basal cell neoplasms."
  1. ;S DIR("?",2)=" Answer 'NO' if you want to exclude these neoplasms."
  1. ;D ^DIR
  1. ;G EX:(Y="")!(Y[U)
  1. ;S:Y=1 SBCIND="YES"
  1. ;K DIR
  1. ;
  1. W !!?3,"The following ICD codes will be searched for:"
  1. W !
  1. W !?3,"140-239 NEOPLASMS"
  1. W !?3," (excluding benign neoplasms 210-229 unless listed below)"
  1. W !?3,"042.2 HIV WITH SPECIFIED MALIGNANT NEOPLASMS"
  1. W !?3,"225.0-225.9 BENIGN NEOPLASMS OF BRAIN AND OTHER PARTS OF NERVOUS SYSTEM"
  1. W !?3,"227.3 BENIGN NEOPLASM OF PITUITARY GLAND AND CRANIOPHARYNGEAL DUCT"
  1. W !?3,"227.4 BENIGN NEOPLASM OF PINEAL GLAND"
  1. W !?3,"228.02 HEMANGIOMA INTRACRANIAL"
  1. W !?3,"259.2 CARCINOID SYNDROME"
  1. W !?3,"273.1-273.9 DISORDERS OF PLASMA PROTEIN METABOLISM"
  1. W !?3,"284.9 ANAPLASTIC ANEMIA, UNSPECIFIED"
  1. W !?3,"285.0 SIDEROBLASTIC ANEMIA"
  1. W !?3,"288.3 EOSINOPHILIA"
  1. W !?3,"288.4 HEMOPHAGOCYTIC SYNDROMES"
  1. W !?3,"289.6 FAMILIAL POLYCYTHEMIA"
  1. W !?3,"289.8 OTHER SPECIFIED DISEASES OF BLOOD AND BLOOD-FORMING ORGANS"
  1. W !?3,"289.83 MYELOFIBROSIS"
  1. W !?3,"795.06 PAPANICOLAOU SMEAR OF CERVIX WITH CYTOLOGIC EVIDENCE OF"
  1. W !?3," MALIGNANCY"
  1. W !?3,"795.16 PAP SMR VAG-CYTOL MALIG"
  1. W !?3,"796.76 PAP SMR ANUS-CYTOL MALIG"
  1. ;
  1. ;NOTE: Code 795.76 is incorrect in the ICD DIAGNOSIS (80) file.
  1. ; It is appears as 796.76. PTF casefinding will look for both
  1. ; 795.76 and 796.76.
  1. ;
  1. W !?3,"V07.3 NEED FOR OTHER PROPHYLACTIC CHEMOTHERAPY"
  1. W !?3,"V07.8 NEED FOR OTHER SPECIFIED PROPHYLACTIC MEASURE"
  1. W !?3,"V10.00-V10.09 GASTROINTESINAL TRACT"
  1. W !?3,"V12.41 PERS HX BENIGN NEOPL OF BRAIN"
  1. W !?3,"V58.0 ENCOUNTER FOR RADIOTHERAPY"
  1. W !?3,"V58.1 ENCOUNTER FOR CHEMOTHERAPY"
  1. W !?3,"V58.11 ANTINEOPLASTIC CHEMO ENC"
  1. W !?3,"V58.12 IMMUNOTHERAPY ENCOUNTER"
  1. W !?3,"V66.1-V66.2 CONVALESCENCE FOLLOWING RADIOTHERAPY/CHEMOTHERAPY"
  1. W !?3,"V67.1-V67.2 FOLLOW-UP EXAMINATION FOLLOWING RADIOTHERAPY/CHEMOTHERAPY"
  1. W !?3,"V71.1 OBSV-SUSPCT MAL NEOPLASM"
  1. W !?3,"V76.0-V76.9 SPECIAL SCREENING FOR MALIGNANT NEOPLASMS"
  1. W !
  1. ;List of ICD10
  1. D L10^ONCOCFP1
  1. W !
  1. ;
  1. S %ZIS="Q" D ^%ZIS I POP G EX
  1. I '$D(IO("Q")) D SER^ONCOCFP G EX
  1. S ZTRTN="SER^ONCOCFP",ZTSAVE("ONCO*")="",ZTSAVE("SBCIND")="",ZTDESC="ONCOLOGY PTF SEARCH"
  1. D ^%ZTLOAD
  1. G EX
  1. ;
  1. SER ;Search PTF file (#45) file
  1. ;Supported by IA #418
  1. S AFFDIV=$G(DUZ(2)),ONCDIVSP=$O(^ONCO(160.1,"C",AFFDIV,""))
  1. I ONCDIVSP="" W !!,"User does not have an associated DIVISION",!! G EX
  1. 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))
  1. K ^TMP("ONCO",$J)
  1. S XDT=ONCO("SD")-.1111111
  1. S XED=ONCO("ED")+.9999999
  1. S ^TMP("ONCO",$J,0)=0
  1. 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
  1. I $G(^TMP("ONCO",$J,0))=0 G WP
  1. E D
  1. .S DIC="^ONCO(160,"
  1. .S BY="@75,INTERNAL(#3),75,.01"
  1. .S FR=DUZ(2)_","_ONCO("SD"),TO=DUZ(2)_","_ONCO("ED")
  1. .S FLDS="[ONCO PTF-CASEFINDING RPT]"
  1. S L=0,IOP=ION,DIOEND="D WP^ONCOCFP"
  1. D EN1^DIP Q
  1. ;
  1. WP ;Wrap-up report
  1. W !?3,$G(^TMP("ONCO",$J,0))_" PTF cases added to Suspense"
  1. Q
  1. ;
  1. IC ;Search for ICD codes
  1. K HT,IC9,IC,ICD,ICP,CI10
  1. S P="",CI=0,CI10=0
  1. F F=10,16:1:24 S ICP=+$P(X70,U,F) I ICP>0 S IC9=$$GET1^DIQ(80,ICP,.01,"I") D FD Q:(CI=1)!(CI10=1)
  1. I (X71'=""),(CI=0),(CI10=0) F F=1:1:15 S ICP=+$P(X71,U,F) I ICP>0 S IC9=$$GET1^DIQ(80,ICP,.01,"I") D FD Q:(CI=1)!(CI10=1)
  1. ;I CI=0 D IC10^ONCOCFP1
  1. I (CI=0),(CI10=0) Q
  1. G CK
  1. ;
  1. FD I ((IC9>139.9)&(IC9<210)) S CI=1 Q
  1. I ((IC9>224.9)&(IC9<226)) S CI=1 Q
  1. I (IC9=227.3)!(IC9=227.4)!(IC9=228.02) S CI=1 Q
  1. I ((IC9>229.9)&(IC9<240)) S CI=1 Q
  1. I (IC9=259.2)!(IC9=273.1)!(IC9=273.2)!(IC9=273.3)!(IC9=273.9)!(IC9=284.9)!(IC9=288.3)!(IC9=288.4)!(IC9=289.6)!(IC9=289.8)!(IC9=289.83)!(IC9=795.06)!(IC9=795.16)!(IC9=795.76)!(IC9=796.76)!(IC9="042.2")!(IC9="285.0") S CI=1 Q
  1. I $E(IC9)="V" S CD=$E(IC9,2,5) I ((CD>9)&(CD<11))!(CD=12.41)!(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
  1. S IC10=IC9 D FD10^ONCOCFP1
  1. Q
  1. ;
  1. CK ;Check ONCOLOGY PATIENT (160) file
  1. ;Supported by IA #418
  1. I ($G(IC9)=""),($G(IC10)="") Q
  1. D DIV Q:DVMTCH=0
  1. S X=^DGPT(D0,0),ADT=$P($P(X,U,2),"."),X=$P(X,U)_";DPT("
  1. S XD0=$O(^ONCO(160,"B",X,0)),ONCIEN=XD0 I XD0="" G MR
  1. I XD0'="" S ONCDIVS="",ONCS="" F S ONCS=$O(^ONCO(160,XD0,"SUS","C",ONCS)) Q:ONCS'>0 S ONCDIVS=ONCDIVS_U_ONCS
  1. I ONCDIVS[DUZ(2) Q
  1. S DA=XD0 I '$D(^ONCO(165.5,"C",XD0)) G N2
  1. ;
  1. CKP ;Check ONCOLOGY PRIMARY (165.5) file
  1. S XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
  1. .S XDX=$P($G(^ONCO(165.5,XD1,0)),U,16) I XDT>(ADT-1)&(XDX<($P(XDT,".")+1)) S HT=1 Q
  1. .S XDX=$P($G(^ONCO(165.5,XD1,1)),U,10) I XDX=XDT S HT=1 Q
  1. Q
  1. ;
  1. MR ;Create ONCOLOGY PATIENT (160) record
  1. Q:$D(HT)
  1. K DO S DIC="^ONCO(160,",DIC(0)="Z" D FILE^DICN K DO
  1. S (ONCIEN,XD0,DA)=+Y
  1. ;
  1. N2 ;Create SUSPENSE (160.075) record
  1. N DD,PTFDT,X1,X2
  1. S X1=ADT,X2=1 D C^%DTC S SDT=X
  1. S X1=ONCO("SD"),X2=1 D C^%DTC S WSD=X
  1. S DA(1)=ONCIEN,DIC="^ONCO(160,"_DA(1)_",""SUS"","
  1. K DO S DIC(0)="L",DIC("P")=$P(^DD(160,75,0),U,2),X=$S(SDT<WSD:WSD,1:SDT)
  1. D FILE^DICN K DO
  1. K DIE S DA(1)=ONCIEN,DIE="^ONCO(160,"_DA(1)_",""SUS"","
  1. S (ONCSUB,DA)=+Y,PTFDT=$P(XDT,".")
  1. S DR="1///^S X=DT;2///^S X=""PT"";3////^S X=DUZ(2);7///^S X=PTFDT;8////^S X=ICP"
  1. D ^DIE
  1. S ^TMP("ONCO",$J,0)=^TMP("ONCO",$J,0)+1
  1. Q
  1. ;
  1. DIV ;DIVISION match
  1. ;Supported by IAs #417 and #1378
  1. N PTFD0,PTMV,WL
  1. S DVMTCH=1,INST=""
  1. S PTFD0=D0,PTMV=$O(^DGPM("APTF",PTFD0,"")) I PTMV="" Q
  1. S WL=$P($G(^DGPM(PTMV,0)),U,6) I WL="" Q
  1. S MCDV=$P($G(^DIC(42,WL,0)),U,11) I MCDV="" Q
  1. S INST=$P($G(^DG(40.8,MCDV,0)),U,7) I INST="" Q
  1. I AFFDIV'[INST S DVMTCH=0 Q
  1. Q
  1. ;
  1. EX ;KILL variables
  1. K %DT,%T,%ZIS,ADT,AFFDIV,BY,CD,CI,D0,DA,DD,DIC,DIE,DIOEND,DIR,DO,DR
  1. K DVMTCH,ED,F,FLDS,FR,GLO,HT,IC,IC9,ICD,ICP,INST,IOP,L,MCDV,NM,O2,CI10,IC10,SBCIND
  1. K ONCDIVS,ONCDIVSP,ONCIEN,ONCO,ONCS,ONCSUB,OSP,P,POP,PTFD0,PTFDT,PTMV
  1. K SD,SDDEF,SDT,TO,WED,WSD,X,X1,X2,X70,X71,XD0,XD1,XDT,XDX,XED,Y,Z
  1. K ZTDESC,ZTRTN,ZTSAVE
  1. K ^TMP("ONCO",$J)
  1. D ^%ZISC
  1. Q