source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCOCFP.m@ 1456

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