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**;Jul 31, 2013;Build 4
;P6 V16
;P10 V18
;P13 V21
;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 codes are excluded in State 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 V22.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 (v22.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 v22.0 (VA Registry)"
W !," 2) State Record Layout v22.0"
W !
N DIR,X,Y
S DIR(0)="SAO^1:VACCR Record Layout v22.0;2:State Record Layout v22.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 V22.0",0))
I Y=2 S EXT="STATE",EXTRACT=$O(^ONCO(160.16,"B","STATE EXTRACT V22.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 14564 printed Oct 16, 2024@18:22:41 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**;Jul 31, 2013;Build 4
+2 ;P6 V16
+3 ;P10 V18
+4 ;P13 V21
+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 codes are excluded in State 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 V22.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 (v22.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 v22.0 (VA Registry)"
+3 WRITE !," 2) State Record Layout v22.0"
+4 WRITE !
+5 NEW DIR,X,Y
+6 SET DIR(0)="SAO^1:VACCR Record Layout v22.0;2:State Record Layout v22.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 V22.0",0))
+13 IF Y=2
SET EXT="STATE"
SET EXTRACT=$ORDER(^ONCO(160.16,"B","STATE EXTRACT V22.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
