- ONCOCFP1 ;HINES OIFO/RVD - [PT Automatic Casefinding-PTF Search 1] ;09/10/15
- ;;2.2;ONCOLOGY;**7,10,13,14,17,18**;Jul 31, 2013;Build 5
- ;
- ; rvd - 0403/12 p56. Use ICD API (#3990) instead of direct global call
- L10 ;
- W !
- ;List of ICD10
- W !?3,"*** COMPREHENSIVE ICD-10-CM Casefinding Code List for Reportable Tumors ***"
- W !
- W !?3,"(C00._ to C43._),C4A._,(C45._ to C48._),C49._ to C96._)"
- W !?3," Malignant neoplasms (excluding category C44), stated or presumed"
- W !?3," to be primary (of specified site) and certain specified histologies"
- W !?3,"C44.00_, C44.09 Unspecified/other malignant neoplasm of skin of lip"
- W !?3,"C44.10_, C44.19_ Unspecified/other malignant neoplasm of skin of eyelid"
- W !?3,"C44.13_ Sebaceous cell carcinoma of skin of eyelid, including canthus"
- W !?3,"C44.20_, C44.29_ Unspecified/other malignant neoplasm skin of ear and"
- W !?3," external auricular canal"
- W !?3,"C44.30_, C44.39_ Unspecified/other malignant neoplasm of skin of"
- W !?3," other/unspecified parts of face"
- W !?3,"C44.40_, C44.49 Unspecified/other malignant neoplasm of skin of"
- W !?3," scalp & neck"
- W !?3,"C44.50_, C44.59_ Unspecified/other malignant neoplasm of skin of trunk"
- W !?3,"C44.60_, C44.69_ Unspecified/other malignant neoplasm of skin of upper"
- W !?3," limb, incl. shoulder"
- W !?3,"C44.70_, C44.79_ Unspecified/other malignant neoplasm of skin of lower "
- W !?3," limb, including hip"
- W !?3,"C44.80_, C44.89 Unspecified/other malignant neoplasm of skin of"
- W !?3," overlapping sites of skin"
- W !?3,"C44.90_, C44.99 Unspecified/other malignant neoplasm of skin of"
- W !?3," unspecified sites of skin"
- W !?3,"C49.A_ Gastrointestinal stromal tumors..."
- W !?3,"(D00._ to D05._), (D07._ to D09._) In-situ neoplasms (Note: Carcinoma in situ of the cervix"
- W !?3," (C/N III-8077/2) and Prostatic Intraepithelial Carcinoma"
- W !?3," (PIN III-8148/2) are not reportable)."
- W !?3,"D18.02 Hemangioma of intracranial structures and any site"
- W !?3,"D32._ Benign neoplasm of meninges (cerebral, spinal and unspecified)"
- W !?3,"D33._ Benign neoplasm of brain and other parts of central nervous"
- W !?3," system"
- W !?3,"(D35.2 to D35.4) Benign neoplasm of pituitary gland, craniopharyngeal"
- W !?3," duct and pineal gland"
- W !?3,"D42._, D43._ Neoplasm of uncertain or unknown behavior of meninges, brain,"
- W !?3," CNS"
- W !?3,"(D44.3 to D44.5) Neoplasm of uncertain or unknown behavior of pituitary"
- W !?3," gland, craniopharyngeal duct and pineal gland"
- W !?3,"D45 Polycythemia vera (9950/3)"
- W !?3,"D46._ Myelodysplastic syndromes (9980, 9982, 9983, 9985, 9986, 9989,"
- W !?3," 9991, 9992)"
- W !?3,"D47.02 Systemic mastocytosis"
- W !?3,"D47.1 Chronic myeloproliferative disease (9963/3)"
- W !?3,"D47.3 Essential (hemorrhagic) thrombocythemia (9962/3)"
- W !?3,"D47.4 Osteomyelofibrosis (9961/3)"
- W !?3," Includes: Chronic idiopathic myelofibrosis"
- W !?3," Myelofibrosis (idiopathic) (with myeloid metaplasia)"
- W !?3," Myesclerosis (megakaryocytic) with myeloid metaplasia)"
- W !?3," Secondary myelofibrosis in myeloproliferative disease)"
- W !?3,"D47.9 Neoplasms of uncertain behavior of lymphoid, hematopoitec"
- W !?3," and related tissue, unspecified (9970/1,9931/3)"
- W !?3,"D47.Z_ Neoplasm of uncertain behavior of lymphoid, hematopoietic"
- W !?3," and related tissue, unspecified (9960/3,9970/1,9971/3, 9931/3)"
- W !?3,"D49.6, D49.7 Neoplasm of unspecified behavior of brain, endocrine glands"
- W !?3," and other CNS"
- W !,?3,"D72.11_ Hypereosonophilic syndrome (HES] (9964/3)"
- W !,?3,"K31.A22 Gastric intestinal metaplasia with high grade dysplasia"
- W !,?3,"N85.02 Endometrial intaepithelial neoplasia (EIN)"
- W !?3,"R85.614 Cytologic evidence of malignacy on smear of anus"
- W !?3,"R87.614 Cytologic evidence of malignacy on smear of cervix"
- W !?3,"R86.624 Cytologic evidence of malignacy on smear of vagina"
- W !?3,"R90.0 Intracranial space-occupying lesion found on diagnostic imaging"
- W !?3," of central nervous system"
- w !
- ;
- ;I SBCIND="YES" D
- ;W !?3,"Basal/Squamous cell ICD-10-CM codes"
- W !
- Q
- ;
- IC10 ;Search for ICD10 codes
- I X71'="",CI10=0 F F=5:1:15 S ICP=+$P(X71,U,F) I ICP>0 S IC10=$$GET1^DIQ(80,ICP,.01,"I") D FD10 Q:CI10=1
- Q
- ;
- FD10 ;Check for valid ICD10 CM code for Oncology.
- ;I (SBCIND="YES"),($E(IC10)="C") S CI10=1 Q
- ;I (SBCIND="NO"),($E(IC10)="C") D Q
- I ((IC10="D44.0")!(IC10="D44.1")!(IC10="D44.10")!(IC10="D44.11")!(IC10="D44.12")) S CI10=0 Q
- I ((IC10="D44.2")!(IC10="D44.6")!(IC10="D44.7")!(IC10="D44.9")) S CI10=0 Q
- I ($E(IC10,1,4)="D44.")!($E(IC10,1,6)="D72.11") S CI10=1 Q
- I ($E(IC10,1,5)="D35.0")!(IC10="D35.1")!(IC10="D35.5")!(IC10="D35.9") S CI10=0 Q
- I ($E(IC10,1,2)="C0")!($E(IC10,1,4)="C43.")!($E(IC10,1,4)="C4A.")!($E(IC10,1,4)="C40.") S CI10=1 Q
- I ($E(IC10,1,4)="C45.")!($E(IC10,1,4)="C48.")!($E(IC10,1,4)="C49.")!($E(IC10,1,4)="C96.") S CI10=1 Q
- I ($E(IC10,1,4)="C46.")!($E(IC10,1,4)="C47.") S CI10=1 Q
- I ($E(IC10,1,4)="C41.")!($E(IC10,1,4)="C42.") S CI10=1 Q
- I ($E(IC10,1,6)="C44.13")!($E(IC10,1,4)="C46.") S CI10=1 Q
- I ($E(IC10,1,6)="C44.00")!($E(IC10,1,6)="C44.09") S CI10=1 Q
- I ($E(IC10,1,6)="C44.10")!($E(IC10,1,6)="C44.19") S CI10=1 Q
- I ($E(IC10,1,6)="C44.20")!($E(IC10,1,6)="C44.29") S CI10=1 Q
- I ($E(IC10,1,6)="C44.30")!($E(IC10,1,6)="C44.39") S CI10=1 Q
- I ($E(IC10,1,6)="C44.40")!($E(IC10,1,6)="C44.49") S CI10=1 Q
- I ($E(IC10,1,6)="C44.50")!($E(IC10,1,6)="C44.59") S CI10=1 Q
- I ($E(IC10,1,6)="C44.60")!($E(IC10,1,6)="C44.69") S CI10=1 Q
- I ($E(IC10,1,6)="C44.70")!($E(IC10,1,6)="C44.79") S CI10=1 Q
- I ($E(IC10,1,6)="C44.80")!($E(IC10,1,6)="C44.89") S CI10=1 Q
- I ($E(IC10,1,6)="C44.90")!($E(IC10,1,6)="C44.99") S CI10=1 Q
- I ($E(IC10,1,2)="C5")!($E(IC10,1,2)="C6") S CI10=1 Q
- I ($E(IC10,1,2)="C7")!($E(IC10,1,2)="C8") S CI10=1 Q
- I ($E(IC10,1,2)="C9")!($E(IC10,1,2)="C1") S CI10=1 Q
- I ($E(IC10,1,2)="C2")!($E(IC10,1,2)="C3") S CI10=1 Q
- I ($E(IC10,1,3)="C40")!($E(IC10,1,2)="C0") S CI10=1 Q
- I ($E(IC10,1,4)="D00.")!($E(IC10,1,4)="D01.") S CI10=1 Q
- I ($E(IC10,1,4)="D02.")!($E(IC10,1,4)="D03.") S CI10=1 Q
- I ($E(IC10,1,4)="D04.")!($E(IC10,1,4)="D05.") S CI10=1 Q
- I ($E(IC10,1,4)="D07.")!($E(IC10,1,6)="D72.11") S CI10=1 Q
- I ($E(IC10,1,4)="D09.")!($E(IC10,1,6)="D47.Z1") S CI10=1 Q
- I ($E(IC10,1,3)="D32")!($E(IC10,1,6)="D18.02") S CI10=1 Q
- I ($E(IC10,1,3)="D42")!($E(IC10,1,3)="D33") S CI10=1 Q
- I ($E(IC10,1,3)="D45")!($E(IC10,1,4)="D43.") S CI10=1 Q
- I ($E(IC10,1,5)="D47.Z")!($E(IC10,1,5)="D47.1") S CI10=1 Q
- I ($E(IC10,1,5)="D47.3")!($E(IC10,1,5)="D47.4") S CI10=1 Q
- ;I ((IC10="D18.02")!(IC10="D35.2")!(IC10="D35.3")!(IC10="D35.4")!(IC10="D45")) S CI10=1 Q
- I ($E(IC10,1,4)="D44.")!($E(IC10,1,4)="D72.11") S CI10=1 Q
- I ((IC10="D72.110")!(IC10="D72.111")!(IC10="D72.118")!(IC10="D72.119")) S CI10=1 Q
- I ((IC10="D47.Z")!(IC10="D47.Z1")!(IC10="D47.Z9")!(IC10="D44.3")!(IC10="D44.4")!(IC10="D44.5")) S CI10=1 Q
- I ((IC10="D47.1")!(IC10="D47.3")!(IC10="D47.4")!(IC10="D47.02")!(IC10="D47.9")!(IC10="D49.6")!(IC10="D49.7")) S CI10=1 Q
- I ((IC10="R85.614")!(IC10="R87.614")!(IC10="R87.624")!(IC10="K31.A22")!(IC10="R90.0")) S CI10=1 Q
- ;I ($E(IC10)="D"),(($E(IC10,2,7)>00)&($E(IC10,2,7)<09.9999)) S CI10=1 Q
- I ($E(IC10)="D"),(($E(IC10,2,7)>31.9999)&($E(IC10,2,7)<33.9999)) S CI10=1 Q
- I ($E(IC10)="D"),(($E(IC10,2,7)>35.2000)&($E(IC10,2,7)<35.4001)) S CI10=1 Q
- I ($E(IC10)="D"),(($E(IC10,2,7)>41.9999)&($E(IC10,2,7)<43.9999)) S CI10=1 Q
- I ($E(IC10)="D"),(($E(IC10,2,7)>45.9999)&($E(IC10,2,7)<46.9999)) S CI10=1 Q
- I $E(IC10,1,6)="N85.02" S CI10=1 Q ;Patch #18
- ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.1")!($E(IC10,1,5)="Z85.2")) S CI10=1 Q
- ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.3")!($E(IC10,1,5)="Z85.4")) S CI10=1 Q
- ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.5")!($E(IC10,1,5)="Z85.6")) S CI10=1 Q
- ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.7")!($E(IC10,1,5)="Z85.8")) S CI10=1 Q
- ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.9")!($E(IC10,1,5)="Z86.0")) S CI10=1 Q
- ;I ($E(IC10)="Z"),(($E(IC10,1,6)="Z86.00")!($E(IC10,1,6)="Z86.01")) S CI10=1 Q
- ;I ($E(IC10)="Z"),($E(IC10,1,6)="Z86.03") S CI10=1 Q
- Q
- ;
- EX ;KILL variables
- K %DT,%T,%ZIS,ADT,AFFDIV,BY,CD,CI,D0,DA,DD,DIC,DIE,DIOEND,DIR,DO,DR
- K DVMTCH,ED,F,FLDS,FR,GLO,HT,IC,IC9,ICD,ICP,INST,IOP,L,MCDV,NM,O2
- K ONCDIVS,ONCDIVSP,ONCIEN,ONCO,ONCS,ONCSUB,OSP,P,POP,PTFD0,PTFDT,PTMV
- K SD,SDDEF,SDT,TO,WED,WSD,X,X1,X2,X70,X71,XD0,XD1,XDT,XDX,XED,Y,Z
- K ZTDESC,ZTRTN,ZTSAVE
- K ^TMP("ONCO",$J)
- D ^%ZISC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCFP1 9165 printed Jan 18, 2025@03:25:43 Page 2
- ONCOCFP1 ;HINES OIFO/RVD - [PT Automatic Casefinding-PTF Search 1] ;09/10/15
- +1 ;;2.2;ONCOLOGY;**7,10,13,14,17,18**;Jul 31, 2013;Build 5
- +2 ;
- +3 ; rvd - 0403/12 p56. Use ICD API (#3990) instead of direct global call
- L10 ;
- +1 WRITE !
- +2 ;List of ICD10
- +3 WRITE !?3,"*** COMPREHENSIVE ICD-10-CM Casefinding Code List for Reportable Tumors ***"
- +4 WRITE !
- +5 WRITE !?3,"(C00._ to C43._),C4A._,(C45._ to C48._),C49._ to C96._)"
- +6 WRITE !?3," Malignant neoplasms (excluding category C44), stated or presumed"
- +7 WRITE !?3," to be primary (of specified site) and certain specified histologies"
- +8 WRITE !?3,"C44.00_, C44.09 Unspecified/other malignant neoplasm of skin of lip"
- +9 WRITE !?3,"C44.10_, C44.19_ Unspecified/other malignant neoplasm of skin of eyelid"
- +10 WRITE !?3,"C44.13_ Sebaceous cell carcinoma of skin of eyelid, including canthus"
- +11 WRITE !?3,"C44.20_, C44.29_ Unspecified/other malignant neoplasm skin of ear and"
- +12 WRITE !?3," external auricular canal"
- +13 WRITE !?3,"C44.30_, C44.39_ Unspecified/other malignant neoplasm of skin of"
- +14 WRITE !?3," other/unspecified parts of face"
- +15 WRITE !?3,"C44.40_, C44.49 Unspecified/other malignant neoplasm of skin of"
- +16 WRITE !?3," scalp & neck"
- +17 WRITE !?3,"C44.50_, C44.59_ Unspecified/other malignant neoplasm of skin of trunk"
- +18 WRITE !?3,"C44.60_, C44.69_ Unspecified/other malignant neoplasm of skin of upper"
- +19 WRITE !?3," limb, incl. shoulder"
- +20 WRITE !?3,"C44.70_, C44.79_ Unspecified/other malignant neoplasm of skin of lower "
- +21 WRITE !?3," limb, including hip"
- +22 WRITE !?3,"C44.80_, C44.89 Unspecified/other malignant neoplasm of skin of"
- +23 WRITE !?3," overlapping sites of skin"
- +24 WRITE !?3,"C44.90_, C44.99 Unspecified/other malignant neoplasm of skin of"
- +25 WRITE !?3," unspecified sites of skin"
- +26 WRITE !?3,"C49.A_ Gastrointestinal stromal tumors..."
- +27 WRITE !?3,"(D00._ to D05._), (D07._ to D09._) In-situ neoplasms (Note: Carcinoma in situ of the cervix"
- +28 WRITE !?3," (C/N III-8077/2) and Prostatic Intraepithelial Carcinoma"
- +29 WRITE !?3," (PIN III-8148/2) are not reportable)."
- +30 WRITE !?3,"D18.02 Hemangioma of intracranial structures and any site"
- +31 WRITE !?3,"D32._ Benign neoplasm of meninges (cerebral, spinal and unspecified)"
- +32 WRITE !?3,"D33._ Benign neoplasm of brain and other parts of central nervous"
- +33 WRITE !?3," system"
- +34 WRITE !?3,"(D35.2 to D35.4) Benign neoplasm of pituitary gland, craniopharyngeal"
- +35 WRITE !?3," duct and pineal gland"
- +36 WRITE !?3,"D42._, D43._ Neoplasm of uncertain or unknown behavior of meninges, brain,"
- +37 WRITE !?3," CNS"
- +38 WRITE !?3,"(D44.3 to D44.5) Neoplasm of uncertain or unknown behavior of pituitary"
- +39 WRITE !?3," gland, craniopharyngeal duct and pineal gland"
- +40 WRITE !?3,"D45 Polycythemia vera (9950/3)"
- +41 WRITE !?3,"D46._ Myelodysplastic syndromes (9980, 9982, 9983, 9985, 9986, 9989,"
- +42 WRITE !?3," 9991, 9992)"
- +43 WRITE !?3,"D47.02 Systemic mastocytosis"
- +44 WRITE !?3,"D47.1 Chronic myeloproliferative disease (9963/3)"
- +45 WRITE !?3,"D47.3 Essential (hemorrhagic) thrombocythemia (9962/3)"
- +46 WRITE !?3,"D47.4 Osteomyelofibrosis (9961/3)"
- +47 WRITE !?3," Includes: Chronic idiopathic myelofibrosis"
- +48 WRITE !?3," Myelofibrosis (idiopathic) (with myeloid metaplasia)"
- +49 WRITE !?3," Myesclerosis (megakaryocytic) with myeloid metaplasia)"
- +50 WRITE !?3," Secondary myelofibrosis in myeloproliferative disease)"
- +51 WRITE !?3,"D47.9 Neoplasms of uncertain behavior of lymphoid, hematopoitec"
- +52 WRITE !?3," and related tissue, unspecified (9970/1,9931/3)"
- +53 WRITE !?3,"D47.Z_ Neoplasm of uncertain behavior of lymphoid, hematopoietic"
- +54 WRITE !?3," and related tissue, unspecified (9960/3,9970/1,9971/3, 9931/3)"
- +55 WRITE !?3,"D49.6, D49.7 Neoplasm of unspecified behavior of brain, endocrine glands"
- +56 WRITE !?3," and other CNS"
- +57 WRITE !,?3,"D72.11_ Hypereosonophilic syndrome (HES] (9964/3)"
- +58 WRITE !,?3,"K31.A22 Gastric intestinal metaplasia with high grade dysplasia"
- +59 WRITE !,?3,"N85.02 Endometrial intaepithelial neoplasia (EIN)"
- +60 WRITE !?3,"R85.614 Cytologic evidence of malignacy on smear of anus"
- +61 WRITE !?3,"R87.614 Cytologic evidence of malignacy on smear of cervix"
- +62 WRITE !?3,"R86.624 Cytologic evidence of malignacy on smear of vagina"
- +63 WRITE !?3,"R90.0 Intracranial space-occupying lesion found on diagnostic imaging"
- +64 WRITE !?3," of central nervous system"
- +65 WRITE !
- +66 ;
- +67 ;I SBCIND="YES" D
- +68 ;W !?3,"Basal/Squamous cell ICD-10-CM codes"
- +69 WRITE !
- +70 QUIT
- +71 ;
- IC10 ;Search for ICD10 codes
- +1 IF X71'=""
- IF CI10=0
- FOR F=5:1:15
- SET ICP=+$PIECE(X71,U,F)
- IF ICP>0
- SET IC10=$$GET1^DIQ(80,ICP,.01,"I")
- DO FD10
- if CI10=1
- QUIT
- +2 QUIT
- +3 ;
- FD10 ;Check for valid ICD10 CM code for Oncology.
- +1 ;I (SBCIND="YES"),($E(IC10)="C") S CI10=1 Q
- +2 ;I (SBCIND="NO"),($E(IC10)="C") D Q
- +3 IF ((IC10="D44.0")!(IC10="D44.1")!(IC10="D44.10")!(IC10="D44.11")!(IC10="D44.12"))
- SET CI10=0
- QUIT
- +4 IF ((IC10="D44.2")!(IC10="D44.6")!(IC10="D44.7")!(IC10="D44.9"))
- SET CI10=0
- QUIT
- +5 IF ($EXTRACT(IC10,1,4)="D44.")!($EXTRACT(IC10,1,6)="D72.11")
- SET CI10=1
- QUIT
- +6 IF ($EXTRACT(IC10,1,5)="D35.0")!(IC10="D35.1")!(IC10="D35.5")!(IC10="D35.9")
- SET CI10=0
- QUIT
- +7 IF ($EXTRACT(IC10,1,2)="C0")!($EXTRACT(IC10,1,4)="C43.")!($EXTRACT(IC10,1,4)="C4A.")!($EXTRACT(IC10,1,4)="C40.")
- SET CI10=1
- QUIT
- +8 IF ($EXTRACT(IC10,1,4)="C45.")!($EXTRACT(IC10,1,4)="C48.")!($EXTRACT(IC10,1,4)="C49.")!($EXTRACT(IC10,1,4)="C96.")
- SET CI10=1
- QUIT
- +9 IF ($EXTRACT(IC10,1,4)="C46.")!($EXTRACT(IC10,1,4)="C47.")
- SET CI10=1
- QUIT
- +10 IF ($EXTRACT(IC10,1,4)="C41.")!($EXTRACT(IC10,1,4)="C42.")
- SET CI10=1
- QUIT
- +11 IF ($EXTRACT(IC10,1,6)="C44.13")!($EXTRACT(IC10,1,4)="C46.")
- SET CI10=1
- QUIT
- +12 IF ($EXTRACT(IC10,1,6)="C44.00")!($EXTRACT(IC10,1,6)="C44.09")
- SET CI10=1
- QUIT
- +13 IF ($EXTRACT(IC10,1,6)="C44.10")!($EXTRACT(IC10,1,6)="C44.19")
- SET CI10=1
- QUIT
- +14 IF ($EXTRACT(IC10,1,6)="C44.20")!($EXTRACT(IC10,1,6)="C44.29")
- SET CI10=1
- QUIT
- +15 IF ($EXTRACT(IC10,1,6)="C44.30")!($EXTRACT(IC10,1,6)="C44.39")
- SET CI10=1
- QUIT
- +16 IF ($EXTRACT(IC10,1,6)="C44.40")!($EXTRACT(IC10,1,6)="C44.49")
- SET CI10=1
- QUIT
- +17 IF ($EXTRACT(IC10,1,6)="C44.50")!($EXTRACT(IC10,1,6)="C44.59")
- SET CI10=1
- QUIT
- +18 IF ($EXTRACT(IC10,1,6)="C44.60")!($EXTRACT(IC10,1,6)="C44.69")
- SET CI10=1
- QUIT
- +19 IF ($EXTRACT(IC10,1,6)="C44.70")!($EXTRACT(IC10,1,6)="C44.79")
- SET CI10=1
- QUIT
- +20 IF ($EXTRACT(IC10,1,6)="C44.80")!($EXTRACT(IC10,1,6)="C44.89")
- SET CI10=1
- QUIT
- +21 IF ($EXTRACT(IC10,1,6)="C44.90")!($EXTRACT(IC10,1,6)="C44.99")
- SET CI10=1
- QUIT
- +22 IF ($EXTRACT(IC10,1,2)="C5")!($EXTRACT(IC10,1,2)="C6")
- SET CI10=1
- QUIT
- +23 IF ($EXTRACT(IC10,1,2)="C7")!($EXTRACT(IC10,1,2)="C8")
- SET CI10=1
- QUIT
- +24 IF ($EXTRACT(IC10,1,2)="C9")!($EXTRACT(IC10,1,2)="C1")
- SET CI10=1
- QUIT
- +25 IF ($EXTRACT(IC10,1,2)="C2")!($EXTRACT(IC10,1,2)="C3")
- SET CI10=1
- QUIT
- +26 IF ($EXTRACT(IC10,1,3)="C40")!($EXTRACT(IC10,1,2)="C0")
- SET CI10=1
- QUIT
- +27 IF ($EXTRACT(IC10,1,4)="D00.")!($EXTRACT(IC10,1,4)="D01.")
- SET CI10=1
- QUIT
- +28 IF ($EXTRACT(IC10,1,4)="D02.")!($EXTRACT(IC10,1,4)="D03.")
- SET CI10=1
- QUIT
- +29 IF ($EXTRACT(IC10,1,4)="D04.")!($EXTRACT(IC10,1,4)="D05.")
- SET CI10=1
- QUIT
- +30 IF ($EXTRACT(IC10,1,4)="D07.")!($EXTRACT(IC10,1,6)="D72.11")
- SET CI10=1
- QUIT
- +31 IF ($EXTRACT(IC10,1,4)="D09.")!($EXTRACT(IC10,1,6)="D47.Z1")
- SET CI10=1
- QUIT
- +32 IF ($EXTRACT(IC10,1,3)="D32")!($EXTRACT(IC10,1,6)="D18.02")
- SET CI10=1
- QUIT
- +33 IF ($EXTRACT(IC10,1,3)="D42")!($EXTRACT(IC10,1,3)="D33")
- SET CI10=1
- QUIT
- +34 IF ($EXTRACT(IC10,1,3)="D45")!($EXTRACT(IC10,1,4)="D43.")
- SET CI10=1
- QUIT
- +35 IF ($EXTRACT(IC10,1,5)="D47.Z")!($EXTRACT(IC10,1,5)="D47.1")
- SET CI10=1
- QUIT
- +36 IF ($EXTRACT(IC10,1,5)="D47.3")!($EXTRACT(IC10,1,5)="D47.4")
- SET CI10=1
- QUIT
- +37 ;I ((IC10="D18.02")!(IC10="D35.2")!(IC10="D35.3")!(IC10="D35.4")!(IC10="D45")) S CI10=1 Q
- +38 IF ($EXTRACT(IC10,1,4)="D44.")!($EXTRACT(IC10,1,4)="D72.11")
- SET CI10=1
- QUIT
- +39 IF ((IC10="D72.110")!(IC10="D72.111")!(IC10="D72.118")!(IC10="D72.119"))
- SET CI10=1
- QUIT
- +40 IF ((IC10="D47.Z")!(IC10="D47.Z1")!(IC10="D47.Z9")!(IC10="D44.3")!(IC10="D44.4")!(IC10="D44.5"))
- SET CI10=1
- QUIT
- +41 IF ((IC10="D47.1")!(IC10="D47.3")!(IC10="D47.4")!(IC10="D47.02")!(IC10="D47.9")!(IC10="D49.6")!(IC10="D49.7"))
- SET CI10=1
- QUIT
- +42 IF ((IC10="R85.614")!(IC10="R87.614")!(IC10="R87.624")!(IC10="K31.A22")!(IC10="R90.0"))
- SET CI10=1
- QUIT
- +43 ;I ($E(IC10)="D"),(($E(IC10,2,7)>00)&($E(IC10,2,7)<09.9999)) S CI10=1 Q
- +44 IF ($EXTRACT(IC10)="D")
- IF (($EXTRACT(IC10,2,7)>31.9999)&($EXTRACT(IC10,2,7)<33.9999))
- SET CI10=1
- QUIT
- +45 IF ($EXTRACT(IC10)="D")
- IF (($EXTRACT(IC10,2,7)>35.2000)&($EXTRACT(IC10,2,7)<35.4001))
- SET CI10=1
- QUIT
- +46 IF ($EXTRACT(IC10)="D")
- IF (($EXTRACT(IC10,2,7)>41.9999)&($EXTRACT(IC10,2,7)<43.9999))
- SET CI10=1
- QUIT
- +47 IF ($EXTRACT(IC10)="D")
- IF (($EXTRACT(IC10,2,7)>45.9999)&($EXTRACT(IC10,2,7)<46.9999))
- SET CI10=1
- QUIT
- +48 ;Patch #18
- IF $EXTRACT(IC10,1,6)="N85.02"
- SET CI10=1
- QUIT
- +49 ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.1")!($E(IC10,1,5)="Z85.2")) S CI10=1 Q
- +50 ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.3")!($E(IC10,1,5)="Z85.4")) S CI10=1 Q
- +51 ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.5")!($E(IC10,1,5)="Z85.6")) S CI10=1 Q
- +52 ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.7")!($E(IC10,1,5)="Z85.8")) S CI10=1 Q
- +53 ;I ($E(IC10)="Z"),(($E(IC10,1,5)="Z85.9")!($E(IC10,1,5)="Z86.0")) S CI10=1 Q
- +54 ;I ($E(IC10)="Z"),(($E(IC10,1,6)="Z86.00")!($E(IC10,1,6)="Z86.01")) S CI10=1 Q
- +55 ;I ($E(IC10)="Z"),($E(IC10,1,6)="Z86.03") S CI10=1 Q
- +56 QUIT
- +57 ;
- EX ;KILL variables
- +1 KILL %DT,%T,%ZIS,ADT,AFFDIV,BY,CD,CI,D0,DA,DD,DIC,DIE,DIOEND,DIR,DO,DR
- +2 KILL DVMTCH,ED,F,FLDS,FR,GLO,HT,IC,IC9,ICD,ICP,INST,IOP,L,MCDV,NM,O2
- +3 KILL ONCDIVS,ONCDIVSP,ONCIEN,ONCO,ONCS,ONCSUB,OSP,P,POP,PTFD0,PTFDT,PTMV
- +4 KILL SD,SDDEF,SDT,TO,WED,WSD,X,X1,X2,X70,X71,XD0,XD1,XDT,XDX,XED,Y,Z
- +5 KILL ZTDESC,ZTRTN,ZTSAVE
- +6 KILL ^TMP("ONCO",$JOB)
- +7 DO ^%ZISC
- +8 QUIT