- 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 Feb 18, 2025@23:51:20 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