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

ONCACD0.m

Go to the documentation of this file.
  1. 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
  1. ;P6 V16
  1. ;P10 V18
  1. ;P13 V21, P20 V23
  1. ;P14 XML format for State and RCRS
  1. ;P17 V22
  1. ;P19 CC option is for State extract only
  1. EN1(DEVICE,STEXT) ;Entry point
  1. EN2 N ACO,BDT,DATE,DIAGYR,EDT,EXTRACT,NCDB,ONCSPIEN,QUEUE,SDT,STAT,STAT1,STAT2,YESNO,DATE1,ONCDATE,ONCDT,ONCLDT
  1. N ACCN,ONCDT11,ONCDATE1,SCREEN,CYR,ONC91AS,PTR,CLASSOFCASE,ONCPHI,ONCCLCA,ONCR12,ONCRCL
  1. K ^TMP($J),RQRS
  1. S DEVICE=$G(DEVICE,0),STEXT=$G(STEXT,0),EXT=""
  1. S (EDT,EXTRACT,DATE,OUT,QUEUE,SDT,STAT,ONCDT)=0
  1. ;P2.2*4
  1. W !
  1. 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.",!
  1. S ONCPHI=1
  1. ;S DIR("A")=" Exclude PHI COMORBIDITY codes: "
  1. ;S DIR("B")="YES",DIR(0)="Y"
  1. ;S DIR("?")=" "
  1. ;S DIR("?",1)=" Answer 'YES' if you want to exclude PHI COMORBIDITY codes."
  1. ;S DIR("?",2)=" Answer 'NO' if you want to include PHI COMORBIDITY codes."
  1. ;D ^DIR
  1. ;I $D(DIRUT) S OUT=1 K DIRUT Q
  1. ;S ONCPHI=Y
  1. ;
  1. I (STEXT=0)!(STEXT=2)!(STEXT=3) S EXTRACT=$O(^ONCO(160.16,"B","NCDB EXTRACT V23.0",0))
  1. I (STEXT=1)&(DEVICE=1) D GETREC(.EXTRACT,.OUT) ;p19
  1. I (STEXT=1)&(DEVICE=0) S ONCRCL=4,EXTRACT=5 W !,"The current record layout (v23.0) is for all states (including SEER states)."
  1. I 'OUT S STAT=$$GETHOSP
  1. I 'STAT S OUT=1
  1. I 'OUT S STAT1=$P(STAT,U,1),STAT2=$P(STAT,U,2)
  1. I 'OUT D GETDATE(.DATE,.DATE1,.OUT)
  1. I 'OUT,STEXT=1 D GETDT(.SDT,.EDT,DATE,.OUT)
  1. I 'OUT,STEXT=3 D RQRS(.SDT,.EDT,DATE,.OUT) S RQRS=1
  1. I 'OUT D VERIFY(STAT,DATE,SDT,EDT,STEXT,.YESNO,.OUT)
  1. I 'OUT G:'YESNO EN2
  1. I 'OUT D DEVICE(DEVICE,.OUT)
  1. I 'OUT D:'QUEUE PRINT(DEVICE,.OUT)
  1. D EXIT
  1. Q
  1. ;
  1. GETREC(EXTRACT,OUT) ;Select VACCR, STATE record layout
  1. W !!," Available record layouts:",!
  1. W !," 1) VACCR Record Layout v23.0 (VA Registry)"
  1. W !," 2) State Record Layout v23.0"
  1. W !
  1. N DIR,X,Y
  1. S DIR(0)="SAO^1:VACCR Record Layout v23.0;2:State Record Layout v23.0"
  1. S DIR("A")=" Select record layout: "
  1. S DIR("?")="Select the record layout to use"
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. I +Y<1 S OUT=1 Q
  1. I Y=1 S EXT="VACCR",EXTRACT=$O(^ONCO(160.16,"B","VACCR EXTRACT V23.0",0))
  1. I Y=2 S EXT="STATE",EXTRACT=$O(^ONCO(160.16,"B","STATE EXTRACT V23.0",0))
  1. S ONCRCL=Y
  1. I ONCRCL=1 D
  1. .S DIR("A")=" Exclude PHI COMORBIDITY codes: "
  1. .S DIR("B")="YES",DIR(0)="Y"
  1. .S DIR("?")=" "
  1. .S DIR("?",1)=" Answer 'YES' if you want to exclude PHI COMORBIDITY codes."
  1. .S DIR("?",2)=" Answer 'NO' if you want to include PHI COMORBIDITY codes."
  1. .D ^DIR
  1. .I $D(DIRUT) S OUT=1 K DIRUT Q
  1. .S ONCPHI=Y
  1. Q
  1. ;
  1. GETHOSP() ;Facility Identification Number (FIN)
  1. N STAT,STATI,ALLOK
  1. S STAT=0,ALLOK=$$GETDXH(.STAT)
  1. I STAT S STATI=6_STAT_0,STAT=STAT_"^"_STATI
  1. Q STAT
  1. ;
  1. GETDXH(DXH) ;INSTITUTION ID NUMBER (160.1,27)
  1. N OKHERE,DIE,DA,DR,ONCOL
  1. W !
  1. S DIE=160.1
  1. S DA=$O(^ONCO(160.1,"C",DUZ(2),0))
  1. I DA="" S DA=$O(^ONCO(160.1,0))
  1. S ONCSPIEN=DA
  1. S DR=27_$J("",1)_"Facility Identification Number (FIN)"
  1. S ONCOL=0
  1. L +^ONCO(160.1,DA):0 I $T D ^DIE L -^ONCO(160.1,DA) S ONCOL=1
  1. I 'ONCOL W !,"This ONCOLOGY SITE PARAMETERS record is being edited by another user."
  1. K ONCOL,DIE
  1. I $D(Y)=0 S DXH=$$GET1^DIQ(160.19,X,.01,"I")
  1. I X'="" S ACDSTATE=$P($G(^ONCO(160.19,X,0)),U,4)
  1. S OKHERE=($D(Y)=0)
  1. Q OKHERE
  1. ;
  1. RQRS(SDT,EDT,DATE,OUT) ;Process RCRS data
  1. ;
  1. W !!!,"RCRS report will be run on ALL analytic cases.",!
  1. S ONCR12=2
  1. ;K DIR
  1. ;S DIR(0)="SAO^1:COLON, RECTUM and BREAST only;2:All Analytic Cases only"
  1. ;S DIR("A")=" Select cases for inclusion: "
  1. ;S DIR("?")="Select cases or primaries for RQRS download"
  1. ;D ^DIR
  1. ;I $D(DIRUT) S OUT=1 K DIRUT Q
  1. ;I Y<1 S OUT=1 Q
  1. ;S ONCR12=Y
  1. W !
  1. ;
  1. K DIR
  1. S DIR(0)="SAO^1:Date DX;2:Date Case Last Changed;3:Accession Number"
  1. S DIR("A")=" Select date field to be used for Start/End range: "
  1. S DIR("?")="Select the date field you wish to use for this download's Start/End range prompts."
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. I Y<1 S OUT=1 Q
  1. S (NCDB,ONCLDT)=Y
  1. K DIR
  1. S ONCDT11=2880101
  1. I $G(ONCLDT)=3 D ACCN Q
  1. ;S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
  1. S DIR(0)="DO^3060101:"_DT_":EP"
  1. ;S DIR("B")=$E(ONCDT11,4,5)_"/"_$E(ONCDT11,6,7)_"/"_$E(ONCDT11,2,3)
  1. I $G(ONCLDT)=1 D
  1. .S DIR("A")=" Start, Date DX: "
  1. .S DIR("?",1)=" Enter the DATE of Diagnosis of the"
  1. .S DIR("?",2)=" FIRST abstract you would like to report."
  1. I $G(ONCLDT)=2 D
  1. .S DIR("A")=" Start, Date Case Last Changed: "
  1. .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
  1. .S DIR("?",2)=" FIRST abstract you would like to report."
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S SDT=Y
  1. I $E(SDT,4,7)="0000" S SDT=$E(SDT,1,3)_"0101"
  1. K DIR
  1. S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(X<SDT) X"
  1. S DIR(0)="DO^"_SDT_":"_DT_":EP"
  1. S DIR("?")=" End Date must be greater than the Start Date."
  1. I $G(ONCLDT)=1 D
  1. .S DIR("A")=" End, Date DX: "
  1. .S DIR("?",1)=" Enter the DATE of Diagnosis of the"
  1. .S DIR("?",2)=" LAST abstract you would like to report."
  1. I $G(ONCLDT)=2 D
  1. .S DIR("A")=" End, Date Case Last Changed: "
  1. .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
  1. .S DIR("?",2)=" LAST abstract you would like to report."
  1. S DIR("B")="TODAY"
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S EDT=Y I $E(EDT,4,7)="0000" S EDT=$E(EDT,1,3)_1231
  1. ;
  1. Q
  1. ;
  1. GETDT(SDT,EDT,DATE,OUT) ; Select a date range
  1. K DIR
  1. S DIR(0)="SAO^1:Date Case Completed;2:Date Case Last Changed;3:Accession Number"
  1. S DIR("A")=" Select date field to be used for Start/End range: "
  1. S DIR("?")="Select the date field you wish to use for this download's Start/End range prompts."
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. I Y<1 S OUT=1 Q
  1. S ONCLDT=Y
  1. S ONCDT11=3000101
  1. DCLC K DIR
  1. I $G(ONCLDT)=3 D ACCN Q:OUT=1 G ACJ
  1. S CYR=DT,SCREEN="K:(X>CYR)!(X<ONCDT11) X"
  1. S DIR(0)="DO^"_ONCDT11_":"_DT_":EP"
  1. ;S DIR("B")=$E(ONCDT11,4,5)_"/"_$E(ONCDT11,6,7)_"/"_$E(ONCDT11,2,3)
  1. I $G(ONCLDT)=1 D
  1. .S DIR("A")=" Start, Date Case Completed: "
  1. .S DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
  1. .S DIR("?",2)=" FIRST abstract you would like to report."
  1. I ($G(ONCLDT)=2)!($G(NCDB)=2) D
  1. .S DIR("A")=" Start, Date Case Last Changed: "
  1. .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
  1. .S DIR("?",2)=" FIRST abstract you would like to report."
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S (SDT,BDT)=Y
  1. K DIR
  1. S CYR=DT,SCREEN="K:(X>CYR)!(X<SDT) X"
  1. S DIR(0)="DO^"_SDT_":"_DT_":EP"
  1. S DIR("B")="TODAY"
  1. S DIR("?")=" End Date must be greater than the Start Date."
  1. I $G(ONCLDT)=1 D
  1. .S DIR("A")=" End, Date Case Completed: "
  1. .I EXT="VACCR",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,8)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,61)
  1. .I EXT="STATE",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,9)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,62)
  1. .S DIR("?",1)=" Enter the DATE CASE COMPLETED of the"
  1. .S DIR("?",2)=" LAST abstract you would like to report."
  1. I ($G(ONCLDT)=2)!($G(NCDB)=2) D
  1. .S DIR("A")=" End, Date Case Last Changed: "
  1. .I EXT="VACCR",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,10)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,63)
  1. .I EXT="STATE",$P($G(^ONCO(160.1,ONCSPIEN,0)),U,11)'="" S ONCED89=$$GET1^DIQ(160.1,ONCSPIEN,64)
  1. .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the"
  1. .S DIR("?",2)=" LAST abstract you would like to report."
  1. ;S:$G(ONCED89) DIR("B")=$E(ONCED89,4,5)_"/"_$E(ONCED89,6,7)_"/"_$E(ONCED89,2,3)
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S EDT=Y I $P(EDT,".",2)="" S EDT=EDT_.2500
  1. ACJ I EXT="" Q
  1. I $G(NCDB)=2 Q
  1. I EXT="VACCR" Q
  1. K DIR
  1. S DIR("A")=" Analytic cases only"
  1. S DIR("B")="YES"
  1. S DIR(0)="Y"
  1. S DIR("?")=" "
  1. S DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 0-2) extracted."
  1. S DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) extracted."
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S ACO=Y
  1. Q
  1. ;
  1. DATEDX(SDT,EDT,DATE,OUT) ;Select DATE DX range
  1. K DIR
  1. S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
  1. ;S DIR(0)="DO^3000101:"_DT_":EP"
  1. ;S DIR(0)="D^::X"
  1. S DIR("A")=" Start, Date Dx: "
  1. S DIR("?",1)=" Enter the DATE DX of the FIRST"
  1. S DIR("?",2)=" abstract you would like to report."
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S (SDT,BDT)=Y
  1. K DIR
  1. S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(X<SDT) X"
  1. S DIR(0)="DO^"_SDT_":"_DT_":EP"
  1. ;S DIR(0)="D^::X"
  1. S DIR("A")=" End, Date Dx:"
  1. S DIR("?",1)=" Enter the DATE DX of the LAST abstract you would"
  1. S DIR("?",2)=" like to report and must be greater than Start, Date Dx."
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S EDT=Y
  1. Q
  1. ;
  1. PRINT(DEVICE,OUT) ;Capture output data
  1. I 'DEVICE D Q:OUT
  1. .N X
  1. .W !!
  1. .W !,?6,"--------------------------------------------------------------"
  1. .W !,?6,"|Please activate your PC capture program. The data will be |"
  1. .W !,?6,"|sent in 2 minutes or when you press the return key. |"
  1. .W !,?6,"--------------------------------------------------------------"
  1. .W !!!
  1. .R X:120
  1. .I X="^" S OUT=1
  1. U IO D EN1^ONCACD1
  1. Q
  1. ;
  1. EXIT ;Exit
  1. K ACDSTATE,DIC,EXT,OUT,X,Y
  1. I '$D(^TMP($J)) W !?3,"No records extracted." G EX
  1. W !
  1. S DIC="^ONCO(165.5,",L=0,FLDS="[ONC EXTRACT REPORT]",BY(0)="^TMP($J,",L(0)=1
  1. S:DEVICE IOP=ION
  1. I STEXT=0 S DHD=$P(^ONCO(160.16,EXTRACT,0),U,1) W !
  1. I (STEXT=1)!(STEXT=2) S DHD=$P(^ONCO(160.16,EXTRACT,0),U,1)_" "_$$FMTE^XLFDT(BDT,"2D")_" - "_$$FMTE^XLFDT(EDT,"2D")
  1. D EN1^DIP
  1. I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR Q:'Y
  1. ;
  1. EX K ^TMP($J)
  1. K %ZIS
  1. D ^%ZISC
  1. K ACDANS,BY,CCEX,DHD,EXT,FLDS,FR,IOP,L,POP,STEXT,TO
  1. Q
  1. ;
  1. DEVICE(DEVICE,OUT) ;Select output device
  1. Q:'DEVICE
  1. S %ZIS="Q"
  1. D ^%ZIS
  1. I POP S OUT=1 Q
  1. I $D(IO("Q")) D
  1. .S ZTRTN="PRINT^ONCACD0(DEVICE,.OUT)"
  1. .S ZTDESC=$S('STEXT:"ONC NCDB Extract",STEXT:"ONC State Extract",1:"")
  1. .S ZTSAVE("STAT1")=""
  1. .S ZTSAVE("DATE")=""
  1. .S ZTSAVE("DATE1")=""
  1. .S ZTSAVE("ONCDT")=""
  1. .S ZTSAVE("ONCLDT")=""
  1. .S ZTSAVE("STEXT")=""
  1. .S ZTSAVE("DEVICE")=""
  1. .S ZTSAVE("OUT")=""
  1. .S ZTSAVE("BDT")=""
  1. .S ZTSAVE("SDT")=""
  1. .S ZTSAVE("EDT")=""
  1. .S ZTSAVE("EXT")=""
  1. .S ZTSAVE("EXTRACT")=""
  1. .S ZTSAVE("NCDB")=""
  1. .D ^%ZTLOAD
  1. .I $D(ZTSK)[0 S OUT=1 W !!,?20,"Report Canceled!"
  1. .E W !!,?20,"Report Queued!" S QUEUE=1
  1. .D HOME^%ZIS
  1. K ZTDESC,ZTRTN,ZTSAVE,ZTSK
  1. Q
  1. ;
  1. VERIFY(STAT,DATE,SDT,EDT,STEXT,YESNO,OUT) ;Verify settings
  1. N DIR,Y,RL
  1. S RL=$P(^ONCO(160.16,EXTRACT,0),U,1)
  1. I STEXT=3 S RL="RCRS EXTRACT"
  1. W !!," These are your current settings:"
  1. W !
  1. W !," Record layout.......................: ",RL
  1. W !," Facility Identification Number (FIN): ",STAT1
  1. I EXT="STATE" D
  1. .W !," State to be extracted...............: ",ACDSTATE
  1. I STEXT=0 D
  1. .W !," Diagnosis Year......................: ",DIAGYR
  1. .W !," Selection criterion.................: ",$S(NCDB=1:"All cases",NCDB=2:"Date Case Last Changed date range",NCDB=3:"Accession Number",1:"")
  1. I STEXT=3 D
  1. .W !," Selection criterion.................: ",$S(NCDB=1:"Date DX",NCDB=2:"Date Case Last Changed date range",NCDB=3:"Accession Number",1:"")
  1. I (STEXT=1)!(STEXT=2)!(STEXT=3),(($G(NCDB)'=3)&($G(ONCLDT)'=3)) D
  1. .W !," Start date..........................: ",$$FMTE^XLFDT(SDT,"2D")
  1. .W !," End date............................: ",$$FMTE^XLFDT(EDT,"2D")
  1. I ($G(ONCLDT)=3)!($G(NCDB)=3) D
  1. .W !," Accession Number Start..........: ",SDT
  1. .W !," Accession Number End............: ",EDT
  1. I EXT="STATE" D
  1. .W !," Analytic cases only.................: ",$S(ACO=1:"YES",1:"NO")
  1. W !
  1. S DIR("A")=" Are these settings correct"
  1. S DIR("B")="YES"
  1. S DIR(0)="Y"
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S YESNO=Y
  1. I STEXT=1,EXT="VACCR" S $P(^ONCO(160.1,ONCSPIEN,0),U,8)=EDT
  1. I STEXT=1,EXT="STATE" S $P(^ONCO(160.1,ONCSPIEN,0),U,9)=EDT
  1. I STEXT=2,EXT="VACCR" S $P(^ONCO(160.1,ONCSPIEN,0),U,10)=EDT
  1. I STEXT=2,EXT="STATE" S $P(^ONCO(160.1,ONCSPIEN,0),U,11)=EDT
  1. Q
  1. ;
  1. GETDATE(ONCDT,DATE1,OUT) ;Select Diagnosis Year
  1. Q:STEXT>0
  1. N CYR,DIR,SCREEN,Y
  1. S ONCDT=0
  1. S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X"
  1. S DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN
  1. S DIR("A")=" Diagnosis Year Start: "
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. ;S (ONCDT,DIAGYR)=Y
  1. S (ONCDATE,ONCDT)=Y
  1. S ONCDT=ONCDT-1700
  1. S ONCDT11=ONCDT_"0101"
  1. S ONCDT=ONCDT_"0000"
  1. S (ONCDT,ONCLDT)=ONCDT-1
  1. ;Diagnosis Year End
  1. K DIR
  1. S DATE1=ONCDATE
  1. S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(X<ONCDATE) X"
  1. S DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN
  1. S DIR("A")=" Diagnosis Year End: "
  1. S DIR("?")=" Diagnosis Year End must be a number and greater than the Start year."
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S (ONCDATE1,DATE1)=Y
  1. S DIAGYR=ONCDATE_"-"_Y
  1. S DATE1=DATE1+1
  1. S DATE1=DATE1-1700
  1. S DATE1=DATE1_"0000"
  1. S DATE1=DATE1-1
  1. K DIR
  1. W !," Diagnosis Years: ",DIAGYR
  1. W !
  1. W !,?6,"Select one of the following:"
  1. W !
  1. W !,?11,"1 All eligible cases for this year"
  1. W !,?11,"2 Cases within a 'Date Case Last Changed' date range"
  1. W !,?11,"3 Accession Number"
  1. W !
  1. S DIR(0)="SAO^1:All cases;2:Cases within a date range;3:Accession Number"
  1. S DIR("A")=" Select extraction criterion: "
  1. S DIR("B")="All cases"
  1. S DIR("?")=" "
  1. S DIR("?",1)=" Select 'All cases' if you want to extract all"
  1. S DIR("?",2)=" of the eligible cases for this Diagnosis Year."
  1. S DIR("?",3)=""
  1. S DIR("?",4)=" Select 'Cases within a date range' if you want"
  1. S DIR("?",5)=" to specify a 'Date Case Last Changed' date range"
  1. S DIR("?",6)=" for this Diagnosis Year."
  1. S DIR("?",7)=" "
  1. S DIR("?",8)="Select 'Accession Number-Seq' if you want to specify"
  1. S DIR("?",9)="the extract by Accession Number range."
  1. D ^DIR
  1. I $D(DIRUT) S OUT=1 K DIRUT Q
  1. I Y<1 S OUT=1 Q
  1. S NCDB=Y
  1. I NCDB=2 W ! D DCLC
  1. I NCDB=3 W ! D ACCN
  1. Q
  1. ACCN ;Accession Number
  1. ;P8 modify Accession range logic.
  1. N ONCACST,ONCACEN
  1. S ONCACST=$O(^ONCO(165.5,"AA",0)),ONCACEN=$O(^ONCO(165.5,"AA",""),-1)
  1. ;S:$D(ONCDATE) ONCACST=ONCDATE_"00000" S:$D(ONCDATE1) ONCACEN=ONCDATE1_"99999"
  1. S ONCDATE=1980,ONCDATE1=2000+$E(DT,2,3) ;Patch #13
  1. S:$D(ONCDATE) ONCACST=$O(^ONCO(165.5,"AA",ONCDATE_"00000"))
  1. S:$D(ONCDATE1) ONCACEN=$O(^ONCO(165.5,"AA",ONCDATE1_"99999"),-1)
  1. K DIR
  1. S DIR("B")=ONCACST
  1. S DIR(0)="NO^"_ONCACST_":"_ONCACEN
  1. S DIR("A")="Enter the Accession Number Start "
  1. S DIR("?")="Enter a number from "_ONCACST_" to "_ONCACEN
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S (BDT,SDT)=Y
  1. K DIR
  1. S DIR("B")=ONCACEN
  1. S DIR(0)="NO^"_BDT_":"_ONCACEN
  1. S DIR("A")="Enter the Accession Number End "
  1. S DIR("?")="Enter a number from "_BDT_" to "_ONCACEN
  1. D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q
  1. S EDT=Y
  1. Q