ONCODSP ;HINES OIFO/GWB,RTK - MISCELLANEOUS OPTIONS ;05/05/10
;;2.2;ONCOLOGY;**1,4,5,10,13,17**;Jul 31, 2013;Build 6
;
TR ;[TR Define Tumor Registry Parameters]
W ! S DIC="^ONCO(160.1,",DIC(0)="AEMLQ",DLAYGO=160.1 D ^DIC
I Y=-1 G EX
W @IOF,!," ONCOLOGY SITE PARAMETERS"
W !," ------------------------"
S DIE="^ONCO(160.1,",DA=+Y
S DR=""
S DR(1,160.1,1)=".01 HOSPITAL NAME....."
S DR(1,160.1,2)=".02 STREET ADDRESS...."
S DR(1,160.1,3)=".03 ZIPCODE..........."
;S DR(1,160.1,3.1)="W !,"" CITY..............: "",$$GET1^DIQ(160.1,DA,66)"
;S DR(1,160.1,3.2)="W !,"" STATE.............: "",$$GET1^DIQ(160.1,DA,67)"
S DR(1,160.1,4)=".04 REFERENCE DATE...."
S DR(1,160.1,4.1)="71 COC ACCREDITATION DATE."
S DR(1,160.1,5)="1 TUMOR REGISTRAR..."
S DR(1,160.1,6)="1.02 PHONE NUMBER......"
S DR(1,160.1,7)="1.03 STATE HOSPITAL #.."
S DR(1,160.1,8)="27 FACILITY ID #....."
S DR(1,160.1,8.1)="S FACPNT=$P($G(^ONCO(160.1,DA,1)),U,4) D FNPI^ONCNPI"
S DR(1,160.1,9)="28 CENTRAL REGISTRY #"
S DR(1,160.1,10)="7 VISN.............."
S DR(1,160.1,10.1)="19 CS/EDITS URL......"
S DR(1,160.1,11)="6 DIVISION.........."
S DR(1,160.1,11.1)="68 COC ACCREDITATION."
S DR(1,160.1,12)="W !"
S DR(1,160.1,12.1)="70 COC ACCREDITATION TEXT."
S DR(1,160.1,12.2)="W !"
S DR(1,160.1,13)="8 AFFILIATED DIVISION."
S DR(1,160.1,14)="W !"
S DR(1,160.1,15)="5 AUTHORIZED QA USER.."
S DR(1,160.1,16)="W !"
S DR(1,160.1,17)="105 ABSTRACTOR/REGISTRAR"
D ^DIE
W ! K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
G EX
;
TDSNIT() ;Input Transform for 3 Digit State Number multiple (160.1,105)
I $D(^ONCO(160.1,"E",X,DA(1))) W !!,"That number has already been assigned!! " Q 1
W ! Q 0
;
DIVID ;DIVISION (160.1,6) identifier
S ONCDIV=""
Q:'$D(^ONCO(160.1,Y,1))
S INSPTR=$P(^ONCO(160.1,Y,1),U,8)
Q:'$D(^DIC(4,INSPTR,99))
S ONCDIV=$P(^DIC(4,INSPTR,99),U,1)
W ?30,ONCDIV
K ONCDIV,INSPTR
Q
;
WS ;[WS Edit/print worksheet]
K DIR
S DIR("A")=" Action",DIR(0)="SO^E:Edit worksheet;P:Print worksheet"
D ^DIR G EW:Y="E",PW:Y="P",EX
;
EW ;Edit worksheet
S DIE="^ONCO(160.2,",DA=5,DR=1 D ^DIE
G WS
;
PW ;Print Worksheet
S DIC="^ONCO(160.2,",L=0,(NUMBER,DA)=5
S BY="@NUMBER",FR=NUMBER,TO=NUMBER,FLDS="[ONCO WORKSHEET]"
D EN1^DIP
G WS
FST ;Type of First Recurrence for RF option.
;added label FST in p *2.2*4
W:$G(ONC1655) ?28,$E($$GET1^DIQ(165.5,ONC1655,20),1,15),?45,$E($$GET1^DIQ(165.5,ONC1655,.02),1,11)
W:$G(ONC16012) ?58,$P($G(^ONCO(160.12,ONC16012,0)),U,2)
Q
;
RSR ;[RS Registry Summary Reports]
S ONCOS("T")="T",DIR("A")=" Select"
S DIR(0)="S^T:Today;A:Annual;F:Follow-Up",DIR("B")="Today"
D ^DIR G EX:Y=""!(Y[U) G @Y
;
A ;[RS Registry Summary Reports - Annual]
S BYR=$O(^ONCO(165.5,"AY",0))
F YR=$E(DT,1)+17_$E(DT,2,3)-1:-1:BYR-1 S EYR=$O(^ONCO(165.5,"AY",YR)) Q:EYR'=""
W !!
K DIR
S YR=$E(DT,1)+17_$E(DT,2,3)
S DIR("A")=" Select year for summary"
S DIR("B")=YR-1 S:DIR("B")<BYR DIR("B")=BYR
S DIR(0)="N^"_BYR_":"_EYR D ^DIR K DIR
G EX:Y[U!(Y=""),A:Y>YR,A:Y'?1.N S ONCOS("T")=Y
K DIR
S DIR("A")=" Analytic cases only"
S DIR("B")="YES"
S DIR(0)="Y"
S DIR("?")=" "
S DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 00-22) displayed."
S DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) displayed."
D ^DIR
I $D(DIRUT) Q
S ACO=Y
;
T ;[RS Registry Summary Reports - Today]
K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G EX
I '$D(IO("Q")) D WAIT^DICD,TK^ONCODSP G EX
S ZTSAVE("ONCOS*")="",ZTSAVE("ACO")=""
S ZTRTN="TK^ONCODSP",ZTDESC="REGISTRY SUMMARY RPT"
D ^%ZTLOAD G EX
;
F ;[RS Registry Summary Reports - Follow-Up]
K DIR
W !!," Follow-up rate calculation parameters (select 1 or 2):",!
W !,"1) 15 Year Rolling Follow-Up Rate for All Patients: For all eligible"
W !," analytic cases (Class of Case 10-14 and 20-22) from the most"
W !," current year of completed cases through 15 years prior or the"
W !," program's first accreditation date (or reference date if no"
W !," accreditation date), whichever is shorter."
W !,"2) 5 Year Rolling Follow-Up Rate for Recent Patients: For all eligible"
W !," analytic cases (Class of Case 10-14 and 20-22) diagnosed from"
W !," the most current year of completed cases through five years"
W !," preceding or the program's first accredited date (or reference"
W !," date if no accreditation date), whichever is shorter."
W !
N DIR,X,Y
S DIR(0)="SAO^1:15 Year Follow-Up Rate for All Patients;2:5 Year Follow-Up Rate for Recent Patients"
S DIR("A")=" Select follow-up rate calculation parameter: "
S DIR("?")="Select the starting point to compute the follow-up rate"
D ^DIR G EX:Y=""!(Y[U) S ONCOS("F")=Y
K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G EX
I '$D(IO("Q")) D WAIT^DICD G FR^ONCOCOF
S ZTSAVE("ONCOS*")="",ZTRTN="FR^ONCOCOF",ZTDESC="FOLLOWUP RATE REPORT"
D ^%ZTLOAD G EX
;
TK ;Tasked [RS Registry Summary Reports - Today] report
S YR=ONCOS("T")
G AN:YR'="T"
S V(9)=0,F(8)=0 F I=0,1 S G(I)=0,V(I)=0,F(I)=0
;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
;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
S G=0,XD0=0 F S XD0=$O(^ONCO(165.5,"AG",G,XD0)) Q:XD0'>0 I $$DIV^ONCFUNC(XD0)=DUZ(2),$P($G(^ONCO(165.5,XD0,7)),"^",2)'="A" S G(G)=G(G)+1
S G=1,XD0=0 F S XD0=$O(^ONCO(165.5,"AG",G,XD0)) Q:XD0'>0 I $$DIV^ONCFUNC(XD0)=DUZ(2),$P($G(^ONCO(165.5,XD0,7)),"^",2)'="A" S G(G)=G(G)+1
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
;F I=0:1:3 S W(I)=0
;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
F I=0,1,2,3,"A" S W(I)=0
F I=0,1,2,3,"A" 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
W !!?30,"Analytical: ",$J(G(1),5)
W !?26,"Non-Analytical: ",$J(G(0),5)
W !?26,"Accession Only: ",$J(W("A"),5)
W !?42,"-----"
;W !?35,"Total: ",$J(G(0)+G(1),5),!!
W !?35,"Total: ",$J(G(0)+G(1)+W("A"),5),!!
W !,?30,"WORKLOAD STATISTICS",!!
;W "Suspense: ",W,?15,"Incomplete: ",W(0),?35,"Minimal: ",W(1),?50,"Partial: ",W(2),?65,"Complete: ",W(3),!!
W "Suspense: ",W,!!,"Incomplete: ",W(0),?19,"Minimal: ",W(1),?34,"Partial: ",W(2),?49,"Complete: ",W(3),?65,"Acc Only: ",W("A"),!
W "---------------",!,"Total: ",W(0)+W(1)+W(2)+W(3)+W("A")
Q
;
AN ;[RS Registry Summary Reports - Annual]
K ^TMP($J,"ANNSUM")
S ^ONCO(164.08,"YR")=YR
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)=""
S ^TMP($J,"ANNSUM","YR")=YR
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)=""
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
.I $P($G(^ONCO(165.5,XD0,7)),U,2)="A" Q
.S COCANAL=$$GET1^DIQ(165.5,XD0,.042)
.I ACO=1,COCANAL="NONANALYTIC" Q
.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:"")
.I SG="" S SG=7 ;incomplete=7 (will put them in 8th piece of SG node)
.S ST=$P(X0,U),IC=$P(X0,U,22),PT=$P(X0,U,2),CC=$P(X0,U,20) Q:IC=""
.I IC=6799 S IC=6780
.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
.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)
.S SG=+SG+1,SG=$S(SG=100:6,SG=89:7,1:SG)
.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
.S $P(^TMP($J,"ANNSUM",IC,"RS"),U,RS)=$P(^TMP($J,"ANNSUM",IC,"RS"),U,RS)+1
.S $P(^TMP($J,"ANNSUM",IC,"SG"),U,SG)=$P(^TMP($J,"ANNSUM",IC,"SG"),U,SG)+1
;
PRT ;Print report
D ^ONCODSP1
;
EX ;EXIT
K BY,BYR,CC,CSG,EYR,F,FLDS,FR,G,I,IC,J,L,NUMBER,ONCOS,ONCOUT
K P0,PSG,PT,R,RC,RS,SG,ST,SX,TO,V,W,X,X0,X1,X2,XD0,Y,YR
K DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR,SITEPARAM
K ^TMP($J)
Q
;
CLEANUP ;Cleanup
K %ZIS,ACO,COCANAL,OUT,POP,S,ZTDESC,ZTRTN,ZTSAVE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCODSP 8487 printed Dec 13, 2024@02:24:50 Page 2
ONCODSP ;HINES OIFO/GWB,RTK - MISCELLANEOUS OPTIONS ;05/05/10
+1 ;;2.2;ONCOLOGY;**1,4,5,10,13,17**;Jul 31, 2013;Build 6
+2 ;
TR ;[TR Define Tumor Registry Parameters]
+1 WRITE !
SET DIC="^ONCO(160.1,"
SET DIC(0)="AEMLQ"
SET DLAYGO=160.1
DO ^DIC
+2 IF Y=-1
GOTO EX
+3 WRITE @IOF,!," ONCOLOGY SITE PARAMETERS"
+4 WRITE !," ------------------------"
+5 SET DIE="^ONCO(160.1,"
SET DA=+Y
+6 SET DR=""
+7 SET DR(1,160.1,1)=".01 HOSPITAL NAME....."
+8 SET DR(1,160.1,2)=".02 STREET ADDRESS...."
+9 SET DR(1,160.1,3)=".03 ZIPCODE..........."
+10 ;S DR(1,160.1,3.1)="W !,"" CITY..............: "",$$GET1^DIQ(160.1,DA,66)"
+11 ;S DR(1,160.1,3.2)="W !,"" STATE.............: "",$$GET1^DIQ(160.1,DA,67)"
+12 SET DR(1,160.1,4)=".04 REFERENCE DATE...."
+13 SET DR(1,160.1,4.1)="71 COC ACCREDITATION DATE."
+14 SET DR(1,160.1,5)="1 TUMOR REGISTRAR..."
+15 SET DR(1,160.1,6)="1.02 PHONE NUMBER......"
+16 SET DR(1,160.1,7)="1.03 STATE HOSPITAL #.."
+17 SET DR(1,160.1,8)="27 FACILITY ID #....."
+18 SET DR(1,160.1,8.1)="S FACPNT=$P($G(^ONCO(160.1,DA,1)),U,4) D FNPI^ONCNPI"
+19 SET DR(1,160.1,9)="28 CENTRAL REGISTRY #"
+20 SET DR(1,160.1,10)="7 VISN.............."
+21 SET DR(1,160.1,10.1)="19 CS/EDITS URL......"
+22 SET DR(1,160.1,11)="6 DIVISION.........."
+23 SET DR(1,160.1,11.1)="68 COC ACCREDITATION."
+24 SET DR(1,160.1,12)="W !"
+25 SET DR(1,160.1,12.1)="70 COC ACCREDITATION TEXT."
+26 SET DR(1,160.1,12.2)="W !"
+27 SET DR(1,160.1,13)="8 AFFILIATED DIVISION."
+28 SET DR(1,160.1,14)="W !"
+29 SET DR(1,160.1,15)="5 AUTHORIZED QA USER.."
+30 SET DR(1,160.1,16)="W !"
+31 SET DR(1,160.1,17)="105 ABSTRACTOR/REGISTRAR"
+32 DO ^DIE
+33 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
SET OUT="Y"
+34 GOTO EX
+35 ;
TDSNIT() ;Input Transform for 3 Digit State Number multiple (160.1,105)
+1 IF $DATA(^ONCO(160.1,"E",X,DA(1)))
WRITE !!,"That number has already been assigned!! "
QUIT 1
+2 WRITE !
QUIT 0
+3 ;
DIVID ;DIVISION (160.1,6) identifier
+1 SET ONCDIV=""
+2 if '$DATA(^ONCO(160.1,Y,1))
QUIT
+3 SET INSPTR=$PIECE(^ONCO(160.1,Y,1),U,8)
+4 if '$DATA(^DIC(4,INSPTR,99))
QUIT
+5 SET ONCDIV=$PIECE(^DIC(4,INSPTR,99),U,1)
+6 WRITE ?30,ONCDIV
+7 KILL ONCDIV,INSPTR
+8 QUIT
+9 ;
WS ;[WS Edit/print worksheet]
+1 KILL DIR
+2 SET DIR("A")=" Action"
SET DIR(0)="SO^E:Edit worksheet;P:Print worksheet"
+3 DO ^DIR
if Y="E"
GOTO EW
if Y="P"
GOTO PW
GOTO EX
+4 ;
EW ;Edit worksheet
+1 SET DIE="^ONCO(160.2,"
SET DA=5
SET DR=1
DO ^DIE
+2 GOTO WS
+3 ;
PW ;Print Worksheet
+1 SET DIC="^ONCO(160.2,"
SET L=0
SET (NUMBER,DA)=5
+2 SET BY="@NUMBER"
SET FR=NUMBER
SET TO=NUMBER
SET FLDS="[ONCO WORKSHEET]"
+3 DO EN1^DIP
+4 GOTO WS
FST ;Type of First Recurrence for RF option.
+1 ;added label FST in p *2.2*4
+2 if $GET(ONC1655)
WRITE ?28,$EXTRACT($$GET1^DIQ(165.5,ONC1655,20),1,15),?45,$EXTRACT($$GET1^DIQ(165.5,ONC1655,.02),1,11)
+3 if $GET(ONC16012)
WRITE ?58,$PIECE($GET(^ONCO(160.12,ONC16012,0)),U,2)
+4 QUIT
+5 ;
RSR ;[RS Registry Summary Reports]
+1 SET ONCOS("T")="T"
SET DIR("A")=" Select"
+2 SET DIR(0)="S^T:Today;A:Annual;F:Follow-Up"
SET DIR("B")="Today"
+3 DO ^DIR
if Y=""!(Y[U)
GOTO EX
GOTO @Y
+4 ;
A ;[RS Registry Summary Reports - Annual]
+1 SET BYR=$ORDER(^ONCO(165.5,"AY",0))
+2 FOR YR=$EXTRACT(DT,1)+17_$EXTRACT(DT,2,3)-1:-1:BYR-1
SET EYR=$ORDER(^ONCO(165.5,"AY",YR))
if EYR'=""
QUIT
+3 WRITE !!
+4 KILL DIR
+5 SET YR=$EXTRACT(DT,1)+17_$EXTRACT(DT,2,3)
+6 SET DIR("A")=" Select year for summary"
+7 SET DIR("B")=YR-1
if DIR("B")<BYR
SET DIR("B")=BYR
+8 SET DIR(0)="N^"_BYR_":"_EYR
DO ^DIR
KILL DIR
+9 if Y[U!(Y="")
GOTO EX
if Y>YR
GOTO A
if Y'?1.N
GOTO A
SET ONCOS("T")=Y
+10 KILL DIR
+11 SET DIR("A")=" Analytic cases only"
+12 SET DIR("B")="YES"
+13 SET DIR(0)="Y"
+14 SET DIR("?")=" "
+15 SET DIR("?",1)=" Answer 'YES' if you want only analytic cases (CLASS OF CASE 00-22) displayed."
+16 SET DIR("?",2)=" Answer 'NO' if you want all cases (analytic and non-analytic) displayed."
+17 DO ^DIR
+18 IF $DATA(DIRUT)
QUIT
+19 SET ACO=Y
+20 ;
T ;[RS Registry Summary Reports - Today]
+1 KILL IO("Q")
SET %ZIS="Q"
WRITE !!
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO EX
+2 IF '$DATA(IO("Q"))
DO WAIT^DICD
DO TK^ONCODSP
GOTO EX
+3 SET ZTSAVE("ONCOS*")=""
SET ZTSAVE("ACO")=""
+4 SET ZTRTN="TK^ONCODSP"
SET ZTDESC="REGISTRY SUMMARY RPT"
+5 DO ^%ZTLOAD
GOTO EX
+6 ;
F ;[RS Registry Summary Reports - Follow-Up]
+1 KILL DIR
+2 WRITE !!," Follow-up rate calculation parameters (select 1 or 2):",!
+3 WRITE !,"1) 15 Year Rolling Follow-Up Rate for All Patients: For all eligible"
+4 WRITE !," analytic cases (Class of Case 10-14 and 20-22) from the most"
+5 WRITE !," current year of completed cases through 15 years prior or the"
+6 WRITE !," program's first accreditation date (or reference date if no"
+7 WRITE !," accreditation date), whichever is shorter."
+8 WRITE !,"2) 5 Year Rolling Follow-Up Rate for Recent Patients: For all eligible"
+9 WRITE !," analytic cases (Class of Case 10-14 and 20-22) diagnosed from"
+10 WRITE !," the most current year of completed cases through five years"
+11 WRITE !," preceding or the program's first accredited date (or reference"
+12 WRITE !," date if no accreditation date), whichever is shorter."
+13 WRITE !
+14 NEW DIR,X,Y
+15 SET DIR(0)="SAO^1:15 Year Follow-Up Rate for All Patients;2:5 Year Follow-Up Rate for Recent Patients"
+16 SET DIR("A")=" Select follow-up rate calculation parameter: "
+17 SET DIR("?")="Select the starting point to compute the follow-up rate"
+18 DO ^DIR
if Y=""!(Y[U)
GOTO EX
SET ONCOS("F")=Y
+19 KILL IO("Q")
SET %ZIS="Q"
WRITE !!
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO EX
+20 IF '$DATA(IO("Q"))
DO WAIT^DICD
GOTO FR^ONCOCOF
+21 SET ZTSAVE("ONCOS*")=""
SET ZTRTN="FR^ONCOCOF"
SET ZTDESC="FOLLOWUP RATE REPORT"
+22 DO ^%ZTLOAD
GOTO EX
+23 ;
TK ;Tasked [RS Registry Summary Reports - Today] report
+1 SET YR=ONCOS("T")
+2 if YR'="T"
GOTO AN
+3 SET V(9)=0
SET F(8)=0
FOR I=0,1
SET G(I)=0
SET V(I)=0
SET F(I)=0
+4 ;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
+5 ;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
+6 SET G=0
SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(165.5,"AG",G,XD0))
if XD0'>0
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
IF $PIECE($GET(^ONCO(165.5,XD0,7)),"^",2)'="A"
SET G(G)=G(G)+1
+7 SET G=1
SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(165.5,"AG",G,XD0))
if XD0'>0
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
IF $PIECE($GET(^ONCO(165.5,XD0,7)),"^",2)'="A"
SET G(G)=G(G)+1
+8 SET W=0
SET X0=0
FOR
SET X0=$ORDER(^ONCO(160,"ADX",X0))
if 'X0
QUIT
SET X1=0
FOR
SET X1=$ORDER(^ONCO(160,"ADX",X0,X1))
if 'X1
QUIT
SET X2=0
FOR
SET X2=$ORDER(^ONCO(160,"ADX",X0,X1,X2))
if 'X2
QUIT
IF $$SUSDIV^ONCFUNC(X1,X2)=DUZ(2)
SET W=W+1
+9 ;F I=0:1:3 S W(I)=0
+10 ;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
+11 FOR I=0,1,2,3,"A"
SET W(I)=0
+12 FOR I=0,1,2,3,"A"
SET X0=0
FOR
SET X0=$ORDER(^ONCO(165.5,"AS",I,X0))
if X0'>0
QUIT
IF $$DIV^ONCFUNC(X0)=DUZ(2)
SET W(I)=W(I)+1
+13 WRITE !!?30,"Analytical: ",$JUSTIFY(G(1),5)
+14 WRITE !?26,"Non-Analytical: ",$JUSTIFY(G(0),5)
+15 WRITE !?26,"Accession Only: ",$JUSTIFY(W("A"),5)
+16 WRITE !?42,"-----"
+17 ;W !?35,"Total: ",$J(G(0)+G(1),5),!!
+18 WRITE !?35,"Total: ",$JUSTIFY(G(0)+G(1)+W("A"),5),!!
+19 WRITE !,?30,"WORKLOAD STATISTICS",!!
+20 ;W "Suspense: ",W,?15,"Incomplete: ",W(0),?35,"Minimal: ",W(1),?50,"Partial: ",W(2),?65,"Complete: ",W(3),!!
+21 WRITE "Suspense: ",W,!!,"Incomplete: ",W(0),?19,"Minimal: ",W(1),?34,"Partial: ",W(2),?49,"Complete: ",W(3),?65,"Acc Only: ",W("A"),!
+22 WRITE "---------------",!,"Total: ",W(0)+W(1)+W(2)+W(3)+W("A")
+23 QUIT
+24 ;
AN ;[RS Registry Summary Reports - Annual]
+1 KILL ^TMP($JOB,"ANNSUM")
+2 SET ^ONCO(164.08,"YR")=YR
+3 SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(164.08,XD0))
if XD0'>0
QUIT
FOR J="CC","RS","SG"
SET ^ONCO(164.08,XD0,J)=""
+4 SET ^TMP($JOB,"ANNSUM","YR")=YR
+5 SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(164.08,XD0))
if XD0'>0
QUIT
SET ^TMP($JOB,"ANNSUM",XD0,0)=$GET(^ONCO(164.08,XD0,0))
FOR J="CC","RS","SG"
SET ^TMP($JOB,"ANNSUM",XD0,J)=""
+6 SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(165.5,"AY",YR,XD0))
if XD0'>0
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
SET X0=^ONCO(165.5,XD0,0)
SET CSG=$PIECE($GET(^ONCO(165.5,XD0,2)),U,20)
SET PSG=$PIECE($GET(^ONCO(165.5,XD0,2.1)),U,4)
SET SG=$PIECE($GET(^ONCO(165.5,XD0,2)),U,28)
Begin DoDot:1
+7 IF $PIECE($GET(^ONCO(165.5,XD0,7)),U,2)="A"
QUIT
+8 SET COCANAL=$$GET1^DIQ(165.5,XD0,.042)
+9 IF ACO=1
IF COCANAL="NONANALYTIC"
QUIT
+10 IF SG'=""
SET SG=$SELECT(SG=0:0,SG="I":1,SG="II":2,SG="III":3,SG="IV":4,SG="U":99,SG="NA":88,1:"")
+11 ;incomplete=7 (will put them in 8th piece of SG node)
IF SG=""
SET SG=7
+12 SET ST=$PIECE(X0,U)
SET IC=$PIECE(X0,U,22)
SET PT=$PIECE(X0,U,2)
SET CC=$PIECE(X0,U,20)
if IC=""
QUIT
+13 IF IC=6799
SET IC=6780
+14 SET P0=$GET(^ONCO(160,PT,0))
if P0=""
QUIT
SET RC=+$PIECE(P0,U,6)
SET SX=$PIECE(P0,U,8)
SET R=$SELECT(RC=1:"W",RC=2:"B",1:"O")
SET S=$SELECT(SX=1:"M",1:"F")
SET RS=R_S
+15 SET CC=$SELECT(CC=0:3,1:2)
SET RS=$SELECT(RS="WM":1,RS="WF":2,RS="BM":3,RS="BF":4,RS="OM":5,1:6)
+16 SET SG=+SG+1
SET SG=$SELECT(SG=100:6,SG=89:7,1:SG)
+17 SET $PIECE(^TMP($JOB,"ANNSUM",IC,"CC"),U,CC)=$PIECE(^TMP($JOB,"ANNSUM",IC,"CC"),U,CC)+1
SET $PIECE(^TMP($JOB,"ANNSUM",IC,"CC"),U)=$PIECE(^TMP($JOB,"ANNSUM",IC,"CC"),U)+1
+18 SET $PIECE(^TMP($JOB,"ANNSUM",IC,"RS"),U,RS)=$PIECE(^TMP($JOB,"ANNSUM",IC,"RS"),U,RS)+1
+19 SET $PIECE(^TMP($JOB,"ANNSUM",IC,"SG"),U,SG)=$PIECE(^TMP($JOB,"ANNSUM",IC,"SG"),U,SG)+1
End DoDot:1
+20 ;
PRT ;Print report
+1 DO ^ONCODSP1
+2 ;
EX ;EXIT
+1 KILL BY,BYR,CC,CSG,EYR,F,FLDS,FR,G,I,IC,J,L,NUMBER,ONCOS,ONCOUT
+2 KILL P0,PSG,PT,R,RC,RS,SG,ST,SX,TO,V,W,X,X0,X1,X2,XD0,Y,YR
+3 KILL DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR,SITEPARAM
+4 KILL ^TMP($JOB)
+5 QUIT
+6 ;
CLEANUP ;Cleanup
+1 KILL %ZIS,ACO,COCANAL,OUT,POP,S,ZTDESC,ZTRTN,ZTSAVE
