source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCODSP.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1ONCODSP ;Hines OIFO/GWB - MISCELLANEOUS OPTIONS ;05/05/00
2 ;;2.11;ONCOLOGY;**1,5,6,13,18,22,23,25,26,39,40,44**;Mar 07, 1995;Build 1
3TR ;[TR Define Tumor Registry Parameters]
4 W ! S DIC="^ONCO(160.1,",DIC(0)="AEMLQ",DLAYGO=160.1 D ^DIC
5 I Y=-1 G EX
6 W @IOF,!," ONCOLOGY SITE PARAMETERS"
7 W !," ------------------------"
8 S DIE="^ONCO(160.1,",DA=+Y
9 S DR=""
10 S DR(1,160.1,1)=".01 HOSPITAL NAME......."
11 S DR(1,160.1,2)=".02 STREET ADDRESS......"
12 S DR(1,160.1,3)=".03 ZIP CODE............"
13 S DR(1,160.1,4)=".04 REFERENCE DATE......"
14 S DR(1,160.1,5)="1 TUMOR REGISTRAR....."
15 S DR(1,160.1,6)="1.02 PHONE NUMBER........"
16 S DR(1,160.1,7)="1.03 STATE HOSPITAL #...."
17 S DR(1,160.1,8)="27 INSTITUTION ID #...."
18 S DR(1,160.1,9)="28 CENTRAL REGISTRY #.."
19 S DR(1,160.1,10)="7 VISN................"
20 S DR(1,160.1,10.1)="19 CS URL.............."
21 ;S DR(1,160.1,10.2)="59 EXTENDED VA DATASET."
22 S DR(1,160.1,11)="6 DIVISION............"
23 S DR(1,160.1,12)="W !"
24 S DR(1,160.1,13)="8 AFFILIATED DIVISION."
25 S DR(1,160.1,14)="W !"
26 S DR(1,160.1,15)="5 AUTHORZIED QA USER.."
27 D ^DIE
28 W ! K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
29 G EX
30 ;
31DIVID ;DIVISION (160.1,6) identifier
32 S ONCDIV=""
33 Q:'$D(^ONCO(160.1,Y,1))
34 S INSPTR=$P(^ONCO(160.1,Y,1),U,8)
35 Q:'$D(^DIC(4,INSPTR,99))
36 S ONCDIV=$P(^DIC(4,INSPTR,99),U,1)
37 W ?30,ONCDIV
38 K ONCDIV,INSPTR
39 Q
40 ;
41WS ;[WS Edit/print worksheet]
42 K DIR
43 S DIR("A")=" Action",DIR(0)="SO^E:Edit worksheet;P:Print worksheet"
44 D ^DIR G EW:Y="E",PW:Y="P",EX
45 ;
46EW ;Edit worksheet
47 S DIE="^ONCO(160.2,",DA=5,DR=1 D ^DIE
48 G WS
49 ;
50PW ;Print Worksheet
51 S DIC="^ONCO(160.2,",L=0,(NUMBER,DA)=5
52 S BY="@NUMBER",FR=NUMBER,TO=NUMBER,FLDS="[ONCO WORKSHEET]"
53 D EN1^DIP
54 G WS
55 ;
56RSR ;[RS Registry Summary Reports]
57 S ONCOS("T")="T",DIR("A")=" Select"
58 S DIR(0)="S^T:Today;A:Annual;F:Follow-Up",DIR("B")="Today"
59 D ^DIR G EX:Y=""!(Y[U) G @Y
60 ;
61A ;[RS Registry Summary Reports - Annual]
62 S BYR=$O(^ONCO(165.5,"AY",0))
63 F YR=$E(DT,1)+17_$E(DT,2,3)-1:-1:BYR-1 S EYR=$O(^ONCO(165.5,"AY",YR)) Q:EYR'=""
64 W !!
65 K DIR
66 S YR=$E(DT,1)+17_$E(DT,2,3)
67 S DIR("A")=" Select year for summary"
68 S DIR("B")=YR-1 S:DIR("B")<BYR DIR("B")=BYR
69 S DIR(0)="N^"_BYR_":"_EYR D ^DIR K DIR
70 G EX:Y[U!(Y=""),A:Y>YR,A:Y'?1.N S ONCOS("T")=Y
71 K DIR
72 S DIR("A")=" Analytic cases only"
73 S DIR("B")="YES"
74 S DIR(0)="Y"
75 S DIR("?")=" "
76 S DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 0-2) displayed."
77 S DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) displayed."
78 D ^DIR
79 I $D(DIRUT) Q
80 S ACO=Y
81 ;
82T ;[RS Registry Summary Reports - Today]
83 K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G EX
84 I '$D(IO("Q")) D WAIT^DICD,TK^ONCODSP G EX
85 S ZTSAVE("ONCOS*")="",ZTSAVE("ACO")=""
86 S ZTRTN="TK^ONCODSP",ZTDESC="REGISTRY SUMMARY RPT"
87 D ^%ZTLOAD G EX
88 ;
89F ;[RS Registry Summary Reports - Follow-Up]
90 K DIR
91 W !!," Follow-up rate calculation parameters (select 1 or 2):",!
92 W !," 1) All analytic patients from the cancer registry reference date"
93 W !," 2) All analytic patients diagnosed within the last five years, or"
94 W !," from the cancer registry reference date, whichever is shorter"
95 W !
96 N DIR,X,Y
97 S DIR(0)="SAO^1:From cancer registry reference date;2:Within last 5 years or reference date (whichever is shorter)"
98 S DIR("A")=" Select follow-up rate calculation parameter: "
99 S DIR("?")="Select the starting point to compute the follow-up rate"
100 D ^DIR G EX:Y=""!(Y[U) S ONCOS("F")=Y
101 K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G EX
102 I '$D(IO("Q")) D WAIT^DICD G FR^ONCOCOF
103 S ZTSAVE("ONCOS*")="",ZTRTN="FR^ONCOCOF",ZTDESC="FOLLOWUP RATE REPORT"
104 D ^%ZTLOAD G EX
105 ;
106TK ;Tasked [RS Registry Summary Reports - Today] report
107 S YR=ONCOS("T")
108 G AN:YR'="T"
109 S V(9)=0,F(8)=0 F I=0,1 S G(I)=0,V(I)=0,F(I)=0
110 S G=0,XD0=0 F S XD0=$O(^ONCO(165.5,"AG",G,XD0)) Q:XD0'>0 I $$DIV^ONCFUNC(XD0)=DUZ(2) S G(G)=G(G)+1
111 S G=1,XD0=0 F S XD0=$O(^ONCO(165.5,"AG",G,XD0)) Q:XD0'>0 I $$DIV^ONCFUNC(XD0)=DUZ(2) S G(G)=G(G)+1
112 S W=0,X0=0 F S X0=$O(^ONCO(160,"ADX",X0)) Q:'X0 S X1=0 F S X1=$O(^ONCO(160,"ADX",X0,X1)) Q:'X1 S X2=0 F S X2=$O(^ONCO(160,"ADX",X0,X1,X2)) Q:'X2 I $$SUSDIV^ONCFUNC(X1,X2)=DUZ(2) S W=W+1
113 F I=0:1:3 S W(I)=0
114 F I=0:1:3 S X0=0 F S X0=$O(^ONCO(165.5,"AS",I,X0)) Q:X0'>0 I $$DIV^ONCFUNC(X0)=DUZ(2) S W(I)=W(I)+1
115 W !!?30,"Analytical: ",$J(G(1),5)
116 W !?26,"Non-Analytical: ",$J(G(0),5)
117 W !?42,"-----"
118 W !?35,"Total: ",$J(G(0)+G(1),5),!!
119 W !,?30,"WORKLOAD STATISTICS",!!
120 W "Suspense: ",W,?15,"Incomplete: ",W(0),?35,"Minimal: ",W(1),?50,"Partial: ",W(2),?65,"Complete: ",W(3),!!
121 Q
122 ;
123AN ;[RS Registry Summary Reports - Annual]
124 K ^TMP($J,"ANNSUM")
125 S ^ONCO(164.08,"YR")=YR
126 S XD0=0 F S XD0=$O(^ONCO(164.08,XD0)) Q:XD0'>0 F J="CC","RS","SG" S ^ONCO(164.08,XD0,J)=""
127 S ^TMP($J,"ANNSUM","YR")=YR
128 S XD0=0 F S XD0=$O(^ONCO(164.08,XD0)) Q:XD0'>0 S ^TMP($J,"ANNSUM",XD0,0)=$G(^ONCO(164.08,XD0,0)) F J="CC","RS","SG" S ^TMP($J,"ANNSUM",XD0,J)=""
129 S XD0=0 F S XD0=$O(^ONCO(165.5,"AY",YR,XD0)) Q:XD0'>0 I $$DIV^ONCFUNC(XD0)=DUZ(2) S X0=^ONCO(165.5,XD0,0),CSG=$P($G(^ONCO(165.5,XD0,2)),U,20),PSG=$P($G(^ONCO(165.5,XD0,2.1)),U,4),SG=$P($G(^ONCO(165.5,XD0,2)),U,28) D
130 .S COCANAL=$$GET1^DIQ(165.5,XD0,.042)
131 .I ACO=1,COCANAL="NONANALYTIC" Q
132 .I SG'="" S SG=$S(SG=0:0,SG="I":1,SG="II":2,SG="III":3,SG="IV":4,SG="U":99,SG="NA":88,1:"")
133 .I SG="" S SG=7 ;incomplete=7 (will put them in 8th piece of SG node)
134 .S ST=$P(X0,U),IC=$P(X0,U,22),PT=$P(X0,U,2),CC=$P(X0,U,20) Q:IC=""
135 .I IC=6799 S IC=6780
136 .S P0=$G(^ONCO(160,PT,0)) Q:P0="" S RC=+$P(P0,U,6),SX=$P(P0,U,8),R=$S(RC=1:"W",RC=2:"B",1:"O"),S=$S(SX=1:"M",1:"F"),RS=R_S
137 .S CC=$S(CC=0:3,1:2),RS=$S(RS="WM":1,RS="WF":2,RS="BM":3,RS="BF":4,RS="OM":5,1:6)
138 .S SG=+SG+1,SG=$S(SG=100:6,SG=89:7,1:SG)
139 .S $P(^TMP($J,"ANNSUM",IC,"CC"),U,CC)=$P(^TMP($J,"ANNSUM",IC,"CC"),U,CC)+1,$P(^TMP($J,"ANNSUM",IC,"CC"),U)=$P(^TMP($J,"ANNSUM",IC,"CC"),U)+1
140 .S $P(^TMP($J,"ANNSUM",IC,"RS"),U,RS)=$P(^TMP($J,"ANNSUM",IC,"RS"),U,RS)+1
141 .S $P(^TMP($J,"ANNSUM",IC,"SG"),U,SG)=$P(^TMP($J,"ANNSUM",IC,"SG"),U,SG)+1
142 ;
143PRT ;Print report
144 D ^ONCODSP1
145 ;
146EX ;EXIT
147 K BY,BYR,CC,CSG,EYR,F,FLDS,FR,G,I,IC,J,L,NUMBER,ONCOS,ONCOUT
148 K P0,PSG,PT,R,RC,RS,SG,ST,SX,TO,V,W,X,X0,X1,X2,XD0,Y,YR
149 K DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR
150 K ^TMP($J)
151 Q
Note: See TracBrowser for help on using the repository browser.