ONCOANC0 ;Hines OIFO/GWB - BUILDS DATA ARRAY FOR NCDB CALL FOR DATA ;8/21/93
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
AASMAIN S X=0 X ^%ZOSF("RM") ;disable autowrap
N AAS160,AAS165,AAS1655,AASACYR,AASAVD0,AASBLNK,AASCASE,AASD0160,AASD1,AASD1A,AASDPT,AASDTCV,AASRI,AASTAT,AASZERO,ONCOIEN
K ^TMP($J)
S AASBLNK=$J("",255),AASZERO="0000000000",MLHIX=0,AASDT=""
S AASDTCV="S:AASX'="""" AASDT=$E(AASX,4,5)_$E(AASX,6,7)_(1700+$E(AASX,1,3)) S AASX=AASDT S:AASX="""" AASX=$E(AASBLNK,1,8) S:$E(AASDT,1,2)=""00"" AASDT=99_$E(AASDT,3,8) S:$E(AASDT,3,4)=""00"" AASDT=$E(AASDT,1,2)_99_$E(AASDT,5,8) S AASX=AASDT"
S (D0,AASAVD0)=0
I '$D(AASDXH) S AASDXH=$$ASKNUM^ONCOU("Enter DAM 6-digit hospital registry ID","0:999999:0") G AASQUIT:$D(DIRUT)
S:$L(AASDXH)<6 AASDXH=$E(AASZERO,1,6-$L(AASDXH))_AASDXH
S AASRI=6_AASDXH_0
I $G(ONCOREP)!$G(ONCOREQ) G DEVQUE
D HANG^ONCOANC3
I $D(DUOUT) G AASQUIT^ONCOANC0 ; check for bailout
G AASRETN
DEVQUE ;Device/Queuing Ctrl
K IO("Q") S %ZIS="MQ" D ^%ZIS I POP S ONCOUT="" G AASQUIT
S ONCOFF="S DN=1,ONCOY="""" I $Y>(IOSL-5) R:IOST[""C-"" !!,""Press Return to Continue, '^' to escape: "",ONCOY:DTIME S:'$T ONCOY=U S:ONCOY=U ONCOUT=1,DN=0 Q:$D(ONCOUT) D:DN HEAD^ONCOANC2 K ONCOY",(PG,ONCOECNT)=0
I $D(IO("Q")) S (ZTSAVE("DIC"),ZTSAVE("AAS*"),ZTSAVE("ONCO*"),ZTSAVE("MLHIX"),ZTSAVE("PG"))="",ZTRTN="AASRETN^ONCOANC0",ZTDESC="Oncology ACOS Report" D ^%ZTLOAD K ZTSK G AASQUIT
U IO
AASRETN ;$O Thru "AY" Xref
S AASAY1=AASAY,AASAY=$E(AASAY,3,4)
S D0=0 F S D0=$O(^ONCO(165.5,"AY",AASAY1,D0)) Q:D0="" Q:$D(ONCOUT) D GET
W:'($G(ONCOREP)!($G(ONCOREQ))) !!," << Total records created: ",MLHIX," >>",!!
I ($G(ONCOREP)) W !!," << Total records reported on: ",MLHIX," >>",!!
I ($G(ONCOREQ)) W !!," << Total records reviewed: ",MLHIX," >>",!!," << Total incomplete records: ",ONCOECNT," >>",!!
G AASQUIT
GET ;main loop-proces primary
S AAS1655("N0")=$S($D(^ONCO(165.5,D0,0))#2:^(0),1:"")
S AASCASE=$P(AAS1655("N0"),U,4) I AASCASE=""!(AASCASE<0)!(AASCASE'?1N) Q
S AASACYR=$E($P(AAS1655("N0"),U,7),3,4) I AASACYR'=AASAY Q
S AAS1655("N1")=$S($D(^ONCO(165.5,D0,1))#2:^(1),1:""),AAS1655("N2")=$S($D(^ONCO(165.5,D0,2))#2:^(2),1:""),AAS1655("N3")=$S($D(^ONCO(165.5,D0,3))#2:^(3),1:"")
I $D(^ONCO(165.5,D0,4,0))#2 F AASX=0:0 S AASX=$O(^ONCO(165.5,D0,4,AASX)) Q:'AASX S AAS165("D0")=AASX
S:'$D(AAS165("D0")) AAS165("D0")=0
S AAS1655("N4")=$S($D(^ONCO(165.5,D0,4,AAS165("D0"),0))#2:^(0),1:"")
S AAS1655("N5")=$S($D(^ONCO(165.5,D0,5))#2:^(5),1:""),AAS1655("N24")=$S($D(^ONCO(165.5,D0,24))#2:^(24),1:""),AAS1655("N7")=$S($D(^ONCO(165.5,D0,7))#2:^(7),1:"")
STDIS ;Disqualifies incomplete data and data outside the abstract range for the State data Disk
S AASPP=1 I AASTYPNC="A" D I AASPP="" K AASPP Q
.S BYR("B")=$G(BYR("B")),BYR("E")=$G(BYR("E"))
.S:$P(AAS1655("N7"),U,2)'=3 AASPP=""
.S BYR("A")=$P(AAS1655("N7"),U)
.S:BYR("A")<BYR("B")!(BYR("A")>BYR("E")) AASPP=""
K AASPP
S AASD0160=$P(AAS1655("N0"),U,2) S:AASD0160'?.6N AASD0160=0
S AAS160("N0")=$S($D(^ONCO(160,AASD0160,0))#2:^(0),1:"")
I $D(^ONCO(160,AASD0160,"F",0))#2 F AASD1=0:0 S AASD1=$O(^ONCO(160,AASD0160,"F",AASD1)) Q:'AASD1 S AASD1A=AASD1
S:'$D(AASD1A) AASD1A=0
S AAS160("NF")=$S($D(^ONCO(160,AASD0160,"F",AASD1A,0))#2:^(0),1:""),AAS160("N1")=$S($D(^ONCO(160,AASD0160,1))#2:^(1),1:"")
S:D0'=AASD0160 AASAVD0=D0,D0=AASD0160
D SETUP^ONCOES S AASDPT=@ONCOX1
;D ST^ONCOES S AASTAT=$S(X="":" ",1:X)
S:AASAVD0>0 D0=AASAVD0,AASAVD0=0
AASRL ;NCDB REC LAYOUT
; RECORD TYPE = I REGISTRY TYPE = 3
D PID^ONCOCOP ; PATIENT ID = 1ST LETTER OF LAST NAME+4DIGITS OF SSN*
S:$L(X)<8 X=X_$E(AASZERO,1,8-$L(X)) S ^TMP($J,D0,76)=AASTYPNC_X_3_AASRI
D:AASTYPNC="A" NAME^ONCOANC4
AASDXAD ;POSTAL CODE AT DIAGNOSIS, COUNTY AT DIAGNOSIS, STATE AT DIAGNOSIS,
;CITY/TOWN AT DIAGNOSIS
S AASZIP=$P(AAS1655("N1"),U,2)
S:$L(AASZIP)<9 AASZIP=AASZIP_$E(AASBLNK,1,9-$L(AASZIP))
S AASCNTY=$G(^VIC(5.1,+$P(AAS1655("N1"),U,3),0))
S AASCNTY=+$P(AASCNTY,U,3)
S AASCNTY=$S((AASCNTY>0):AASCNTY,1:999)
S AASCNTY="T"_$E(AASZERO,1,3-$L(AASCNTY))_AASCNTY
S AASTAT=$P(AAS1655("N1"),U,4)
S AASTAT=$S(AASTAT="":" ",1:$P(^ONCO(160.15,AASTAT,0),U,1))
S AASCITY=$P(AAS1655("N1"),U,12) S:AASCITY="" AASCITY="CITY UNKNOWN"
S:$L(AASCITY)<20 AASCITY=AASCITY_$E(AASBLNK,1,20-$L(AASCITY))
S AASCITY=$E(AASCITY,1,20)
S ^TMP($J,D0,76)=^TMP($J,D0,76)_AASCITY_AASTAT_$E(AASCNTY,2,4)_AASZIP_$E(AASBLNK,1,7)
S AASMS=$S(AAS1655("N1")'="":$P(AAS1655("N1"),U,5),1:"")
I AASMS=""!(AASMS<1)!(AASMS>9)!(AASMS>5&(AASMS<9)) S AASMS=" "
D RSAR^ONCOANC4 ;RACE,SEX,AGE,RELIGION
G AASTUM^ONCOANC2
AASQUIT D ^%ZISC
D CLEANUP^ONCOANC9
Q
NOCON S AASTYPNC="I" D LINE^ONCOANCQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOANC0 4742 printed Apr 09, 2024@21:27:33 Page 2
ONCOANC0 ;Hines OIFO/GWB - BUILDS DATA ARRAY FOR NCDB CALL FOR DATA ;8/21/93
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
AASMAIN ;disable autowrap
SET X=0
XECUTE ^%ZOSF("RM")
+1 NEW AAS160,AAS165,AAS1655,AASACYR,AASAVD0,AASBLNK,AASCASE,AASD0160,AASD1,AASD1A,AASDPT,AASDTCV,AASRI,AASTAT,AASZERO,ONCOIEN
+2 KILL ^TMP($JOB)
+3 SET AASBLNK=$JUSTIFY("",255)
SET AASZERO="0000000000"
SET MLHIX=0
SET AASDT=""
+4 SET AASDTCV="S:AASX'="""" AASDT=$E(AASX,4,5)_$E(AASX,6,7)_(1700+$E(AASX,1,3)) S AASX=AASDT S:AASX="""" AASX=$E(AASBLNK,1,8) S:$E(AASDT,1,2)=""00"" AASDT=99_$E(AASDT,3,8) S:$E(AASDT,3,4)=""00"" AASDT=$E(AASDT,1,2)_99_$E(AASDT,5,8) S AASX=AASDT"
+5 SET (D0,AASAVD0)=0
+6 IF '$DATA(AASDXH)
SET AASDXH=$$ASKNUM^ONCOU("Enter DAM 6-digit hospital registry ID","0:999999:0")
if $DATA(DIRUT)
GOTO AASQUIT
+7 if $LENGTH(AASDXH)<6
SET AASDXH=$EXTRACT(AASZERO,1,6-$LENGTH(AASDXH))_AASDXH
+8 SET AASRI=6_AASDXH_0
+9 IF $GET(ONCOREP)!$GET(ONCOREQ)
GOTO DEVQUE
+10 DO HANG^ONCOANC3
+11 ; check for bailout
IF $DATA(DUOUT)
GOTO AASQUIT^ONCOANC0
+12 GOTO AASRETN
DEVQUE ;Device/Queuing Ctrl
+1 KILL IO("Q")
SET %ZIS="MQ"
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO AASQUIT
+2 SET ONCOFF="S DN=1,ONCOY="""" I $Y>(IOSL-5) R:IOST[""C-"" !!,""Press Return to Continue, '^' to escape: "",ONCOY:DTIME S:'$T ONCOY=U S:ONCOY=U ONCOUT=1,DN=0 Q:$D(ONCOUT) D:DN HEAD^ONCOANC2 K ONCOY"
SET (PG,ONCOECNT)=0
+3 IF $DATA(IO("Q"))
SET (ZTSAVE("DIC"),ZTSAVE("AAS*"),ZTSAVE("ONCO*"),ZTSAVE("MLHIX"),ZTSAVE("PG"))=""
SET ZTRTN="AASRETN^ONCOANC0"
SET ZTDESC="Oncology ACOS Report"
DO ^%ZTLOAD
KILL ZTSK
GOTO AASQUIT
+4 USE IO
AASRETN ;$O Thru "AY" Xref
+1 SET AASAY1=AASAY
SET AASAY=$EXTRACT(AASAY,3,4)
+2 SET D0=0
FOR
SET D0=$ORDER(^ONCO(165.5,"AY",AASAY1,D0))
if D0=""
QUIT
if $DATA(ONCOUT)
QUIT
DO GET
+3 if '($GET(ONCOREP)!($GET(ONCOREQ)))
WRITE !!," << Total records created: ",MLHIX," >>",!!
+4 IF ($GET(ONCOREP))
WRITE !!," << Total records reported on: ",MLHIX," >>",!!
+5 IF ($GET(ONCOREQ))
WRITE !!," << Total records reviewed: ",MLHIX," >>",!!," << Total incomplete records: ",ONCOECNT," >>",!!
+6 GOTO AASQUIT
GET ;main loop-proces primary
+1 SET AAS1655("N0")=$SELECT($DATA(^ONCO(165.5,D0,0))#2:^(0),1:"")
+2 SET AASCASE=$PIECE(AAS1655("N0"),U,4)
IF AASCASE=""!(AASCASE<0)!(AASCASE'?1N)
QUIT
+3 SET AASACYR=$EXTRACT($PIECE(AAS1655("N0"),U,7),3,4)
IF AASACYR'=AASAY
QUIT
+4 SET AAS1655("N1")=$SELECT($DATA(^ONCO(165.5,D0,1))#2:^(1),1:"")
SET AAS1655("N2")=$SELECT($DATA(^ONCO(165.5,D0,2))#2:^(2),1:"")
SET AAS1655("N3")=$SELECT($DATA(^ONCO(165.5,D0,3))#2:^(3),1:"")
+5 IF $DATA(^ONCO(165.5,D0,4,0))#2
FOR AASX=0:0
SET AASX=$ORDER(^ONCO(165.5,D0,4,AASX))
if 'AASX
QUIT
SET AAS165("D0")=AASX
+6 if '$DATA(AAS165("D0"))
SET AAS165("D0")=0
+7 SET AAS1655("N4")=$SELECT($DATA(^ONCO(165.5,D0,4,AAS165("D0"),0))#2:^(0),1:"")
+8 SET AAS1655("N5")=$SELECT($DATA(^ONCO(165.5,D0,5))#2:^(5),1:"")
SET AAS1655("N24")=$SELECT($DATA(^ONCO(165.5,D0,24))#2:^(24),1:"")
SET AAS1655("N7")=$SELECT($DATA(^ONCO(165.5,D0,7))#2:^(7),1:"")
STDIS ;Disqualifies incomplete data and data outside the abstract range for the State data Disk
+1 SET AASPP=1
IF AASTYPNC="A"
Begin DoDot:1
+2 SET BYR("B")=$GET(BYR("B"))
SET BYR("E")=$GET(BYR("E"))
+3 if $PIECE(AAS1655("N7"),U,2)'=3
SET AASPP=""
+4 SET BYR("A")=$PIECE(AAS1655("N7"),U)
+5 if BYR("A")<BYR("B")!(BYR("A")>BYR("E"))
SET AASPP=""
End DoDot:1
IF AASPP=""
KILL AASPP
QUIT
+6 KILL AASPP
+7 SET AASD0160=$PIECE(AAS1655("N0"),U,2)
if AASD0160'?.6N
SET AASD0160=0
+8 SET AAS160("N0")=$SELECT($DATA(^ONCO(160,AASD0160,0))#2:^(0),1:"")
+9 IF $DATA(^ONCO(160,AASD0160,"F",0))#2
FOR AASD1=0:0
SET AASD1=$ORDER(^ONCO(160,AASD0160,"F",AASD1))
if 'AASD1
QUIT
SET AASD1A=AASD1
+10 if '$DATA(AASD1A)
SET AASD1A=0
+11 SET AAS160("NF")=$SELECT($DATA(^ONCO(160,AASD0160,"F",AASD1A,0))#2:^(0),1:"")
SET AAS160("N1")=$SELECT($DATA(^ONCO(160,AASD0160,1))#2:^(1),1:"")
+12 if D0'=AASD0160
SET AASAVD0=D0
SET D0=AASD0160
+13 DO SETUP^ONCOES
SET AASDPT=@ONCOX1
+14 ;D ST^ONCOES S AASTAT=$S(X="":" ",1:X)
+15 if AASAVD0>0
SET D0=AASAVD0
SET AASAVD0=0
AASRL ;NCDB REC LAYOUT
+1 ; RECORD TYPE = I REGISTRY TYPE = 3
+2 ; PATIENT ID = 1ST LETTER OF LAST NAME+4DIGITS OF SSN*
DO PID^ONCOCOP
+3 if $LENGTH(X)<8
SET X=X_$EXTRACT(AASZERO,1,8-$LENGTH(X))
SET ^TMP($JOB,D0,76)=AASTYPNC_X_3_AASRI
+4 if AASTYPNC="A"
DO NAME^ONCOANC4
AASDXAD ;POSTAL CODE AT DIAGNOSIS, COUNTY AT DIAGNOSIS, STATE AT DIAGNOSIS,
+1 ;CITY/TOWN AT DIAGNOSIS
+2 SET AASZIP=$PIECE(AAS1655("N1"),U,2)
+3 if $LENGTH(AASZIP)<9
SET AASZIP=AASZIP_$EXTRACT(AASBLNK,1,9-$LENGTH(AASZIP))
+4 SET AASCNTY=$GET(^VIC(5.1,+$PIECE(AAS1655("N1"),U,3),0))
+5 SET AASCNTY=+$PIECE(AASCNTY,U,3)
+6 SET AASCNTY=$SELECT((AASCNTY>0):AASCNTY,1:999)
+7 SET AASCNTY="T"_$EXTRACT(AASZERO,1,3-$LENGTH(AASCNTY))_AASCNTY
+8 SET AASTAT=$PIECE(AAS1655("N1"),U,4)
+9 SET AASTAT=$SELECT(AASTAT="":" ",1:$PIECE(^ONCO(160.15,AASTAT,0),U,1))
+10 SET AASCITY=$PIECE(AAS1655("N1"),U,12)
if AASCITY=""
SET AASCITY="CITY UNKNOWN"
+11 if $LENGTH(AASCITY)<20
SET AASCITY=AASCITY_$EXTRACT(AASBLNK,1,20-$LENGTH(AASCITY))
+12 SET AASCITY=$EXTRACT(AASCITY,1,20)
+13 SET ^TMP($JOB,D0,76)=^TMP($JOB,D0,76)_AASCITY_AASTAT_$EXTRACT(AASCNTY,2,4)_AASZIP_$EXTRACT(AASBLNK,1,7)
+14 SET AASMS=$SELECT(AAS1655("N1")'="":$PIECE(AAS1655("N1"),U,5),1:"")
+15 IF AASMS=""!(AASMS<1)!(AASMS>9)!(AASMS>5&(AASMS<9))
SET AASMS=" "
+16 ;RACE,SEX,AGE,RELIGION
DO RSAR^ONCOANC4
+17 GOTO AASTUM^ONCOANC2
AASQUIT DO ^%ZISC
+1 DO CLEANUP^ONCOANC9
+2 QUIT
NOCON SET AASTYPNC="I"
DO LINE^ONCOANCQ
QUIT
