- ONCACD0 ;HINES OIFO/GWB - NAACCR extract driver ;09/22/11
- ;;2.2;ONCOLOGY;**1,4,5,8,6,10,12,13,14,15,17,19,20**;Jul 31, 2013;Build 5
- ;P6 V16
- ;P10 V18
- ;P13 V21, P20 V23
- ;P14 XML format for State and RCRS
- ;P17 V22
- ;P19 CC option is for State extract only
- EN1(DEVICE,STEXT) ;Entry point
- EN2 N ACO,BDT,DATE,DIAGYR,EDT,EXTRACT,NCDB,ONCSPIEN,QUEUE,SDT,STAT,STAT1,STAT2,YESNO,DATE1,ONCDATE,ONCDT,ONCLDT
- N ACCN,ONCDT11,ONCDATE1,SCREEN,CYR,ONC91AS,PTR,CLASSOFCASE,ONCPHI,ONCCLCA,ONCR12,ONCRCL
- K ^TMP($J),RQRS
- S DEVICE=$G(DEVICE,0),STEXT=$G(STEXT,0),EXT=""
- S (EDT,EXTRACT,DATE,OUT,QUEUE,SDT,STAT,ONCDT)=0
- ;P2.2*4
- W !
- W !,"Protected Health Information data items are excluded from RCRS and NCDB reports, and Statute 38 USC 7332 codes are excluded from state, RCRS and NCDB reports.",!
- S ONCPHI=1
- ;S DIR("A")=" Exclude PHI COMORBIDITY codes: "
- ;S DIR("B")="YES",DIR(0)="Y"
- ;S DIR("?")=" "
- ;S DIR("?",1)=" Answer 'YES' if you want to exclude PHI COMORBIDITY codes."
- ;S DIR("?",2)=" Answer 'NO' if you want to include PHI COMORBIDITY codes."
- ;D ^DIR
- ;I $D(DIRUT) S OUT=1 K DIRUT Q
- ;S ONCPHI=Y
- ;
- I (STEXT=0)!(STEXT=2)!(STEXT=3) S EXTRACT=$O(^ONCO(160.16,"B","NCDB EXTRACT V23.0",0))
- I (STEXT=1)&(DEVICE=1) D GETREC(.EXTRACT,.OUT) ;p19
- I (STEXT=1)&(DEVICE=0) S ONCRCL=4,EXTRACT=5 W !,"The current record layout (v23.0) is for all states (including SEER states)."
- I 'OUT S STAT=$$GETHOSP
- I 'STAT S OUT=1
- I 'OUT S STAT1=$P(STAT,U,1),STAT2=$P(STAT,U,2)
- I 'OUT D GETDATE(.DATE,.DATE1,.OUT)
- I 'OUT,STEXT=1 D GETDT(.SDT,.EDT,DATE,.OUT)
- I 'OUT,STEXT=3 D RQRS(.SDT,.EDT,DATE,.OUT) S RQRS=1
- I 'OUT D VERIFY(STAT,DATE,SDT,EDT,STEXT,.YESNO,.OUT)
- I 'OUT G:'YESNO EN2
- I 'OUT D DEVICE(DEVICE,.OUT)
- I 'OUT D:'QUEUE PRINT(DEVICE,.OUT)
- D EXIT
- Q
- ;
- GETREC(EXTRACT,OUT) ;Select VACCR, STATE record layout
- W !!," Available record layouts:",!
- W !," 1) VACCR Record Layout v23.0 (VA Registry)"
- W !," 2) State Record Layout v23.0"
- W !
- N DIR,X,Y
- S DIR(0)="SAO^1:VACCR Record Layout v23.0;2:State Record Layout v23.0"
- S DIR("A")=" Select record layout: "
- S DIR("?")="Select the record layout to use"
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- I +Y<1 S OUT=1 Q
- I Y=1 S EXT="VACCR",EXTRACT=$O(^ONCO(160.16,"B","VACCR EXTRACT V23.0",0))
- I Y=2 S EXT="STATE",EXTRACT=$O(^ONCO(160.16,"B","STATE EXTRACT V23.0",0))
- S ONCRCL=Y
- I ONCRCL=1 D
- .S DIR("A")=" Exclude PHI COMORBIDITY codes: "
- .S DIR("B")="YES",DIR(0)="Y"
- .S DIR("?")=" "
- .S DIR("?",1)=" Answer 'YES' if you want to exclude PHI COMORBIDITY codes."
- .S DIR("?",2)=" Answer 'NO' if you want to include PHI COMORBIDITY codes."
- .D ^DIR
- .I $D(DIRUT) S OUT=1 K DIRUT Q
- .S ONCPHI=Y
- Q
- ;
- GETHOSP() ;Facility Identification Number (FIN)
- N STAT,STATI,ALLOK
- S STAT=0,ALLOK=$$GETDXH(.STAT)
- I STAT S STATI=6_STAT_0,STAT=STAT_"^"_STATI
- Q STAT
- ;
- GETDXH(DXH) ;INSTITUTION ID NUMBER (160.1,27)
- N OKHERE,DIE,DA,DR,ONCOL
- W !
- S DIE=160.1
- S DA=$O(^ONCO(160.1,"C",DUZ(2),0))
- I DA="" S DA=$O(^ONCO(160.1,0))
- S ONCSPIEN=DA
- S DR=27_$J("",1)_"Facility Identification Number (FIN)"
- S ONCOL=0
- L +^ONCO(160.1,DA):0 I $T D ^DIE L -^ONCO(160.1,DA) S ONCOL=1
- I 'ONCOL W !,"This ONCOLOGY SITE PARAMETERS record is being edited by another user."
- K ONCOL,DIE
- I $D(Y)=0 S DXH=$$GET1^DIQ(160.19,X,.01,"I")
- I X'="" S ACDSTATE=$P($G(^ONCO(160.19,X,0)),U,4)
- S OKHERE=($D(Y)=0)
- Q OKHERE
- ;
- RQRS(SDT,EDT,DATE,OUT) ;Process RCRS data
- ;
- W !!!,"RCRS report will be run on ALL analytic cases.",!
- S ONCR12=2
- ;K DIR
- ;S DIR(0)="SAO^1:COLON, RECTUM and BREAST only;2:All Analytic Cases only"
- ;S DIR("A")=" Select cases for inclusion: "
- ;S DIR("?")="Select cases or primaries for RQRS download"
- ;D ^DIR
- ;I $D(DIRUT) S OUT=1 K DIRUT Q
- ;I Y<1 S OUT=1 Q
- ;S ONCR12=Y
- W !
- ;
- K DIR
- S DIR(0)="SAO^1:Date DX;2:Date Case Last Changed;3:Accession Number"
- S DIR("A")=" Select date field to be used for Start/End range: "
- S DIR("?")="Select the date field you wish to use for this download's Start/End range prompts."
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- I Y<1 S OUT=1 Q
- S (NCDB,ONCLDT)=Y
- K DIR
- S ONCDT11=2880101
- I $G(ONCLDT)=3 D ACCN Q
- ;S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
- S DIR(0)="DO^3060101:"_DT_":EP"
- ;S DIR("B")=$E(ONCDT11,4,5)_"/"_$E(ONCDT11,6,7)_"/"_$E(ONCDT11,2,3)
- I $G(ONCLDT)=1 D
- .S DIR("A")=" Start, Date DX: "
- .S DIR("?",1)=" Enter the DATE of Diagnosis of the"
- .S DIR("?",2)=" FIRST abstract you would like to report."
- I $G(ONCLDT)=2 D
- .S DIR("A")=" Start, Date Case Last Changed: "
- .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- .S DIR("?",2)=" FIRST abstract you would like to report."
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S SDT=Y
- I $E(SDT,4,7)="0000" S SDT=$E(SDT,1,3)_"0101"
- K DIR
- S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(X<SDT) X"
- S DIR(0)="DO^"_SDT_":"_DT_":EP"
- S DIR("?")=" End Date must be greater than the Start Date."
- I $G(ONCLDT)=1 D
- .S DIR("A")=" End, Date DX: "
- .S DIR("?",1)=" Enter the DATE of Diagnosis of the"
- .S DIR("?",2)=" LAST abstract you would like to report."
- I $G(ONCLDT)=2 D
- .S DIR("A")=" End, Date Case Last Changed: "
- .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- .S DIR("?",2)=" LAST abstract you would like to report."
- S DIR("B")="TODAY"
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S EDT=Y I $E(EDT,4,7)="0000" S EDT=$E(EDT,1,3)_1231
- ;
- Q
- ;
- GETDT(SDT,EDT,DATE,OUT) ; Select a date range
- K DIR
- S DIR(0)="SAO^1:Date Case Completed;2:Date Case Last Changed;3:Accession Number"
- S DIR("A")=" Select date field to be used for Start/End range: "
- S DIR("?")="Select the date field you wish to use for this download's Start/End range prompts."
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- I Y<1 S OUT=1 Q
- S ONCLDT=Y
- S ONCDT11=3000101
- DCLC K DIR
- I $G(ONCLDT)=3 D ACCN Q:OUT=1 G ACJ
- S CYR=DT,SCREEN="K:(X>CYR)!(X<ONCDT11) X"
- S DIR(0)="DO^"_ONCDT11_":"_DT_":EP"
- ;S DIR("B")=$E(ONCDT11,4,5)_"/"_$E(ONCDT11,6,7)_"/"_$E(ONCDT11,2,3)
- I $G(ONCLDT)=1 D
- .S DIR("A")=" Start, Date Case Completed: "
- .S DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
- .S DIR("?",2)=" FIRST abstract you would like to report."
- I ($G(ONCLDT)=2)!($G(NCDB)=2) D
- .S DIR("A")=" Start, Date Case Last Changed: "
- .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- .S DIR("?",2)=" FIRST abstract you would like to report."
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S (SDT,BDT)=Y
- K DIR
- S CYR=DT,SCREEN="K:(X>CYR)!(X<SDT) X"
- S DIR(0)="DO^"_SDT_":"_DT_":EP"
- S DIR("B")="TODAY"
- S DIR("?")=" End Date must be greater than the Start Date."
- I $G(ONCLDT)=1 D
- .S DIR("A")=" End, Date Case Completed: "
- .I EXT="VACCR",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,8)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,61)
- .I EXT="STATE",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,9)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,62)
- .S DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
- .S DIR("?",2)=" LAST abstract you would like to report."
- I ($G(ONCLDT)=2)!($G(NCDB)=2) D
- .S DIR("A")=" End, Date Case Last Changed: "
- .I EXT="VACCR",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,10)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,63)
- .I EXT="STATE",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,11)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,64)
- .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- .S DIR("?",2)=" LAST abstract you would like to report."
- ;S:$G(ONCED89) DIR("B")=$E(ONCED89,4,5)_"/"_$E(ONCED89,6,7)_"/"_$E(ONCED89,2,3)
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S EDT=Y I $P(EDT,".",2)="" S EDT=EDT_.2500
- ACJ I EXT="" Q
- I $G(NCDB)=2 Q
- I EXT="VACCR" Q
- K DIR
- S DIR("A")=" Analytic cases only"
- S DIR("B")="YES"
- S DIR(0)="Y"
- S DIR("?")=" "
- S DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 0-2) extracted."
- S DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) extracted."
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- S ACO=Y
- Q
- ;
- DATEDX(SDT,EDT,DATE,OUT) ;Select DATE DX range
- K DIR
- S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
- ;S DIR(0)="DO^3000101:"_DT_":EP"
- ;S DIR(0)="D^::X"
- S DIR("A")=" Start, Date Dx: "
- S DIR("?",1)=" Enter the DATE DX of the FIRST"
- S DIR("?",2)=" abstract you would like to report."
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S (SDT,BDT)=Y
- K DIR
- S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(X<SDT) X"
- S DIR(0)="DO^"_SDT_":"_DT_":EP"
- ;S DIR(0)="D^::X"
- S DIR("A")=" End, Date Dx:"
- S DIR("?",1)=" Enter the DATE DX of the LAST abstract you would"
- S DIR("?",2)=" like to report and must be greater than Start, Date Dx."
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S EDT=Y
- Q
- ;
- PRINT(DEVICE,OUT) ;Capture output data
- I 'DEVICE D Q:OUT
- .N X
- .W !!
- .W !,?6,"--------------------------------------------------------------"
- .W !,?6,"|Please activate your PC capture program. The data will be |"
- .W !,?6,"|sent in 2 minutes or when you press the return key. |"
- .W !,?6,"--------------------------------------------------------------"
- .W !!!
- .R X:120
- .I X="^" S OUT=1
- U IO D EN1^ONCACD1
- Q
- ;
- EXIT ;Exit
- K ACDSTATE,DIC,EXT,OUT,X,Y
- I '$D(^TMP($J)) W !?3,"No records extracted." G EX
- W !
- S DIC="^ONCO(165.5,",L=0,FLDS="[ONC EXTRACT REPORT]",BY(0)="^TMP($J,",L(0)=1
- S:DEVICE IOP=ION
- I STEXT=0 S DHD=$P(^ONCO(160.16,EXTRACT,0),U,1) W !
- I (STEXT=1)!(STEXT=2) S DHD=$P(^ONCO(160.16,EXTRACT,0),U,1)_" "_$$FMTE^XLFDT(BDT,"2D")_" - "_$$FMTE^XLFDT(EDT,"2D")
- D EN1^DIP
- I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR Q:'Y
- ;
- EX K ^TMP($J)
- K %ZIS
- D ^%ZISC
- K ACDANS,BY,CCEX,DHD,EXT,FLDS,FR,IOP,L,POP,STEXT,TO
- Q
- ;
- DEVICE(DEVICE,OUT) ;Select output device
- Q:'DEVICE
- S %ZIS="Q"
- D ^%ZIS
- I POP S OUT=1 Q
- I $D(IO("Q")) D
- .S ZTRTN="PRINT^ONCACD0(DEVICE,.OUT)"
- .S ZTDESC=$S('STEXT:"ONC NCDB Extract",STEXT:"ONC State Extract",1:"")
- .S ZTSAVE("STAT1")=""
- .S ZTSAVE("DATE")=""
- .S ZTSAVE("DATE1")=""
- .S ZTSAVE("ONCDT")=""
- .S ZTSAVE("ONCLDT")=""
- .S ZTSAVE("STEXT")=""
- .S ZTSAVE("DEVICE")=""
- .S ZTSAVE("OUT")=""
- .S ZTSAVE("BDT")=""
- .S ZTSAVE("SDT")=""
- .S ZTSAVE("EDT")=""
- .S ZTSAVE("EXT")=""
- .S ZTSAVE("EXTRACT")=""
- .S ZTSAVE("NCDB")=""
- .D ^%ZTLOAD
- .I $D(ZTSK)[0 S OUT=1 W !!,?20,"Report Canceled!"
- .E W !!,?20,"Report Queued!" S QUEUE=1
- .D HOME^%ZIS
- K ZTDESC,ZTRTN,ZTSAVE,ZTSK
- Q
- ;
- VERIFY(STAT,DATE,SDT,EDT,STEXT,YESNO,OUT) ;Verify settings
- N DIR,Y,RL
- S RL=$P(^ONCO(160.16,EXTRACT,0),U,1)
- I STEXT=3 S RL="RCRS EXTRACT"
- W !!," These are your current settings:"
- W !
- W !," Record layout.......................: ",RL
- W !," Facility Identification Number (FIN): ",STAT1
- I EXT="STATE" D
- .W !," State to be extracted...............: ",ACDSTATE
- I STEXT=0 D
- .W !," Diagnosis Year......................: ",DIAGYR
- .W !," Selection criterion.................: ",$S(NCDB=1:"All cases",NCDB=2:"Date Case Last Changed date range",NCDB=3:"Accession Number",1:"")
- I STEXT=3 D
- .W !," Selection criterion.................: ",$S(NCDB=1:"Date DX",NCDB=2:"Date Case Last Changed date range",NCDB=3:"Accession Number",1:"")
- I (STEXT=1)!(STEXT=2)!(STEXT=3),(($G(NCDB)'=3)&($G(ONCLDT)'=3)) D
- .W !," Start date..........................: ",$$FMTE^XLFDT(SDT,"2D")
- .W !," End date............................: ",$$FMTE^XLFDT(EDT,"2D")
- I ($G(ONCLDT)=3)!($G(NCDB)=3) D
- .W !," Accession Number Start..........: ",SDT
- .W !," Accession Number End............: ",EDT
- I EXT="STATE" D
- .W !," Analytic cases only.................: ",$S(ACO=1:"YES",1:"NO")
- W !
- S DIR("A")=" Are these settings correct"
- S DIR("B")="YES"
- S DIR(0)="Y"
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- S YESNO=Y
- I STEXT=1,EXT="VACCR" S $P(^ONCO(160.1,ONCSPIEN,0),U,8)=EDT
- I STEXT=1,EXT="STATE" S $P(^ONCO(160.1,ONCSPIEN,0),U,9)=EDT
- I STEXT=2,EXT="VACCR" S $P(^ONCO(160.1,ONCSPIEN,0),U,10)=EDT
- I STEXT=2,EXT="STATE" S $P(^ONCO(160.1,ONCSPIEN,0),U,11)=EDT
- Q
- ;
- GETDATE(ONCDT,DATE1,OUT) ;Select Diagnosis Year
- Q:STEXT>0
- N CYR,DIR,SCREEN,Y
- S ONCDT=0
- S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
- S DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN
- S DIR("A")=" Diagnosis Year Start: "
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- ;S (ONCDT,DIAGYR)=Y
- S (ONCDATE,ONCDT)=Y
- S ONCDT=ONCDT-1700
- S ONCDT11=ONCDT_"0101"
- S ONCDT=ONCDT_"0000"
- S (ONCDT,ONCLDT)=ONCDT-1
- ;Diagnosis Year End
- K DIR
- S DATE1=ONCDATE
- S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(X<ONCDATE) X"
- S DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN
- S DIR("A")=" Diagnosis Year End: "
- S DIR("?")=" Diagnosis Year End must be a number and greater than the Start year."
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- S (ONCDATE1,DATE1)=Y
- S DIAGYR=ONCDATE_"-"_Y
- S DATE1=DATE1+1
- S DATE1=DATE1-1700
- S DATE1=DATE1_"0000"
- S DATE1=DATE1-1
- K DIR
- W !," Diagnosis Years: ",DIAGYR
- W !
- W !,?6,"Select one of the following:"
- W !
- W !,?11,"1 All eligible cases for this year"
- W !,?11,"2 Cases within a 'Date Case Last Changed' date range"
- W !,?11,"3 Accession Number"
- W !
- S DIR(0)="SAO^1:All cases;2:Cases within a date range;3:Accession Number"
- S DIR("A")=" Select extraction criterion: "
- S DIR("B")="All cases"
- S DIR("?")=" "
- S DIR("?",1)=" Select 'All cases' if you want to extract all"
- S DIR("?",2)=" of the eligible cases for this Diagnosis Year."
- S DIR("?",3)=""
- S DIR("?",4)=" Select 'Cases within a date range' if you want"
- S DIR("?",5)=" to specify a 'Date Case Last Changed' date range"
- S DIR("?",6)=" for this Diagnosis Year."
- S DIR("?",7)=" "
- S DIR("?",8)="Select 'Accession Number-Seq' if you want to specify"
- S DIR("?",9)="the extract by Accession Number range."
- D ^DIR
- I $D(DIRUT) S OUT=1 K DIRUT Q
- I Y<1 S OUT=1 Q
- S NCDB=Y
- I NCDB=2 W ! D DCLC
- I NCDB=3 W ! D ACCN
- Q
- ACCN ;Accession Number
- ;P8 modify Accession range logic.
- N ONCACST,ONCACEN
- S ONCACST=$O(^ONCO(165.5,"AA",0)),ONCACEN=$O(^ONCO(165.5,"AA",""),-1)
- ;S:$D(ONCDATE) ONCACST=ONCDATE_"00000" S:$D(ONCDATE1) ONCACEN=ONCDATE1_"99999"
- S ONCDATE=1980,ONCDATE1=2000+$E(DT,2,3) ;Patch #13
- S:$D(ONCDATE) ONCACST=$O(^ONCO(165.5,"AA",ONCDATE_"00000"))
- S:$D(ONCDATE1) ONCACEN=$O(^ONCO(165.5,"AA",ONCDATE1_"99999"),-1)
- K DIR
- S DIR("B")=ONCACST
- S DIR(0)="NO^"_ONCACST_":"_ONCACEN
- S DIR("A")="Enter the Accession Number Start "
- S DIR("?")="Enter a number from "_ONCACST_" to "_ONCACEN
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S (BDT,SDT)=Y
- K DIR
- S DIR("B")=ONCACEN
- S DIR(0)="NO^"_BDT_":"_ONCACEN
- S DIR("A")="Enter the Accession Number End "
- S DIR("?")="Enter a number from "_BDT_" to "_ONCACEN
- D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
- S EDT=Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCACD0 14669 printed Feb 18, 2025@23:48:21 Page 2
- ONCACD0 ;HINES OIFO/GWB - NAACCR extract driver ;09/22/11
- +1 ;;2.2;ONCOLOGY;**1,4,5,8,6,10,12,13,14,15,17,19,20**;Jul 31, 2013;Build 5
- +2 ;P6 V16
- +3 ;P10 V18
- +4 ;P13 V21, P20 V23
- +5 ;P14 XML format for State and RCRS
- +6 ;P17 V22
- +7 ;P19 CC option is for State extract only
- EN1(DEVICE,STEXT) ;Entry point
- EN2 NEW ACO,BDT,DATE,DIAGYR,EDT,EXTRACT,NCDB,ONCSPIEN,QUEUE,SDT,STAT,STAT1,STAT2,YESNO,DATE1,ONCDATE,ONCDT,ONCLDT
- +1 NEW ACCN,ONCDT11,ONCDATE1,SCREEN,CYR,ONC91AS,PTR,CLASSOFCASE,ONCPHI,ONCCLCA,ONCR12,ONCRCL
- +2 KILL ^TMP($JOB),RQRS
- +3 SET DEVICE=$GET(DEVICE,0)
- SET STEXT=$GET(STEXT,0)
- SET EXT=""
- +4 SET (EDT,EXTRACT,DATE,OUT,QUEUE,SDT,STAT,ONCDT)=0
- +5 ;P2.2*4
- +6 WRITE !
- +7 WRITE !,"Protected Health Information data items are excluded from RCRS and NCDB reports, and Statute 38 USC 7332 codes are excluded from state, RCRS and NCDB reports.",!
- +8 SET ONCPHI=1
- +9 ;S DIR("A")=" Exclude PHI COMORBIDITY codes: "
- +10 ;S DIR("B")="YES",DIR(0)="Y"
- +11 ;S DIR("?")=" "
- +12 ;S DIR("?",1)=" Answer 'YES' if you want to exclude PHI COMORBIDITY codes."
- +13 ;S DIR("?",2)=" Answer 'NO' if you want to include PHI COMORBIDITY codes."
- +14 ;D ^DIR
- +15 ;I $D(DIRUT) S OUT=1 K DIRUT Q
- +16 ;S ONCPHI=Y
- +17 ;
- +18 IF (STEXT=0)!(STEXT=2)!(STEXT=3)
- SET EXTRACT=$ORDER(^ONCO(160.16,"B","NCDB EXTRACT V23.0",0))
- +19 ;p19
- IF (STEXT=1)&(DEVICE=1)
- DO GETREC(.EXTRACT,.OUT)
- +20 IF (STEXT=1)&(DEVICE=0)
- SET ONCRCL=4
- SET EXTRACT=5
- WRITE !,"The current record layout (v23.0) is for all states (including SEER states)."
- +21 IF 'OUT
- SET STAT=$$GETHOSP
- +22 IF 'STAT
- SET OUT=1
- +23 IF 'OUT
- SET STAT1=$PIECE(STAT,U,1)
- SET STAT2=$PIECE(STAT,U,2)
- +24 IF 'OUT
- DO GETDATE(.DATE,.DATE1,.OUT)
- +25 IF 'OUT
- IF STEXT=1
- DO GETDT(.SDT,.EDT,DATE,.OUT)
- +26 IF 'OUT
- IF STEXT=3
- DO RQRS(.SDT,.EDT,DATE,.OUT)
- SET RQRS=1
- +27 IF 'OUT
- DO VERIFY(STAT,DATE,SDT,EDT,STEXT,.YESNO,.OUT)
- +28 IF 'OUT
- if 'YESNO
- GOTO EN2
- +29 IF 'OUT
- DO DEVICE(DEVICE,.OUT)
- +30 IF 'OUT
- if 'QUEUE
- DO PRINT(DEVICE,.OUT)
- +31 DO EXIT
- +32 QUIT
- +33 ;
- GETREC(EXTRACT,OUT) ;Select VACCR, STATE record layout
- +1 WRITE !!," Available record layouts:",!
- +2 WRITE !," 1) VACCR Record Layout v23.0 (VA Registry)"
- +3 WRITE !," 2) State Record Layout v23.0"
- +4 WRITE !
- +5 NEW DIR,X,Y
- +6 SET DIR(0)="SAO^1:VACCR Record Layout v23.0;2:State Record Layout v23.0"
- +7 SET DIR("A")=" Select record layout: "
- +8 SET DIR("?")="Select the record layout to use"
- +9 DO ^DIR
- +10 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +11 IF +Y<1
- SET OUT=1
- QUIT
- +12 IF Y=1
- SET EXT="VACCR"
- SET EXTRACT=$ORDER(^ONCO(160.16,"B","VACCR EXTRACT V23.0",0))
- +13 IF Y=2
- SET EXT="STATE"
- SET EXTRACT=$ORDER(^ONCO(160.16,"B","STATE EXTRACT V23.0",0))
- +14 SET ONCRCL=Y
- +15 IF ONCRCL=1
- Begin DoDot:1
- +16 SET DIR("A")=" Exclude PHI COMORBIDITY codes: "
- +17 SET DIR("B")="YES"
- SET DIR(0)="Y"
- +18 SET DIR("?")=" "
- +19 SET DIR("?",1)=" Answer 'YES' if you want to exclude PHI COMORBIDITY codes."
- +20 SET DIR("?",2)=" Answer 'NO' if you want to include PHI COMORBIDITY codes."
- +21 DO ^DIR
- +22 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +23 SET ONCPHI=Y
- End DoDot:1
- +24 QUIT
- +25 ;
- GETHOSP() ;Facility Identification Number (FIN)
- +1 NEW STAT,STATI,ALLOK
- +2 SET STAT=0
- SET ALLOK=$$GETDXH(.STAT)
- +3 IF STAT
- SET STATI=6_STAT_0
- SET STAT=STAT_"^"_STATI
- +4 QUIT STAT
- +5 ;
- GETDXH(DXH) ;INSTITUTION ID NUMBER (160.1,27)
- +1 NEW OKHERE,DIE,DA,DR,ONCOL
- +2 WRITE !
- +3 SET DIE=160.1
- +4 SET DA=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +5 IF DA=""
- SET DA=$ORDER(^ONCO(160.1,0))
- +6 SET ONCSPIEN=DA
- +7 SET DR=27_$JUSTIFY("",1)_"Facility Identification Number (FIN)"
- +8 SET ONCOL=0
- +9 LOCK +^ONCO(160.1,DA):0
- IF $TEST
- DO ^DIE
- LOCK -^ONCO(160.1,DA)
- SET ONCOL=1
- +10 IF 'ONCOL
- WRITE !,"This ONCOLOGY SITE PARAMETERS record is being edited by another user."
- +11 KILL ONCOL,DIE
- +12 IF $DATA(Y)=0
- SET DXH=$$GET1^DIQ(160.19,X,.01,"I")
- +13 IF X'=""
- SET ACDSTATE=$PIECE($GET(^ONCO(160.19,X,0)),U,4)
- +14 SET OKHERE=($DATA(Y)=0)
- +15 QUIT OKHERE
- +16 ;
- RQRS(SDT,EDT,DATE,OUT) ;Process RCRS data
- +1 ;
- +2 WRITE !!!,"RCRS report will be run on ALL analytic cases.",!
- +3 SET ONCR12=2
- +4 ;K DIR
- +5 ;S DIR(0)="SAO^1:COLON, RECTUM and BREAST only;2:All Analytic Cases only"
- +6 ;S DIR("A")=" Select cases for inclusion: "
- +7 ;S DIR("?")="Select cases or primaries for RQRS download"
- +8 ;D ^DIR
- +9 ;I $D(DIRUT) S OUT=1 K DIRUT Q
- +10 ;I Y<1 S OUT=1 Q
- +11 ;S ONCR12=Y
- +12 WRITE !
- +13 ;
- +14 KILL DIR
- +15 SET DIR(0)="SAO^1:Date DX;2:Date Case Last Changed;3:Accession Number"
- +16 SET DIR("A")=" Select date field to be used for Start/End range: "
- +17 SET DIR("?")="Select the date field you wish to use for this download's Start/End range prompts."
- +18 DO ^DIR
- +19 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +20 IF Y<1
- SET OUT=1
- QUIT
- +21 SET (NCDB,ONCLDT)=Y
- +22 KILL DIR
- +23 SET ONCDT11=2880101
- +24 IF $GET(ONCLDT)=3
- DO ACCN
- QUIT
- +25 ;S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
- +26 SET DIR(0)="DO^3060101:"_DT_":EP"
- +27 ;S DIR("B")=$E(ONCDT11,4,5)_"/"_$E(ONCDT11,6,7)_"/"_$E(ONCDT11,2,3)
- +28 IF $GET(ONCLDT)=1
- Begin DoDot:1
- +29 SET DIR("A")=" Start, Date DX: "
- +30 SET DIR("?",1)=" Enter the DATE of Diagnosis of the"
- +31 SET DIR("?",2)=" FIRST abstract you would like to report."
- End DoDot:1
- +32 IF $GET(ONCLDT)=2
- Begin DoDot:1
- +33 SET DIR("A")=" Start, Date Case Last Changed: "
- +34 SET DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- +35 SET DIR("?",2)=" FIRST abstract you would like to report."
- End DoDot:1
- +36 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +37 SET SDT=Y
- +38 IF $EXTRACT(SDT,4,7)="0000"
- SET SDT=$EXTRACT(SDT,1,3)_"0101"
- +39 KILL DIR
- +40 SET CYR=1700+($EXTRACT(DT,1,3))
- SET SCREEN="K:(X>CYR)!(X<SDT) X"
- +41 SET DIR(0)="DO^"_SDT_":"_DT_":EP"
- +42 SET DIR("?")=" End Date must be greater than the Start Date."
- +43 IF $GET(ONCLDT)=1
- Begin DoDot:1
- +44 SET DIR("A")=" End, Date DX: "
- +45 SET DIR("?",1)=" Enter the DATE of Diagnosis of the"
- +46 SET DIR("?",2)=" LAST abstract you would like to report."
- End DoDot:1
- +47 IF $GET(ONCLDT)=2
- Begin DoDot:1
- +48 SET DIR("A")=" End, Date Case Last Changed: "
- +49 SET DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- +50 SET DIR("?",2)=" LAST abstract you would like to report."
- End DoDot:1
- +51 SET DIR("B")="TODAY"
- +52 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +53 SET EDT=Y
- IF $EXTRACT(EDT,4,7)="0000"
- SET EDT=$EXTRACT(EDT,1,3)_1231
- +54 ;
- +55 QUIT
- +56 ;
- GETDT(SDT,EDT,DATE,OUT) ; Select a date range
- +1 KILL DIR
- +2 SET DIR(0)="SAO^1:Date Case Completed;2:Date Case Last Changed;3:Accession Number"
- +3 SET DIR("A")=" Select date field to be used for Start/End range: "
- +4 SET DIR("?")="Select the date field you wish to use for this download's Start/End range prompts."
- +5 DO ^DIR
- +6 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +7 IF Y<1
- SET OUT=1
- QUIT
- +8 SET ONCLDT=Y
- +9 SET ONCDT11=3000101
- DCLC KILL DIR
- +1 IF $GET(ONCLDT)=3
- DO ACCN
- if OUT=1
- QUIT
- GOTO ACJ
- +2 SET CYR=DT
- SET SCREEN="K:(X>CYR)!(X<ONCDT11) X"
- +3 SET DIR(0)="DO^"_ONCDT11_":"_DT_":EP"
- +4 ;S DIR("B")=$E(ONCDT11,4,5)_"/"_$E(ONCDT11,6,7)_"/"_$E(ONCDT11,2,3)
- +5 IF $GET(ONCLDT)=1
- Begin DoDot:1
- +6 SET DIR("A")=" Start, Date Case Completed: "
- +7 SET DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
- +8 SET DIR("?",2)=" FIRST abstract you would like to report."
- End DoDot:1
- +9 IF ($GET(ONCLDT)=2)!($GET(NCDB)=2)
- Begin DoDot:1
- +10 SET DIR("A")=" Start, Date Case Last Changed: "
- +11 SET DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- +12 SET DIR("?",2)=" FIRST abstract you would like to report."
- End DoDot:1
- +13 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +14 SET (SDT,BDT)=Y
- +15 KILL DIR
- +16 SET CYR=DT
- SET SCREEN="K:(X>CYR)!(X<SDT) X"
- +17 SET DIR(0)="DO^"_SDT_":"_DT_":EP"
- +18 SET DIR("B")="TODAY"
- +19 SET DIR("?")=" End Date must be greater than the Start Date."
- +20 IF $GET(ONCLDT)=1
- Begin DoDot:1
- +21 SET DIR("A")=" End, Date Case Completed: "
- +22 IF EXT="VACCR"
- IF $PIECE($GET(^ONCO(160.1,ONCSPIEN,0)),U,8)'=""
- SET ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,61)
- +23 IF EXT="STATE"
- IF $PIECE($GET(^ONCO(160.1,ONCSPIEN,0)),U,9)'=""
- SET ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,62)
- +24 SET DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
- +25 SET DIR("?",2)=" LAST abstract you would like to report."
- End DoDot:1
- +26 IF ($GET(ONCLDT)=2)!($GET(NCDB)=2)
- Begin DoDot:1
- +27 SET DIR("A")=" End, Date Case Last Changed: "
- +28 IF EXT="VACCR"
- IF $PIECE($GET(^ONCO(160.1,ONCSPIEN,0)),U,10)'=""
- SET ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,63)
- +29 IF EXT="STATE"
- IF $PIECE($GET(^ONCO(160.1,ONCSPIEN,0)),U,11)'=""
- SET ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,64)
- +30 SET DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
- +31 SET DIR("?",2)=" LAST abstract you would like to report."
- End DoDot:1
- +32 ;S:$G(ONCED89) DIR("B")=$E(ONCED89,4,5)_"/"_$E(ONCED89,6,7)_"/"_$E(ONCED89,2,3)
- +33 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +34 SET EDT=Y
- IF $PIECE(EDT,".",2)=""
- SET EDT=EDT_.2500
- ACJ IF EXT=""
- QUIT
- +1 IF $GET(NCDB)=2
- QUIT
- +2 IF EXT="VACCR"
- QUIT
- +3 KILL DIR
- +4 SET DIR("A")=" Analytic cases only"
- +5 SET DIR("B")="YES"
- +6 SET DIR(0)="Y"
- +7 SET DIR("?")=" "
- +8 SET DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 0-2) extracted."
- +9 SET DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) extracted."
- +10 DO ^DIR
- +11 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +12 SET ACO=Y
- +13 QUIT
- +14 ;
- DATEDX(SDT,EDT,DATE,OUT) ;Select DATE DX range
- +1 KILL DIR
- +2 SET CYR=1700+($EXTRACT(DT,1,3))
- SET SCREEN="K:X>CYR X"
- +3 ;S DIR(0)="DO^3000101:"_DT_":EP"
- +4 ;S DIR(0)="D^::X"
- +5 SET DIR("A")=" Start, Date Dx: "
- +6 SET DIR("?",1)=" Enter the DATE DX of the FIRST"
- +7 SET DIR("?",2)=" abstract you would like to report."
- +8 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +9 SET (SDT,BDT)=Y
- +10 KILL DIR
- +11 SET CYR=1700+($EXTRACT(DT,1,3))
- SET SCREEN="K:(X>CYR)!(X<SDT) X"
- +12 SET DIR(0)="DO^"_SDT_":"_DT_":EP"
- +13 ;S DIR(0)="D^::X"
- +14 SET DIR("A")=" End, Date Dx:"
- +15 SET DIR("?",1)=" Enter the DATE DX of the LAST abstract you would"
- +16 SET DIR("?",2)=" like to report and must be greater than Start, Date Dx."
- +17 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +18 SET EDT=Y
- +19 QUIT
- +20 ;
- PRINT(DEVICE,OUT) ;Capture output data
- +1 IF 'DEVICE
- Begin DoDot:1
- +2 NEW X
- +3 WRITE !!
- +4 WRITE !,?6,"--------------------------------------------------------------"
- +5 WRITE !,?6,"|Please activate your PC capture program. The data will be |"
- +6 WRITE !,?6,"|sent in 2 minutes or when you press the return key. |"
- +7 WRITE !,?6,"--------------------------------------------------------------"
- +8 WRITE !!!
- +9 READ X:120
- +10 IF X="^"
- SET OUT=1
- End DoDot:1
- if OUT
- QUIT
- +11 USE IO
- DO EN1^ONCACD1
- +12 QUIT
- +13 ;
- EXIT ;Exit
- +1 KILL ACDSTATE,DIC,EXT,OUT,X,Y
- +2 IF '$DATA(^TMP($JOB))
- WRITE !?3,"No records extracted."
- GOTO EX
- +3 WRITE !
- +4 SET DIC="^ONCO(165.5,"
- SET L=0
- SET FLDS="[ONC EXTRACT REPORT]"
- SET BY(0)="^TMP($J,"
- SET L(0)=1
- +5 if DEVICE
- SET IOP=ION
- +6 IF STEXT=0
- SET DHD=$PIECE(^ONCO(160.16,EXTRACT,0),U,1)
- WRITE !
- +7 IF (STEXT=1)!(STEXT=2)
- SET DHD=$PIECE(^ONCO(160.16,EXTRACT,0),U,1)_" "_$$FMTE^XLFDT(BDT,"2D")_" - "_$$FMTE^XLFDT(EDT,"2D")
- +8 DO EN1^DIP
- +9 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if 'Y
- QUIT
- +10 ;
- EX KILL ^TMP($JOB)
- +1 KILL %ZIS
- +2 DO ^%ZISC
- +3 KILL ACDANS,BY,CCEX,DHD,EXT,FLDS,FR,IOP,L,POP,STEXT,TO
- +4 QUIT
- +5 ;
- DEVICE(DEVICE,OUT) ;Select output device
- +1 if 'DEVICE
- QUIT
- +2 SET %ZIS="Q"
- +3 DO ^%ZIS
- +4 IF POP
- SET OUT=1
- QUIT
- +5 IF $DATA(IO("Q"))
- Begin DoDot:1
- +6 SET ZTRTN="PRINT^ONCACD0(DEVICE,.OUT)"
- +7 SET ZTDESC=$SELECT('STEXT:"ONC NCDB Extract",STEXT:"ONC State Extract",1:"")
- +8 SET ZTSAVE("STAT1")=""
- +9 SET ZTSAVE("DATE")=""
- +10 SET ZTSAVE("DATE1")=""
- +11 SET ZTSAVE("ONCDT")=""
- +12 SET ZTSAVE("ONCLDT")=""
- +13 SET ZTSAVE("STEXT")=""
- +14 SET ZTSAVE("DEVICE")=""
- +15 SET ZTSAVE("OUT")=""
- +16 SET ZTSAVE("BDT")=""
- +17 SET ZTSAVE("SDT")=""
- +18 SET ZTSAVE("EDT")=""
- +19 SET ZTSAVE("EXT")=""
- +20 SET ZTSAVE("EXTRACT")=""
- +21 SET ZTSAVE("NCDB")=""
- +22 DO ^%ZTLOAD
- +23 IF $DATA(ZTSK)[0
- SET OUT=1
- WRITE !!,?20,"Report Canceled!"
- +24 IF '$TEST
- WRITE !!,?20,"Report Queued!"
- SET QUEUE=1
- +25 DO HOME^%ZIS
- End DoDot:1
- +26 KILL ZTDESC,ZTRTN,ZTSAVE,ZTSK
- +27 QUIT
- +28 ;
- VERIFY(STAT,DATE,SDT,EDT,STEXT,YESNO,OUT) ;Verify settings
- +1 NEW DIR,Y,RL
- +2 SET RL=$PIECE(^ONCO(160.16,EXTRACT,0),U,1)
- +3 IF STEXT=3
- SET RL="RCRS EXTRACT"
- +4 WRITE !!," These are your current settings:"
- +5 WRITE !
- +6 WRITE !," Record layout.......................: ",RL
- +7 WRITE !," Facility Identification Number (FIN): ",STAT1
- +8 IF EXT="STATE"
- Begin DoDot:1
- +9 WRITE !," State to be extracted...............: ",ACDSTATE
- End DoDot:1
- +10 IF STEXT=0
- Begin DoDot:1
- +11 WRITE !," Diagnosis Year......................: ",DIAGYR
- +12 WRITE !," Selection criterion.................: ",$SELECT(NCDB=1:"All cases",NCDB=2:"Date Case Last Changed date range",NCDB=3:"Accession Number",1:"")
- End DoDot:1
- +13 IF STEXT=3
- Begin DoDot:1
- +14 WRITE !," Selection criterion.................: ",$SELECT(NCDB=1:"Date DX",NCDB=2:"Date Case Last Changed date range",NCDB=3:"Accession Number",1:"")
- End DoDot:1
- +15 IF (STEXT=1)!(STEXT=2)!(STEXT=3)
- IF (($GET(NCDB)'=3)&($GET(ONCLDT)'=3))
- Begin DoDot:1
- +16 WRITE !," Start date..........................: ",$$FMTE^XLFDT(SDT,"2D")
- +17 WRITE !," End date............................: ",$$FMTE^XLFDT(EDT,"2D")
- End DoDot:1
- +18 IF ($GET(ONCLDT)=3)!($GET(NCDB)=3)
- Begin DoDot:1
- +19 WRITE !," Accession Number Start..........: ",SDT
- +20 WRITE !," Accession Number End............: ",EDT
- End DoDot:1
- +21 IF EXT="STATE"
- Begin DoDot:1
- +22 WRITE !," Analytic cases only.................: ",$SELECT(ACO=1:"YES",1:"NO")
- End DoDot:1
- +23 WRITE !
- +24 SET DIR("A")=" Are these settings correct"
- +25 SET DIR("B")="YES"
- +26 SET DIR(0)="Y"
- +27 DO ^DIR
- +28 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +29 SET YESNO=Y
- +30 IF STEXT=1
- IF EXT="VACCR"
- SET $PIECE(^ONCO(160.1,ONCSPIEN,0),U,8)=EDT
- +31 IF STEXT=1
- IF EXT="STATE"
- SET $PIECE(^ONCO(160.1,ONCSPIEN,0),U,9)=EDT
- +32 IF STEXT=2
- IF EXT="VACCR"
- SET $PIECE(^ONCO(160.1,ONCSPIEN,0),U,10)=EDT
- +33 IF STEXT=2
- IF EXT="STATE"
- SET $PIECE(^ONCO(160.1,ONCSPIEN,0),U,11)=EDT
- +34 QUIT
- +35 ;
- GETDATE(ONCDT,DATE1,OUT) ;Select Diagnosis Year
- +1 if STEXT>0
- QUIT
- +2 NEW CYR,DIR,SCREEN,Y
- +3 SET ONCDT=0
- +4 SET CYR=1700+($EXTRACT(DT,1,3))
- SET SCREEN="K:X>CYR X"
- +5 SET DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN
- +6 SET DIR("A")=" Diagnosis Year Start: "
- +7 DO ^DIR
- +8 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +9 ;S (ONCDT,DIAGYR)=Y
- +10 SET (ONCDATE,ONCDT)=Y
- +11 SET ONCDT=ONCDT-1700
- +12 SET ONCDT11=ONCDT_"0101"
- +13 SET ONCDT=ONCDT_"0000"
- +14 SET (ONCDT,ONCLDT)=ONCDT-1
- +15 ;Diagnosis Year End
- +16 KILL DIR
- +17 SET DATE1=ONCDATE
- +18 SET CYR=1700+($EXTRACT(DT,1,3))
- SET SCREEN="K:(X>CYR)!(X<ONCDATE) X"
- +19 SET DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN
- +20 SET DIR("A")=" Diagnosis Year End: "
- +21 SET DIR("?")=" Diagnosis Year End must be a number and greater than the Start year."
- +22 DO ^DIR
- +23 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +24 SET (ONCDATE1,DATE1)=Y
- +25 SET DIAGYR=ONCDATE_"-"_Y
- +26 SET DATE1=DATE1+1
- +27 SET DATE1=DATE1-1700
- +28 SET DATE1=DATE1_"0000"
- +29 SET DATE1=DATE1-1
- +30 KILL DIR
- +31 WRITE !," Diagnosis Years: ",DIAGYR
- +32 WRITE !
- +33 WRITE !,?6,"Select one of the following:"
- +34 WRITE !
- +35 WRITE !,?11,"1 All eligible cases for this year"
- +36 WRITE !,?11,"2 Cases within a 'Date Case Last Changed' date range"
- +37 WRITE !,?11,"3 Accession Number"
- +38 WRITE !
- +39 SET DIR(0)="SAO^1:All cases;2:Cases within a date range;3:Accession Number"
- +40 SET DIR("A")=" Select extraction criterion: "
- +41 SET DIR("B")="All cases"
- +42 SET DIR("?")=" "
- +43 SET DIR("?",1)=" Select 'All cases' if you want to extract all"
- +44 SET DIR("?",2)=" of the eligible cases for this Diagnosis Year."
- +45 SET DIR("?",3)=""
- +46 SET DIR("?",4)=" Select 'Cases within a date range' if you want"
- +47 SET DIR("?",5)=" to specify a 'Date Case Last Changed' date range"
- +48 SET DIR("?",6)=" for this Diagnosis Year."
- +49 SET DIR("?",7)=" "
- +50 SET DIR("?",8)="Select 'Accession Number-Seq' if you want to specify"
- +51 SET DIR("?",9)="the extract by Accession Number range."
- +52 DO ^DIR
- +53 IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +54 IF Y<1
- SET OUT=1
- QUIT
- +55 SET NCDB=Y
- +56 IF NCDB=2
- WRITE !
- DO DCLC
- +57 IF NCDB=3
- WRITE !
- DO ACCN
- +58 QUIT
- ACCN ;Accession Number
- +1 ;P8 modify Accession range logic.
- +2 NEW ONCACST,ONCACEN
- +3 SET ONCACST=$ORDER(^ONCO(165.5,"AA",0))
- SET ONCACEN=$ORDER(^ONCO(165.5,"AA",""),-1)
- +4 ;S:$D(ONCDATE) ONCACST=ONCDATE_"00000" S:$D(ONCDATE1) ONCACEN=ONCDATE1_"99999"
- +5 ;Patch #13
- SET ONCDATE=1980
- SET ONCDATE1=2000+$EXTRACT(DT,2,3)
- +6 if $DATA(ONCDATE)
- SET ONCACST=$ORDER(^ONCO(165.5,"AA",ONCDATE_"00000"))
- +7 if $DATA(ONCDATE1)
- SET ONCACEN=$ORDER(^ONCO(165.5,"AA",ONCDATE1_"99999"),-1)
- +8 KILL DIR
- +9 SET DIR("B")=ONCACST
- +10 SET DIR(0)="NO^"_ONCACST_":"_ONCACEN
- +11 SET DIR("A")="Enter the Accession Number Start "
- +12 SET DIR("?")="Enter a number from "_ONCACST_" to "_ONCACEN
- +13 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +14 SET (BDT,SDT)=Y
- +15 KILL DIR
- +16 SET DIR("B")=ONCACEN
- +17 SET DIR(0)="NO^"_BDT_":"_ONCACEN
- +18 SET DIR("A")="Enter the Accession Number End "
- +19 SET DIR("?")="Enter a number from "_BDT_" to "_ONCACEN
- +20 DO ^DIR
- IF $DATA(DIRUT)
- SET OUT=1
- KILL DIRUT
- QUIT
- +21 SET EDT=Y
- +22 QUIT