EMERGENCY Released ONC*2.2*8 SEQ #5 Extracted from mail message **KIDS**:ONC*2.2*8^ **INSTALL NAME** ONC*2.2*8 "BLD",9806,0) ONC*2.2*8^ONCOLOGY^0^3170110^y "BLD",9806,1,0) ^^2^2^3161027^ "BLD",9806,1,1,0) Emergency patch for TNM Clinical and Pathologic data fields. Primaries "BLD",9806,1,2,0) with a BLANK TNM data fields are included in RQRS Extract. "BLD",9806,4,0) ^9.64PA^^ "BLD",9806,6) 2^ "BLD",9806,6.3) 3 "BLD",9806,"KRN",0) ^9.67PA^779.2^20 "BLD",9806,"KRN",.4,0) .4 "BLD",9806,"KRN",.401,0) .401 "BLD",9806,"KRN",.402,0) .402 "BLD",9806,"KRN",.403,0) .403 "BLD",9806,"KRN",.5,0) .5 "BLD",9806,"KRN",.84,0) .84 "BLD",9806,"KRN",3.6,0) 3.6 "BLD",9806,"KRN",3.8,0) 3.8 "BLD",9806,"KRN",9.2,0) 9.2 "BLD",9806,"KRN",9.8,0) 9.8 "BLD",9806,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",9806,"KRN",9.8,"NM",1,0) ONCODIS^^0^B774218 "BLD",9806,"KRN",9.8,"NM",2,0) ONCACD1^^0^B68896487 "BLD",9806,"KRN",9.8,"NM",3,0) ONCACD0^^0^B183791801 "BLD",9806,"KRN",9.8,"NM","B","ONCACD0",3) "BLD",9806,"KRN",9.8,"NM","B","ONCACD1",2) "BLD",9806,"KRN",9.8,"NM","B","ONCODIS",1) "BLD",9806,"KRN",19,0) 19 "BLD",9806,"KRN",19.1,0) 19.1 "BLD",9806,"KRN",101,0) 101 "BLD",9806,"KRN",409.61,0) 409.61 "BLD",9806,"KRN",771,0) 771 "BLD",9806,"KRN",779.2,0) 779.2 "BLD",9806,"KRN",870,0) 870 "BLD",9806,"KRN",8989.51,0) 8989.51 "BLD",9806,"KRN",8989.52,0) 8989.52 "BLD",9806,"KRN",8994,0) 8994 "BLD",9806,"KRN","B",.4,.4) "BLD",9806,"KRN","B",.401,.401) "BLD",9806,"KRN","B",.402,.402) "BLD",9806,"KRN","B",.403,.403) "BLD",9806,"KRN","B",.5,.5) "BLD",9806,"KRN","B",.84,.84) "BLD",9806,"KRN","B",3.6,3.6) "BLD",9806,"KRN","B",3.8,3.8) "BLD",9806,"KRN","B",9.2,9.2) "BLD",9806,"KRN","B",9.8,9.8) "BLD",9806,"KRN","B",19,19) "BLD",9806,"KRN","B",19.1,19.1) "BLD",9806,"KRN","B",101,101) "BLD",9806,"KRN","B",409.61,409.61) "BLD",9806,"KRN","B",771,771) "BLD",9806,"KRN","B",779.2,779.2) "BLD",9806,"KRN","B",870,870) "BLD",9806,"KRN","B",8989.51,8989.51) "BLD",9806,"KRN","B",8989.52,8989.52) "BLD",9806,"KRN","B",8994,8994) "BLD",9806,"QUES",0) ^9.62^^ "BLD",9806,"REQB",0) ^9.611^1^1 "BLD",9806,"REQB",1,0) ONC*2.2*5^2 "BLD",9806,"REQB","B","ONC*2.2*5",1) "MBREQ") 0 "PKG",14,-1) 1^1 "PKG",14,0) ONCOLOGY^ONC^Oncology treatment tracking & tumor registry package. "PKG",14,20,0) ^9.402P^^ "PKG",14,22,0) ^9.49I^1^1 "PKG",14,22,1,0) 2.2 "PKG",14,22,1,"PAH",1,0) 8^3170110^28 "PKG",14,22,1,"PAH",1,1,0) ^^2^2^3170110 "PKG",14,22,1,"PAH",1,1,1,0) Emergency patch for TNM Clinical and Pathologic data fields. Primaries "PKG",14,22,1,"PAH",1,1,2,0) with a BLANK TNM data fields are included in RQRS Extract. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","ONCACD0") 0^3^B183791801^B184758090 "RTN","ONCACD0",1,0) ONCACD0 ;Hines OIFO/GWB - NAACCR extract driver ;09/22/11 "RTN","ONCACD0",2,0) ;;2.2;ONCOLOGY;**1,4,5,8**;Jul 31, 2013;Build 3 "RTN","ONCACD0",3,0) ; "RTN","ONCACD0",4,0) EN1(DEVICE,STEXT) ;Entry point "RTN","ONCACD0",5,0) EN2 N ACO,BDT,DATE,DIAGYR,EDT,EXTRACT,NCDB,ONCSPIEN,QUEUE,SDT,STAT,STAT1,STAT2,YESNO,DATE1,ONCDATE,ONCDT,ONCLDT "RTN","ONCACD0",6,0) N ACCN,ONCDT11,ONCDATE1,SCREEN,CYR,ONC91AS,PTR,CLASSOFCASE,ONCPHI,ONCCLCA,ONCR12 "RTN","ONCACD0",7,0) K ^TMP($J),RQRS "RTN","ONCACD0",8,0) S DEVICE=$G(DEVICE,0),STEXT=$G(STEXT,0),EXT="" "RTN","ONCACD0",9,0) S (EDT,EXTRACT,DATE,OUT,QUEUE,SDT,STAT,ONCDT)=0 "RTN","ONCACD0",10,0) ;P2.2*4 "RTN","ONCACD0",11,0) W ! "RTN","ONCACD0",12,0) S DIR("A")=" Exclude PHI COMORBIDITY codes: " "RTN","ONCACD0",13,0) S DIR("B")="YES",DIR(0)="Y" "RTN","ONCACD0",14,0) S DIR("?")=" " "RTN","ONCACD0",15,0) S DIR("?",1)=" Answer 'YES' if you want to exclude PHI COMORBIDITY codes." "RTN","ONCACD0",16,0) S DIR("?",2)=" Answer 'NO' if you want to include PHI COMORBIDITY codes." "RTN","ONCACD0",17,0) D ^DIR "RTN","ONCACD0",18,0) I $D(DIRUT) S OUT=1 K DIRUT Q "RTN","ONCACD0",19,0) S ONCPHI=Y "RTN","ONCACD0",20,0) ; "RTN","ONCACD0",21,0) I (STEXT=0)!(STEXT=2)!(STEXT=3) S EXTRACT=$O(^ONCO(160.16,"B","NCDB EXTRACT V15.0",0)) "RTN","ONCACD0",22,0) I STEXT=1 D GETREC(.EXTRACT,.OUT) "RTN","ONCACD0",23,0) I 'OUT S STAT=$$GETHOSP "RTN","ONCACD0",24,0) I 'STAT S OUT=1 "RTN","ONCACD0",25,0) I 'OUT S STAT1=$P(STAT,U,1),STAT2=$P(STAT,U,2) "RTN","ONCACD0",26,0) I 'OUT D GETDATE(.DATE,.DATE1,.OUT) "RTN","ONCACD0",27,0) I 'OUT,STEXT=1 D GETDT(.SDT,.EDT,DATE,.OUT) "RTN","ONCACD0",28,0) I 'OUT,STEXT=3 D RQRS(.SDT,.EDT,DATE,.OUT) S RQRS=1 "RTN","ONCACD0",29,0) I 'OUT D VERIFY(STAT,DATE,SDT,EDT,STEXT,.YESNO,.OUT) "RTN","ONCACD0",30,0) I 'OUT G:'YESNO EN2 "RTN","ONCACD0",31,0) I 'OUT D DEVICE(DEVICE,.OUT) "RTN","ONCACD0",32,0) I 'OUT D:'QUEUE PRINT(DEVICE,.OUT) "RTN","ONCACD0",33,0) D EXIT "RTN","ONCACD0",34,0) Q "RTN","ONCACD0",35,0) ; "RTN","ONCACD0",36,0) GETREC(EXTRACT,OUT) ;Select VACCR or STATE record layout "RTN","ONCACD0",37,0) W !!," Available record layouts:",! "RTN","ONCACD0",38,0) W !," 1) VACCR Record Layout v15.0 (VA Registry)" "RTN","ONCACD0",39,0) W !," 2) NAACCR State Record Layout v15.0" "RTN","ONCACD0",40,0) W ! "RTN","ONCACD0",41,0) N DIR,X,Y "RTN","ONCACD0",42,0) S DIR(0)="SAO^1:VACCR Record Layout v15.0;2:NAACCR State Record Layout v15.0" "RTN","ONCACD0",43,0) S DIR("A")=" Select record layout: " "RTN","ONCACD0",44,0) S DIR("?")="Select the record layout to use" "RTN","ONCACD0",45,0) D ^DIR "RTN","ONCACD0",46,0) I $D(DIRUT) S OUT=1 K DIRUT Q "RTN","ONCACD0",47,0) I +Y<1 S OUT=1 Q "RTN","ONCACD0",48,0) I Y=1 S EXT="VACCR",EXTRACT=$O(^ONCO(160.16,"B","VACCR EXTRACT V15.0",0)) "RTN","ONCACD0",49,0) I Y=2 S EXT="STATE",EXTRACT=$O(^ONCO(160.16,"B","STATE EXTRACT V15.0",0)) "RTN","ONCACD0",50,0) Q "RTN","ONCACD0",51,0) ; "RTN","ONCACD0",52,0) GETHOSP() ;Facility Identification Number (FIN) "RTN","ONCACD0",53,0) N STAT,STATI,ALLOK "RTN","ONCACD0",54,0) S STAT=0,ALLOK=$$GETDXH(.STAT) "RTN","ONCACD0",55,0) I STAT S STATI=6_STAT_0,STAT=STAT_"^"_STATI "RTN","ONCACD0",56,0) Q STAT "RTN","ONCACD0",57,0) ; "RTN","ONCACD0",58,0) GETDXH(DXH) ;INSTITUTION ID NUMBER (160.1,27) "RTN","ONCACD0",59,0) N OKHERE,DIE,DA,DR,ONCOL "RTN","ONCACD0",60,0) W ! "RTN","ONCACD0",61,0) S DIE=160.1 "RTN","ONCACD0",62,0) S DA=$O(^ONCO(160.1,"C",DUZ(2),0)) "RTN","ONCACD0",63,0) I DA="" S DA=$O(^ONCO(160.1,0)) "RTN","ONCACD0",64,0) S ONCSPIEN=DA "RTN","ONCACD0",65,0) S DR=27_$J("",1)_"Facility Identification Number (FIN)" "RTN","ONCACD0",66,0) S ONCOL=0 "RTN","ONCACD0",67,0) L +^ONCO(160.1,DA):0 I $T D ^DIE L -^ONCO(160.1,DA) S ONCOL=1 "RTN","ONCACD0",68,0) I 'ONCOL W !,"This ONCOLOGY SITE PARAMETERS record is being edited by another user." "RTN","ONCACD0",69,0) K ONCOL,DIE "RTN","ONCACD0",70,0) I $D(Y)=0 S DXH=$$GET1^DIQ(160.19,X,.01,"I") "RTN","ONCACD0",71,0) I X'="" S ACDSTATE=$P($G(^ONCO(160.19,X,0)),U,4) "RTN","ONCACD0",72,0) S OKHERE=($D(Y)=0) "RTN","ONCACD0",73,0) Q OKHERE "RTN","ONCACD0",74,0) ; "RTN","ONCACD0",75,0) RQRS(SDT,EDT,DATE,OUT) ;Process RQRS data "RTN","ONCACD0",76,0) ; "RTN","ONCACD0",77,0) W ! "RTN","ONCACD0",78,0) S ONCR12=0 "RTN","ONCACD0",79,0) K DIR "RTN","ONCACD0",80,0) S DIR(0)="SAO^1:COLON, RECTUM and BREAST only;2:All Analytic Cases only" "RTN","ONCACD0",81,0) S DIR("A")=" Select cases for inclusion: " "RTN","ONCACD0",82,0) S DIR("?")="Select cases or primaries for RQRS download" "RTN","ONCACD0",83,0) D ^DIR "RTN","ONCACD0",84,0) I $D(DIRUT) S OUT=1 K DIRUT Q "RTN","ONCACD0",85,0) I Y<1 S OUT=1 Q "RTN","ONCACD0",86,0) S ONCR12=Y "RTN","ONCACD0",87,0) W ! "RTN","ONCACD0",88,0) ; "RTN","ONCACD0",89,0) K DIR "RTN","ONCACD0",90,0) S DIR(0)="SAO^1:Date DX;2:Date Case Last Changed;3:Accession Number" "RTN","ONCACD0",91,0) S DIR("A")=" Select date field to be used for Start/End range: " "RTN","ONCACD0",92,0) S DIR("?")="Select the date field you wish to use for this download's Start/End range prompts." "RTN","ONCACD0",93,0) D ^DIR "RTN","ONCACD0",94,0) I $D(DIRUT) S OUT=1 K DIRUT Q "RTN","ONCACD0",95,0) I Y<1 S OUT=1 Q "RTN","ONCACD0",96,0) S (NCDB,ONCLDT)=Y "RTN","ONCACD0",97,0) K DIR "RTN","ONCACD0",98,0) S ONCDT11=3080101 "RTN","ONCACD0",99,0) I $G(ONCLDT)=3 D ACCN Q "RTN","ONCACD0",100,0) ;S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X" "RTN","ONCACD0",101,0) S DIR(0)="DO^3080101:"_DT_":EP" "RTN","ONCACD0",102,0) ;S DIR("B")=$E(ONCDT11,4,5)_"/"_$E(ONCDT11,6,7)_"/"_$E(ONCDT11,2,3) "RTN","ONCACD0",103,0) I $G(ONCLDT)=1 D "RTN","ONCACD0",104,0) .S DIR("A")=" Start, Date DX: " "RTN","ONCACD0",105,0) .S DIR("?",1)=" Enter the DATE of Diagnosis of the" "RTN","ONCACD0",106,0) .S DIR("?",2)=" FIRST abstract you would like to report." "RTN","ONCACD0",107,0) I $G(ONCLDT)=2 D "RTN","ONCACD0",108,0) .S DIR("A")=" Start, Date Case Last Changed: " "RTN","ONCACD0",109,0) .S DIR("?",1)=" Enter the DATE CASE LAST CHANGED of the" "RTN","ONCACD0",110,0) .S DIR("?",2)=" FIRST abstract you would like to report." "RTN","ONCACD0",111,0) D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q "RTN","ONCACD0",112,0) S SDT=Y "RTN","ONCACD0",113,0) I $E(SDT,4,7)="0000" S SDT=$E(SDT,1,3)_"0101" "RTN","ONCACD0",114,0) K DIR "RTN","ONCACD0",115,0) S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(XCYR)!(XCYR)!(XCYR X" "RTN","ONCACD0",195,0) ;S DIR(0)="DO^3000101:"_DT_":EP" "RTN","ONCACD0",196,0) ;S DIR(0)="D^::X" "RTN","ONCACD0",197,0) S DIR("A")=" Start, Date Dx: " "RTN","ONCACD0",198,0) S DIR("?",1)=" Enter the DATE DX of the FIRST" "RTN","ONCACD0",199,0) S DIR("?",2)=" abstract you would like to report." "RTN","ONCACD0",200,0) D ^DIR I $D(DIRUT) S OUT=1 K DIRUT Q "RTN","ONCACD0",201,0) S (SDT,BDT)=Y "RTN","ONCACD0",202,0) K DIR "RTN","ONCACD0",203,0) S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(X0 "RTN","ONCACD0",313,0) N CYR,DIR,SCREEN,Y "RTN","ONCACD0",314,0) S ONCDT=0 "RTN","ONCACD0",315,0) S CYR=1700+($E(DT,1,3)),SCREEN="K:X>CYR X" "RTN","ONCACD0",316,0) S DIR(0)="NAO^1900:"_CYR_":0^"_SCREEN "RTN","ONCACD0",317,0) S DIR("A")=" Diagnosis Year Start: " "RTN","ONCACD0",318,0) D ^DIR "RTN","ONCACD0",319,0) I $D(DIRUT) S OUT=1 K DIRUT Q "RTN","ONCACD0",320,0) ;S (ONCDT,DIAGYR)=Y "RTN","ONCACD0",321,0) S (ONCDATE,ONCDT)=Y "RTN","ONCACD0",322,0) S ONCDT=ONCDT-1700 "RTN","ONCACD0",323,0) S ONCDT11=ONCDT_"0101" "RTN","ONCACD0",324,0) S ONCDT=ONCDT_"0000" "RTN","ONCACD0",325,0) S (ONCDT,ONCLDT)=ONCDT-1 "RTN","ONCACD0",326,0) ;Diagnosis Year End "RTN","ONCACD0",327,0) K DIR "RTN","ONCACD0",328,0) S DATE1=ONCDATE "RTN","ONCACD0",329,0) S CYR=1700+($E(DT,1,3)),SCREEN="K:(X>CYR)!(XDATE1)!(ONCDT="") S IEN=0 F S IEN=$O(^ONCO(165.5,"ADX",ONCDT,IEN)) Q:IEN="" I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",27,0) .I $G(NCDB)=2 S DCLC=$P($G(^ONCO(165.5,IEN,7)),U,21) Q:(DCLCEDT) "RTN","ONCACD1",28,0) .I $G(NCDB)=3 S ACCN=$P($G(^ONCO(165.5,IEN,0)),U,5) Q:(ACCNEDT) "RTN","ONCACD1",29,0) .D LOOP "RTN","ONCACD1",30,0) ; "RTN","ONCACD1",31,0) ;VACCR/STATE EXTRACT "RTN","ONCACD1",32,0) ;Loop through DATE CASE COMPLETED (165.5,90) "AAD" cross-reference "RTN","ONCACD1",33,0) I STEXT=1,($G(ONCLDT)=1) S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AAD",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AAD",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",34,0) .Q:$G(^ONCO(165.5,IEN,0))="" "RTN","ONCACD1",35,0) .D LOOP "RTN","ONCACD1",36,0) ;Loop through DATE CASE LAST CHANGED (165.5,198) "AAE" cross-reference "RTN","ONCACD1",37,0) I STEXT=1,($G(ONCLDT)=2) S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AAE",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AAE",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",38,0) .Q:$G(^ONCO(165.5,IEN,0))="" "RTN","ONCACD1",39,0) .D LOOP "RTN","ONCACD1",40,0) ;Loop through ACCESSION NUMBER (165.5,.05) "AA" cross-reference "RTN","ONCACD1",41,0) I STEXT=1,($G(ONCLDT)=3) S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AA",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AA",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",42,0) .Q:$G(^ONCO(165.5,IEN,0))="" "RTN","ONCACD1",43,0) .D LOOP "RTN","ONCACD1",44,0) ; "RTN","ONCACD1",45,0) ;VACCR/STATE EXTRACT "RTN","ONCACD1",46,0) ;Loop through DATE CASE LAST CHANGED (165.5,198) "AAE" cross-reference "RTN","ONCACD1",47,0) I STEXT=2 S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AAE",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AAE",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",48,0) .Q:$G(^ONCO(165.5,IEN,0))="" "RTN","ONCACD1",49,0) .D LOOP "RTN","ONCACD1",50,0) ; "RTN","ONCACD1",51,0) ;RQRS EXTRACT "RTN","ONCACD1",52,0) ;Loop through DATE DX (165.5,3) "ADX" cross-reference "RTN","ONCACD1",53,0) I STEXT=3,($G(ONCLDT)=1) S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"ADX",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"ADX",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",54,0) .Q:$G(^ONCO(165.5,IEN,0))="" "RTN","ONCACD1",55,0) .S TPG=$P($G(^ONCO(165.5,IEN,2)),U,1) "RTN","ONCACD1",56,0) .S NC=0 "RTN","ONCACD1",57,0) .F FDNUM=.03,.05,.06,3,20,22.3 I $$GET1^DIQ(165.5,IEN,FDNUM,"I")="" S NC=1 "RTN","ONCACD1",58,0) .Q:NC=1 "RTN","ONCACD1",59,0) .S ONCCLCA=$E($$GET1^DIQ(165.5,IEN,.04),1,2) "RTN","ONCACD1",60,0) .I ($G(ONCR12)=2),((ONCCLCA=0)!(ONCCLCA>0)&(ONCCLCA<23)) D LOOP Q "RTN","ONCACD1",61,0) .I ($G(ONCR12)=1),(($E(TPG,3,4)=50)!($E(TPG,3,4)=18)!($E(TPG,3,4)=20))&(TPG'=67181) D LOOP ; screen out 67181 (appendix) cases - p2.2*4 "RTN","ONCACD1",62,0) ; "RTN","ONCACD1",63,0) ;Loop through DATE CASE LAST CHANGED (165.5,198) "AAE" cross-reference "RTN","ONCACD1",64,0) ;Quit if "ADX" is before 2008 - p2.2*4 "RTN","ONCACD1",65,0) I STEXT=3,($G(ONCLDT)=2) S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AAE",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AAE",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",66,0) .Q:$G(^ONCO(165.5,IEN,0))="" "RTN","ONCACD1",67,0) .Q:$P($G(^ONCO(165.5,IEN,0)),U,16)<3080101 "RTN","ONCACD1",68,0) .S TPG=$P($G(^ONCO(165.5,IEN,2)),U,1) "RTN","ONCACD1",69,0) .S NC=0 "RTN","ONCACD1",70,0) .F FDNUM=.03,.05,.06,3,20,22.3 I $$GET1^DIQ(165.5,IEN,FDNUM,"I")="" S NC=1 "RTN","ONCACD1",71,0) .Q:NC=1 "RTN","ONCACD1",72,0) .S ONCCLCA=$E($$GET1^DIQ(165.5,IEN,.04),1,2) "RTN","ONCACD1",73,0) .I ($G(ONCR12)=2),((ONCCLCA=0)!(ONCCLCA>0)&(ONCCLCA<23)) D LOOP Q "RTN","ONCACD1",74,0) .I ($G(ONCR12)=1),($E(TPG,3,4)=50)!($E(TPG,3,4)=18)!($E(TPG,3,4)=20)&(TPG'=67181) D LOOP "RTN","ONCACD1",75,0) ; "RTN","ONCACD1",76,0) ;Loop through ACCESSION NUMBER (165.5,.05) "AA" cross-reference "RTN","ONCACD1",77,0) I STEXT=3,($G(ONCLDT)=3) S SDT=SDT-1 F S SDT=$O(^ONCO(165.5,"AA",SDT)) Q:(SDT<1)!(SDT>EDT)!(OUT=1) F S IEN=$O(^ONCO(165.5,"AA",SDT,IEN)) Q:IEN<1 I $$DIV^ONCFUNC(IEN)=DUZ(2) D Q:OUT "RTN","ONCACD1",78,0) .Q:$G(^ONCO(165.5,IEN,0))="" "RTN","ONCACD1",79,0) .Q:$P($G(^ONCO(165.5,IEN,0)),U,16)<3080101 "RTN","ONCACD1",80,0) .S TPG=$P($G(^ONCO(165.5,IEN,2)),U,1) "RTN","ONCACD1",81,0) .S NC=0 "RTN","ONCACD1",82,0) .F FDNUM=.03,.05,.06,3,20,22.3 I $$GET1^DIQ(165.5,IEN,FDNUM,"I")="" S NC=1 "RTN","ONCACD1",83,0) .Q:NC=1 "RTN","ONCACD1",84,0) .S ONCCLCA=$E($$GET1^DIQ(165.5,IEN,.04),1,2) "RTN","ONCACD1",85,0) .I ($G(ONCR12)=2),((ONCCLCA=0)!(ONCCLCA>0)&(ONCCLCA<23)) D LOOP Q "RTN","ONCACD1",86,0) .I ($G(ONCR12)=1),($E(TPG,3,4)=50)!($E(TPG,3,4)=18)!($E(TPG,3,4)=20)&(TPG'=67181) D LOOP "RTN","ONCACD1",87,0) Q "RTN","ONCACD1",88,0) ; "RTN","ONCACD1",89,0) LOOP ;Apply extract selection rules "RTN","ONCACD1",90,0) N LINE,RULES,VALID,JUMP "RTN","ONCACD1",91,0) S RULES=0 "RTN","ONCACD1",92,0) F S RULES=$O(^ONCO(160.16,EXTRACT,"RULES",RULES)) Q:RULES<1 D "RTN","ONCACD1",93,0) .S LINE=^ONCO(160.16,EXTRACT,"RULES",RULES,0) "RTN","ONCACD1",94,0) .X LINE "RTN","ONCACD1",95,0) Q:'VALID "RTN","ONCACD1",96,0) S ^TMP($J,IEN)="" "RTN","ONCACD1",97,0) D OUTPUT(IEN,EXTRACT,JUMP,.OUT) "RTN","ONCACD1",98,0) I 'DEVICE W ! "RTN","ONCACD1",99,0) Q "RTN","ONCACD1",100,0) ; "RTN","ONCACD1",101,0) OUTPUT(IEN,EXTRACT,JUMP,OUT) ;Output "RTN","ONCACD1",102,0) S ACD160=$P(^ONCO(165.5,IEN,0),U,2) "RTN","ONCACD1",103,0) I DEVICE D HEAD(IEN,.OUT) Q:OUT "RTN","ONCACD1",104,0) N POS S POS=0 "RTN","ONCACD1",105,0) F S POS=$O(^ONCO(160.16,EXTRACT,"FIELD","B",POS)) Q:POS<1 D Q:OUT "RTN","ONCACD1",106,0) .N NODE S NODE=0 "RTN","ONCACD1",107,0) .F S NODE=$O(^ONCO(160.16,EXTRACT,"FIELD","B",POS,NODE)) Q:NODE<1 D Q:OUT "RTN","ONCACD1",108,0) ..N STRING,DEFAULT,FILL,LEN "RTN","ONCACD1",109,0) ..Q:$G(^ONCO(160.16,EXTRACT,"FIELD",NODE,0))="" "RTN","ONCACD1",110,0) ..D DISPLAY(DEVICE,$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,1)_U_$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,4),.OUT) "RTN","ONCACD1",111,0) ..Q:OUT "RTN","ONCACD1",112,0) ..S LEN=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,2) "RTN","ONCACD1",113,0) ..S STRING=$TR(^ONCO(160.16,EXTRACT,"FIELD",NODE,1),"~","^") "RTN","ONCACD1",114,0) ..S DEFAULT=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,2),U,1) "RTN","ONCACD1",115,0) ..S FILL=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,3),U,1) "RTN","ONCACD1",116,0) ..D DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS) "RTN","ONCACD1",117,0) ..;========================================================= "RTN","ONCACD1",118,0) ..; This Code supports the PCE Extracts (currently disabled) "RTN","ONCACD1",119,0) ..;========================================================= "RTN","ONCACD1",120,0) ..I $G(^ONCO(160.16,EXTRACT,0))["ZZNCDB" D "RTN","ONCACD1",121,0) ...I $O(^ONCO(160.16,EXTRACT,"FIELD","B",POS))>1 Q ;QUIT if not end "RTN","ONCACD1",122,0) ...N EXTRACT,NODE,POS "RTN","ONCACD1",123,0) ...S EXTRACT=100,JUMP=0 "RTN","ONCACD1",124,0) ...;S:$D(^ONCO(165.5,"APCE","BLA",IEN)) EXTRACT=1 "RTN","ONCACD1",125,0) ...; ^==== Bladder 95,90,85 "RTN","ONCACD1",126,0) ...;S:$D(^ONCO(165.5,"APCE","THY",IEN)) EXTRACT=2 "RTN","ONCACD1",127,0) ...; ^==== Thyroid 96,91,86 "RTN","ONCACD1",128,0) ...;S:$D(^ONCO(165.5,"APCE","STS",IEN)) EXTRACT=3 "RTN","ONCACD1",129,0) ...; ^==== Soft Tissue 96,91,86 "RTN","ONCACD1",130,0) ...;S:$D(^ONCO(165.5,"APCE","COL",IEN)) EXTRACT=4 "RTN","ONCACD1",131,0) ...; ^==== Colorectal 97,92,87 "RTN","ONCACD1",132,0) ...;S:$D(^ONCO(165.5,"APCE","NHL",IEN)) EXTRACT=5 "RTN","ONCACD1",133,0) ...; ^==== Non-Hodgkins 97,92,87 "RTN","ONCACD1",134,0) ...;S:$D(^ONCO(165.5,"APCE","BRE",IEN)) EXTRACT=6 "RTN","ONCACD1",135,0) ...; ^==== Breast 98,93,88 "RTN","ONCACD1",136,0) ...;S:$D(^ONCO(165.5,"APCE","PRO2",IEN)) EXTRACT=7 "RTN","ONCACD1",137,0) ...; ^==== Prostate 98,93,88 "RTN","ONCACD1",138,0) ...;S:$D(^ONCO(165.5,"APCE","MEL",IEN)) EXTRACT=8 "RTN","ONCACD1",139,0) ...; ^==== Melanoma 99,94,89 "RTN","ONCACD1",140,0) ...;S:$D(^ONCO(165.5,"APCE","HEP",IEN)) EXTRACT=9 "RTN","ONCACD1",141,0) ...; ^==== Hepatocellular Cancers 00,95,90 "RTN","ONCACD1",142,0) ...;S:$D(^ONCO(165.5,"APCE","CNS",IEN)) EXTRACT=10 "RTN","ONCACD1",143,0) ...; ^==== Primary Intracranial/CNS Tumors 00,95,90 "RTN","ONCACD1",144,0) ...;S:$D(^ONCO(165.5,"APCE","LNG",IEN)) EXTRACT=11 "RTN","ONCACD1",145,0) ...; ^==== Lung (NSCLC) 01,96,91 "RTN","ONCACD1",146,0) ...;S:$D(^ONCO(165.5,"APCE","GAS",IEN)) EXTRACT=12 "RTN","ONCACD1",147,0) ...; ^==== Gastric Cancers 01,96,91 "RTN","ONCACD1",148,0) ...S POS=0 "RTN","ONCACD1",149,0) ...F S POS=$O(^ONCO(160.17,EXTRACT,"FIELD","B",POS)) Q:POS<1 D Q:OUT "RTN","ONCACD1",150,0) ....N NODE S NODE=0 "RTN","ONCACD1",151,0) ....F S NODE=$O(^ONCO(160.17,EXTRACT,"FIELD","B",POS,NODE)) Q:NODE<1 D Q:OUT "RTN","ONCACD1",152,0) .....N DEFAULT,FILL,LEN,STRING "RTN","ONCACD1",153,0) .....Q:$G(^ONCO(160.17,EXTRACT,"FIELD",NODE,0))="" "RTN","ONCACD1",154,0) .....D DISPLAY(DEVICE,$P(^ONCO(160.17,EXTRACT,"FIELD",NODE,0),U,1)_U_$P(^ONCO(160.17,EXTRACT,"FIELD",NODE,0),U,4),.OUT) "RTN","ONCACD1",155,0) .....Q:OUT "RTN","ONCACD1",156,0) .....S STRING=$TR(^ONCO(160.17,EXTRACT,"FIELD",NODE,1),"~","^") "RTN","ONCACD1",157,0) .....S DEFAULT=^ONCO(160.17,EXTRACT,"FIELD",NODE,2) "RTN","ONCACD1",158,0) .....S FILL=^ONCO(160.17,EXTRACT,"FIELD",NODE,3) "RTN","ONCACD1",159,0) .....S LEN=$P(^ONCO(160.17,EXTRACT,"FIELD",NODE,0),U,2) "RTN","ONCACD1",160,0) .....D DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS) "RTN","ONCACD1",161,0) Q "RTN","ONCACD1",162,0) ; "RTN","ONCACD1",163,0) HEAD(IEN,OUT) ;Preview End-of-Page "RTN","ONCACD1",164,0) N FLG "RTN","ONCACD1",165,0) I IEN=OIEN S FLG=0 "RTN","ONCACD1",166,0) I IEN'=OIEN S OIEN=IEN,FLG=1 "RTN","ONCACD1",167,0) I 'FLG Q:$Y+4IOSL D HEAD(0,.OUT) Q:OUT "RTN","ONCACD1",191,0) S COL=$P(WRITE,U,1) "RTN","ONCACD1",192,0) S COL=$S($L(COL)=1:" "_COL,$L(COL)=2:" "_COL,$L(COL)=3:" "_COL,1:COL) "RTN","ONCACD1",193,0) S ITEM=$P(WRITE,U,2),ITEM=$E(ITEM,1,45) "RTN","ONCACD1",194,0) S DOTS=(46-$L(ITEM)) "RTN","ONCACD1",195,0) W !,COL,?5,ITEM "RTN","ONCACD1",196,0) F I=1:1:DOTS W "." "RTN","ONCACD1",197,0) Q "RTN","ONCACD1",198,0) ; "RTN","ONCACD1",199,0) DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS) ;Compute extract value "RTN","ONCACD1",200,0) N ACDANS,EXIT S EXIT=0 "RTN","ONCACD1",201,0) I JUMP'="0" D "RTN","ONCACD1",202,0) .I POS<$P(JUMP,U) Q "RTN","ONCACD1",203,0) .I POS>$P(JUMP,U,2) Q "RTN","ONCACD1",204,0) .N I "RTN","ONCACD1",205,0) .S EXIT=1 "RTN","ONCACD1",206,0) .F I=1:1:LEN W BLANK "RTN","ONCACD1",207,0) Q:EXIT "RTN","ONCACD1",208,0) X STRING "RTN","ONCACD1",209,0) ; "RTN","ONCACD1",210,0) ;If value = "", extract DEFAULT value "RTN","ONCACD1",211,0) I ACDANS="" D Q "RTN","ONCACD1",212,0) .N I,X S X="" "RTN","ONCACD1",213,0) .I DEFAULT=8 D Q "RTN","ONCACD1",214,0) ..F I=1:1:LEN W DEFAULT "RTN","ONCACD1",215,0) .I @DEFAULT="09" W @DEFAULT Q "RTN","ONCACD1",216,0) .F I=1:1:LEN W @DEFAULT "RTN","ONCACD1",217,0) ; "RTN","ONCACD1",218,0) ;If value too long, truncate to LENGTH (160.161,1) "RTN","ONCACD1",219,0) ;If value too short, pad with FILL (160.161,6) "RTN","ONCACD1",220,0) I $L(ACDANS)=LEN W ACDANS Q "RTN","ONCACD1",221,0) I $L(ACDANS)>LEN W $E(ACDANS,1,LEN) Q "RTN","ONCACD1",222,0) E D Q "RTN","ONCACD1",223,0) .N JUST,STUFF,I,REM,CAL "RTN","ONCACD1",224,0) .S JUST=$P(FILL,","),STUFF=$P(FILL,",",2) "RTN","ONCACD1",225,0) .S REM=LEN-$L(ACDANS) "RTN","ONCACD1",226,0) .I JUST="R" W ACDANS "RTN","ONCACD1",227,0) .F I=1:1:REM W @STUFF "RTN","ONCACD1",228,0) .I JUST="L" W ACDANS "RTN","ONCACD1",229,0) Q "RTN","ONCACD1",230,0) ; "RTN","ONCACD1",231,0) CLEANUP ;Cleanup "RTN","ONCACD1",232,0) K DATE,EDT,NCDB,SDT,STEXT "RTN","ONCODIS") 0^1^B774218^B774104 "RTN","ONCODIS",1,0) ONCODIS ;Hines OIFO/GWB - OncoTrax Banner ;09/13/11 "RTN","ONCODIS",2,0) ;;2.2;ONCOLOGY;**1,4,7,5,8**;Jul 31, 2013;Build 3 "RTN","ONCODIS",3,0) ; "RTN","ONCODIS",4,0) MAIN ;OncoTrax Banner "RTN","ONCODIS",5,0) S RC=$$CHKVER^ONCSAPIV() "RTN","ONCODIS",6,0) D LOGO "RTN","ONCODIS",7,0) K I,RC "RTN","ONCODIS",8,0) Q "RTN","ONCODIS",9,0) ; "RTN","ONCODIS",10,0) LOGO ;Display banner "RTN","ONCODIS",11,0) W @IOF W !!!!!! F I=1:1:9 W !,?22,$P($T(DISP+I),";",3) "RTN","ONCODIS",12,0) W !!,?22,"Department of Veterans Affairs" "RTN","ONCODIS",13,0) W !?22,"OncoTraX V2.2 P8" Q "RTN","ONCODIS",14,0) DISP ; "RTN","ONCODIS",15,0) ;;VVVV VVAA "RTN","ONCODIS",16,0) ;; VVVV VVAAAA "RTN","ONCODIS",17,0) ;; VVVV VVAAAAAA "RTN","ONCODIS",18,0) ;; VVVV VVAA AAAA "RTN","ONCODIS",19,0) ;; VVVV VVAA AAAA "RTN","ONCODIS",20,0) ;; VVVV VVAA AAAA "RTN","ONCODIS",21,0) ;; VVVVVVAA AAAA "RTN","ONCODIS",22,0) ;; VVVVAA AAAAAAAAAAA "RTN","ONCODIS",23,0) ;; VVAA AAAAAAAAAAA "VER") 8.0^22.0 "BLD",9806,6) ^5 **END** **END**