- ONCOSCG ;WASH ISC/SRR,MLH-CROSS TABS: STAGE & TREATMENT ;12/15/99
- ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- TS ;individual stage group/treatment,Treatment by Stage
- W !?10,"This option will print cross-tabs for ALL ANALYTIC",!?10,"cases for TREATMENT by STAGE groups (I,II,III,IV)",!
- ;call to ONCOST for time frame
- S ONCOT=1 D TF^ONCOST G EX:$D(DIRUT)
- ROW ;SELECT ROW
- K DIR S DIR("A")=" Select Row",DIR(0)="SO^1:PRIMARY SITE/GP;2:ICDO-SITE;3:ICDO-TOPOGRAPHY;4:SELECTED SITES;5:SYSTEMS;6:HISTOLOGY (ICD-O-3)" D ^DIR G EX:$D(DIRUT) S ONCOS("R")=$P($P(DIR(0),";",Y),":",2)
- K DIR S DIR("A")=" Percentages",DIR(0)="Y" W ! D ^DIR G EX:$D(DIRUT) S ONCOS("P")=$S(Y=0:"",1:1)
- K IO("Q") S %ZIS="Q" W !! D ^%ZIS S IOP=ION I POP S ONCOUT="" G EX
- I '$D(IO("Q")) D TSK^ONCOSCG G EX
- S ZTRTN="TSK^ONCOSCG",ZTDESC="ONCOLOGY STG/TX",ZTSAVE("ONCOS*")="" D ^%ZTLOAD K ZTSK G EX
- ;
- TSK ;Tasked job to go through all 4 stages (use xref "ASG")
- S TF=ONCOS("YR") I TF'="ALL" S BYR=$P(TF,U),EYR=$P(TF,U,2),TF=$S(BYR=EYR:"ANN",1:"RGE")
- S YR=$S(TF="ANN":" ANNUAL ",1:" ") ;use ONCOS ANAL/...for Range or All ;ANNUAL for Annual
- G F G=0,"I","II","III","IV","U","NA" S XD0=$O(^DIBT("F165.5","ONCOS"_YR_"ANAL/STAGE "_G,0)) Q:XD0'>0 K ^DIBT(XD0,1) S XD(G)=XD0,$P(^DIBT(XD0,0),U,2)=DT
- S XD0=$O(^DIBT("F165.5","ONCOS"_$S(TF="ANN":" ANNUAL-",1:" ")_"ANALYTIC",0)) I XD0'="" S $P(^DIBT(XD0,0),U,2)=DT K ^DIBT(XD0,1)
- GET S HEAD=$S(TF="ALL":"ALL",TF="ANN":BYR,1:BYR_"-"_EYR)
- D ALL:TF="ALL",ANN:TF="ANN",RGE:TF="RGE"
- TEM D SETV,HED S ONCOS("T")="ONCOS "_$S(TF="ANN":"ANNUAL-",1:"")_"ANALYTIC"
- ST S ONCOEX=0 F G="I","II","III","IV" Q:ONCOEX S ONCOS("C")="GP-"_G_" AJCC SUMMARY STAGE" D PRINT^ONCOSCT
- Q:ONCOEX S ONCOS("C")="TREATMENT" D PRINT^ONCOSCT Q:ONCOEX
- F G=0,"I","II","III","IV","U","NA" Q:ONCOEX S ONCOS("T")="ONCOS"_YR_"ANAL/STAGE "_G D PRINT^ONCOSCT
- D KIL^ONCOSCT G EX
- ;
- S D0=0 F S D0=$O(^ONCO(165.5,"AG",1,D0)) Q:D0="" I $$DIV^ONCFUNC(D0)=DUZ(2) S ^DIBT(XD0,1,D0)="",G=$P($G(^ONCO(165.5,D0,2)),U,28) I G'="" S ^DIBT(XD(G),1,D0)=""
- ALL S D0=0 F S D0=$O(^ONCO(165.5,"AG",1,D0)) Q:D0="" I $$DIV^ONCFUNC(D0)=DUZ(2) S ^DIBT(XD0,1,D0)="",G=$P($G(^ONCO(165.5,D0,2)),U,28) I G'="" S ^DIBT(XD(G),1,D0)=""
- Q
- ;
- ANN ;SPECIFIED TIME FRAME
- S D1=BYR,D0=0 F S D0=$O(^ONCO(165.5,"AAY",D1,D0)) Q:D0="" I $$DIV^ONCFUNC(D0)=DUZ(2) S ^DIBT(XD0,1,D0)="",G=$P($G(^ONCO(165.5,D0,2)),U,28) I G'="" S ^DIBT(XD(G),1,D0)=""
- ;
- RGE ;RANGE of years for cases
- F D1=BYR:1:EYR S D0=0 D
- .F S D0=$O(^ONCO(165.5,"AAY",D1,D0)) Q:D0="" I $$DIV^ONCFUNC(D0)=DUZ(2) S ^DIBT(XD0,1,D0)="",G=$P($G(^ONCO(165.5,D0,2)),U,28) I G'="" S ^DIBT(XD(G),1,D0)=""
- Q
- SETV S (ONCOS("N"),ONCOS("Y"))="",ONCOS("F")="ONCOLOGY PRIMARY",ONCOS("TK")="",ONCOS("FI")="165.5^ONCOLOGY PRIMARY^ONCO(165.5,"
- Q
- HED ;DEFINE HEADER
- ;S ONCOS("H")=^DD("SITE")_" Years: "_HEAD ;" "_ONCOS("R")_"-"_ONCOS("C")
- S ONCOS("H")="Years: "_HEAD
- Q
- EX ;EXIT
- K IOP,FNAM,GBL,HLAB,NVA,ROWDEF,SL,TF,TX,W
- K %T,D,ONCOT,ONCOEX,ONCOS,XDA,XD,N,G,TEM,PER,COL,ROW,R D ^%ZISC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSCG 3048 printed Feb 18, 2025@23:52:03 Page 2
- ONCOSCG ;WASH ISC/SRR,MLH-CROSS TABS: STAGE & TREATMENT ;12/15/99
- +1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- TS ;individual stage group/treatment,Treatment by Stage
- +1 WRITE !?10,"This option will print cross-tabs for ALL ANALYTIC",!?10,"cases for TREATMENT by STAGE groups (I,II,III,IV)",!
- +2 ;call to ONCOST for time frame
- +3 SET ONCOT=1
- DO TF^ONCOST
- if $DATA(DIRUT)
- GOTO EX
- ROW ;SELECT ROW
- +1 KILL DIR
- SET DIR("A")=" Select Row"
- SET DIR(0)="SO^1:PRIMARY SITE/GP;2:ICDO-SITE;3:ICDO-TOPOGRAPHY;4:SELECTED SITES;5:SYSTEMS;6:HISTOLOGY (ICD-O-3)"
- DO ^DIR
- if $DATA(DIRUT)
- GOTO EX
- SET ONCOS("R")=$PIECE($PIECE(DIR(0),";",Y),":",2)
- +2 KILL DIR
- SET DIR("A")=" Percentages"
- SET DIR(0)="Y"
- WRITE !
- DO ^DIR
- if $DATA(DIRUT)
- GOTO EX
- SET ONCOS("P")=$SELECT(Y=0:"",1:1)
- +3 KILL IO("Q")
- SET %ZIS="Q"
- WRITE !!
- DO ^%ZIS
- SET IOP=ION
- IF POP
- SET ONCOUT=""
- GOTO EX
- +4 IF '$DATA(IO("Q"))
- DO TSK^ONCOSCG
- GOTO EX
- +5 SET ZTRTN="TSK^ONCOSCG"
- SET ZTDESC="ONCOLOGY STG/TX"
- SET ZTSAVE("ONCOS*")=""
- DO ^%ZTLOAD
- KILL ZTSK
- GOTO EX
- +6 ;
- TSK ;Tasked job to go through all 4 stages (use xref "ASG")
- +1 SET TF=ONCOS("YR")
- IF TF'="ALL"
- SET BYR=$PIECE(TF,U)
- SET EYR=$PIECE(TF,U,2)
- SET TF=$SELECT(BYR=EYR:"ANN",1:"RGE")
- +2 ;use ONCOS ANAL/...for Range or All ;ANNUAL for Annual
- SET YR=$SELECT(TF="ANN":" ANNUAL ",1:" ")
- G FOR G=0,"I","II","III","IV","U","NA"
- SET XD0=$ORDER(^DIBT("F165.5","ONCOS"_YR_"ANAL/STAGE "_G,0))
- if XD0'>0
- QUIT
- KILL ^DIBT(XD0,1)
- SET XD(G)=XD0
- SET $PIECE(^DIBT(XD0,0),U,2)=DT
- +1 SET XD0=$ORDER(^DIBT("F165.5","ONCOS"_$SELECT(TF="ANN":" ANNUAL-",1:" ")_"ANALYTIC",0))
- IF XD0'=""
- SET $PIECE(^DIBT(XD0,0),U,2)=DT
- KILL ^DIBT(XD0,1)
- GET SET HEAD=$SELECT(TF="ALL":"ALL",TF="ANN":BYR,1:BYR_"-"_EYR)
- +1 if TF="ALL"
- DO ALL
- if TF="ANN"
- DO ANN
- if TF="RGE"
- DO RGE
- TEM DO SETV
- DO HED
- SET ONCOS("T")="ONCOS "_$SELECT(TF="ANN":"ANNUAL-",1:"")_"ANALYTIC"
- ST SET ONCOEX=0
- FOR G="I","II","III","IV"
- if ONCOEX
- QUIT
- SET ONCOS("C")="GP-"_G_" AJCC SUMMARY STAGE"
- DO PRINT^ONCOSCT
- +1 if ONCOEX
- QUIT
- SET ONCOS("C")="TREATMENT"
- DO PRINT^ONCOSCT
- if ONCOEX
- QUIT
- +2 FOR G=0,"I","II","III","IV","U","NA"
- if ONCOEX
- QUIT
- SET ONCOS("T")="ONCOS"_YR_"ANAL/STAGE "_G
- DO PRINT^ONCOSCT
- +3 DO KIL^ONCOSCT
- GOTO EX
- +4 ;
- +5 SET D0=0
- FOR
- SET D0=$ORDER(^ONCO(165.5,"AG",1,D0))
- if D0=""
- QUIT
- IF $$DIV^ONCFUNC(D0)=DUZ(2)
- SET ^DIBT(XD0,1,D0)=""
- SET G=$PIECE($GET(^ONCO(165.5,D0,2)),U,28)
- IF G'=""
- SET ^DIBT(XD(G),1,D0)=""
- ALL SET D0=0
- FOR
- SET D0=$ORDER(^ONCO(165.5,"AG",1,D0))
- if D0=""
- QUIT
- IF $$DIV^ONCFUNC(D0)=DUZ(2)
- SET ^DIBT(XD0,1,D0)=""
- SET G=$PIECE($GET(^ONCO(165.5,D0,2)),U,28)
- IF G'=""
- SET ^DIBT(XD(G),1,D0)=""
- +1 QUIT
- +2 ;
- ANN ;SPECIFIED TIME FRAME
- +1 SET D1=BYR
- SET D0=0
- FOR
- SET D0=$ORDER(^ONCO(165.5,"AAY",D1,D0))
- if D0=""
- QUIT
- IF $$DIV^ONCFUNC(D0)=DUZ(2)
- SET ^DIBT(XD0,1,D0)=""
- SET G=$PIECE($GET(^ONCO(165.5,D0,2)),U,28)
- IF G'=""
- SET ^DIBT(XD(G),1,D0)=""
- +2 ;
- RGE ;RANGE of years for cases
- +1 FOR D1=BYR:1:EYR
- SET D0=0
- Begin DoDot:1
- +2 FOR
- SET D0=$ORDER(^ONCO(165.5,"AAY",D1,D0))
- if D0=""
- QUIT
- IF $$DIV^ONCFUNC(D0)=DUZ(2)
- SET ^DIBT(XD0,1,D0)=""
- SET G=$PIECE($GET(^ONCO(165.5,D0,2)),U,28)
- IF G'=""
- SET ^DIBT(XD(G),1,D0)=""
- End DoDot:1
- +3 QUIT
- SETV SET (ONCOS("N"),ONCOS("Y"))=""
- SET ONCOS("F")="ONCOLOGY PRIMARY"
- SET ONCOS("TK")=""
- SET ONCOS("FI")="165.5^ONCOLOGY PRIMARY^ONCO(165.5,"
- +1 QUIT
- HED ;DEFINE HEADER
- +1 ;S ONCOS("H")=^DD("SITE")_" Years: "_HEAD ;" "_ONCOS("R")_"-"_ONCOS("C")
- +2 SET ONCOS("H")="Years: "_HEAD
- +3 QUIT
- EX ;EXIT
- +1 KILL IOP,FNAM,GBL,HLAB,NVA,ROWDEF,SL,TF,TX,W
- +2 KILL %T,D,ONCOT,ONCOEX,ONCOS,XDA,XD,N,G,TEM,PER,COL,ROW,R
- DO ^%ZISC
- +3 QUIT
