Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCODSP

ONCODSP.m

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