Routine: ONCOANC0

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

NOCON S AASTYPNC="I" D LINE^ONCOANCQ Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOANC0   4742     printed  Mar 13, 2025@21:29:06                                                                                                                                                                                                    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

ONCOANC0.m