source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOANC0.m@ 1397

ONCOANC0 ;Hines OIFO/GWB - BUILDS DATA ARRAY FOR NCDB CALL FOR DATA ;8/21/93
 ;;2.11;ONCOLOGY;**1,5,6,25,26**;Mar 07, 1995
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