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

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1ONCOANC0 ;Hines OIFO/GWB - BUILDS DATA ARRAY FOR NCDB CALL FOR DATA ;8/21/93
2 ;;2.11;ONCOLOGY;**1,5,6,25,26**;Mar 07, 1995
3AASMAIN S X=0 X ^%ZOSF("RM") ;disable autowrap
4 N AAS160,AAS165,AAS1655,AASACYR,AASAVD0,AASBLNK,AASCASE,AASD0160,AASD1,AASD1A,AASDPT,AASDTCV,AASRI,AASTAT,AASZERO,ONCOIEN
5 K ^TMP($J)
6 S AASBLNK=$J("",255),AASZERO="0000000000",MLHIX=0,AASDT=""
7 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"
8 S (D0,AASAVD0)=0
9 I '$D(AASDXH) S AASDXH=$$ASKNUM^ONCOU("Enter DAM 6-digit hospital registry ID","0:999999:0") G AASQUIT:$D(DIRUT)
10 S:$L(AASDXH)<6 AASDXH=$E(AASZERO,1,6-$L(AASDXH))_AASDXH
11 S AASRI=6_AASDXH_0
12 I $G(ONCOREP)!$G(ONCOREQ) G DEVQUE
13 D HANG^ONCOANC3
14 I $D(DUOUT) G AASQUIT^ONCOANC0 ; check for bailout
15 G AASRETN
16DEVQUE ;Device/Queuing Ctrl
17 K IO("Q") S %ZIS="MQ" D ^%ZIS I POP S ONCOUT="" G AASQUIT
18 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
19 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
20 U IO
21AASRETN ;$O Thru "AY" Xref
22 S AASAY1=AASAY,AASAY=$E(AASAY,3,4)
23 S D0=0 F S D0=$O(^ONCO(165.5,"AY",AASAY1,D0)) Q:D0="" Q:$D(ONCOUT) D GET
24 W:'($G(ONCOREP)!($G(ONCOREQ))) !!," << Total records created: ",MLHIX," >>",!!
25 I ($G(ONCOREP)) W !!," << Total records reported on: ",MLHIX," >>",!!
26 I ($G(ONCOREQ)) W !!," << Total records reviewed: ",MLHIX," >>",!!," << Total incomplete records: ",ONCOECNT," >>",!!
27 G AASQUIT
28GET ;main loop-proces primary
29 S AAS1655("N0")=$S($D(^ONCO(165.5,D0,0))#2:^(0),1:"")
30 S AASCASE=$P(AAS1655("N0"),U,4) I AASCASE=""!(AASCASE<0)!(AASCASE'?1N) Q
31 S AASACYR=$E($P(AAS1655("N0"),U,7),3,4) I AASACYR'=AASAY Q
32 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:"")
33 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
34 S:'$D(AAS165("D0")) AAS165("D0")=0
35 S AAS1655("N4")=$S($D(^ONCO(165.5,D0,4,AAS165("D0"),0))#2:^(0),1:"")
36 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:"")
37STDIS ;Disqualifies incomplete data and data outside the abstract range for the State data Disk
38 S AASPP=1 I AASTYPNC="A" D I AASPP="" K AASPP Q
39 .S BYR("B")=$G(BYR("B")),BYR("E")=$G(BYR("E"))
40 .S:$P(AAS1655("N7"),U,2)'=3 AASPP=""
41 .S BYR("A")=$P(AAS1655("N7"),U)
42 .S:BYR("A")<BYR("B")!(BYR("A")>BYR("E")) AASPP=""
43 K AASPP
44 S AASD0160=$P(AAS1655("N0"),U,2) S:AASD0160'?.6N AASD0160=0
45 S AAS160("N0")=$S($D(^ONCO(160,AASD0160,0))#2:^(0),1:"")
46 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
47 S:'$D(AASD1A) AASD1A=0
48 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:"")
49 S:D0'=AASD0160 AASAVD0=D0,D0=AASD0160
50 D SETUP^ONCOES S AASDPT=@ONCOX1
51 ;D ST^ONCOES S AASTAT=$S(X="":" ",1:X)
52 S:AASAVD0>0 D0=AASAVD0,AASAVD0=0
53AASRL ;NCDB REC LAYOUT
54 ; RECORD TYPE = I REGISTRY TYPE = 3
55 D PID^ONCOCOP ; PATIENT ID = 1ST LETTER OF LAST NAME+4DIGITS OF SSN*
56 S:$L(X)<8 X=X_$E(AASZERO,1,8-$L(X)) S ^TMP($J,D0,76)=AASTYPNC_X_3_AASRI
57 D:AASTYPNC="A" NAME^ONCOANC4
58AASDXAD ;POSTAL CODE AT DIAGNOSIS, COUNTY AT DIAGNOSIS, STATE AT DIAGNOSIS,
59 ;CITY/TOWN AT DIAGNOSIS
60 S AASZIP=$P(AAS1655("N1"),U,2)
61 S:$L(AASZIP)<9 AASZIP=AASZIP_$E(AASBLNK,1,9-$L(AASZIP))
62 S AASCNTY=$G(^VIC(5.1,+$P(AAS1655("N1"),U,3),0))
63 S AASCNTY=+$P(AASCNTY,U,3)
64 S AASCNTY=$S((AASCNTY>0):AASCNTY,1:999)
65 S AASCNTY="T"_$E(AASZERO,1,3-$L(AASCNTY))_AASCNTY
66 S AASTAT=$P(AAS1655("N1"),U,4)
67 S AASTAT=$S(AASTAT="":" ",1:$P(^ONCO(160.15,AASTAT,0),U,1))
68 S AASCITY=$P(AAS1655("N1"),U,12) S:AASCITY="" AASCITY="CITY UNKNOWN"
69 S:$L(AASCITY)<20 AASCITY=AASCITY_$E(AASBLNK,1,20-$L(AASCITY))
70 S AASCITY=$E(AASCITY,1,20)
71 S ^TMP($J,D0,76)=^TMP($J,D0,76)_AASCITY_AASTAT_$E(AASCNTY,2,4)_AASZIP_$E(AASBLNK,1,7)
72 S AASMS=$S(AAS1655("N1")'="":$P(AAS1655("N1"),U,5),1:"")
73 I AASMS=""!(AASMS<1)!(AASMS>9)!(AASMS>5&(AASMS<9)) S AASMS=" "
74 D RSAR^ONCOANC4 ;RACE,SEX,AGE,RELIGION
75 G AASTUM^ONCOANC2
76AASQUIT D ^%ZISC
77 D CLEANUP^ONCOANC9
78 Q
79NOCON S AASTYPNC="I" D LINE^ONCOANCQ Q
Note: See TracBrowser for help on using the repository browser.