ONCOSC1 ;WASH ISC/SRR-CROSS TAB REPORT TASKS ;12/14/99
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
TOT ;Task for Total Registry Cross Tabs
;in: ONCOS*
K ER S ONCOEX=0 D SETV,TEM G EX:$D(ER) S ONCOS("T")=$S(TEM="ALL":TEM,1:XDG_U_TEM) I ONCOS("C")'="ALL" D PRINT^ONCOSCT G EX
S ONCOS("TK")="" F CT=1:1:$S(ONCOS("GP")=1:15,1:12) Q:ONCOEX S ONCOS("C")=$P($P(ONCOS("CT"),";",CT),":",2) D PRINT^ONCOSCT
G EX
;
SETV ;RESET VARIABLES
S (ONCOS("N"),ONCOS("Y"))="",ONCOS("FI")="165.5^ONCOLOGY PRIMARY^ONCO(165.5,"
Q
;
TEM ;Setup templates
S YR=ONCOS("YR"),GP=ONCOS("GP"),BYR=+ONCOS("YR"),EYR=$P(ONCOS("YR"),U,2) G ALL:YR="ALL",ANN:BYR=EYR,RGE
Q
;
ALL S TEM="ONCOS TOTAL-",TEM=$S(GP=0:TEM_"NON",GP=1:TEM_"ANAL",1:"ALL")
Q:TEM="ALL" S XDG=$O(^DIBT("F165.5",TEM,0)) Q:XDG="" K ^DIBT(XDG,1)
I GP<2 S XD0=0 F S XD0=$O(^ONCO(165.5,"AG",GP,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) S ^DIBT(XDG,1,XD0)=""
I GP=2 F GP=0,2 S XD0=0 D
.F S XD0=$O(^ONCO(165.5,"AG",GP,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) S ^DIBT(XDG,1,XD0)=""
Q
;
ANN S TEM="ONCOS ANNUAL-",TEM=TEM_$S(GP=1:"ANALYTIC",GP=0:"NON ANAL",1:"ALLCASES")
S XDG=$O(^DIBT("F165.5",TEM,0)) Q:XDG="" K ^DIBT(XDG,1)
S XD0=0 F S XD0=$O(^ONCO(165.5,"AY",+YR,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) D
.I GP=2 S ^DIBT(XDG,1,XD0)="" Q
.I $P(^ONCO(165.5,XD0,0),U,20)=GP S ^DIBT(XDG,1,XD0)=""
Q
;
RGE S TEM="ONCOS RANGE-",TEM=$S(GP=1:TEM_"ANALYTIC",GP=0:TEM_"NON ANAL",1:TEM_"ALLCASES")
S XDG=$O(^DIBT("F165.5",TEM,0)) Q:XDG="" K ^DIBT(XDG,1)
S XD0=0 F YY=BYR:1:EYR D
.F S XD0=$O(^ONCO(165.5,"AY",YY,XD0)) Q:XD0="" I $$DIV^ONCFUNC(XD0)=DUZ(2) D
..I GP=2 S ^DIBT(XDG,1,XD0)="" Q
..I $P(^ONCO(165.5,XD0,0),U,20)=GP S ^DIBT(XDG,1,XD0)=""
Q
ERR ;NO TEMPLATE
S XD0=0 F S XD0=$O(^ONCO(165.5,"AG",0,XD0)) Q:XD0=""
EX ;EXIT
D KIL^ONCOSCT K CT,J,K,%DT,%ZISOS,BYR,EYR,GLO,OT,ROWDEF,TF,W,YR,B,C,CO,DIC,ER,F,GP,ONCOEX
K I,HEAD,%T,%I,XCOL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSC1 1955 printed Dec 13, 2024@02:25:31 Page 2
ONCOSC1 ;WASH ISC/SRR-CROSS TAB REPORT TASKS ;12/14/99
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
TOT ;Task for Total Registry Cross Tabs
+1 ;in: ONCOS*
+2 KILL ER
SET ONCOEX=0
DO SETV
DO TEM
if $DATA(ER)
GOTO EX
SET ONCOS("T")=$SELECT(TEM="ALL":TEM,1:XDG_U_TEM)
IF ONCOS("C")'="ALL"
DO PRINT^ONCOSCT
GOTO EX
+3 SET ONCOS("TK")=""
FOR CT=1:1:$SELECT(ONCOS("GP")=1:15,1:12)
if ONCOEX
QUIT
SET ONCOS("C")=$PIECE($PIECE(ONCOS("CT"),";",CT),":",2)
DO PRINT^ONCOSCT
+4 GOTO EX
+5 ;
SETV ;RESET VARIABLES
+1 SET (ONCOS("N"),ONCOS("Y"))=""
SET ONCOS("FI")="165.5^ONCOLOGY PRIMARY^ONCO(165.5,"
+2 QUIT
+3 ;
TEM ;Setup templates
+1 SET YR=ONCOS("YR")
SET GP=ONCOS("GP")
SET BYR=+ONCOS("YR")
SET EYR=$PIECE(ONCOS("YR"),U,2)
if YR="ALL"
GOTO ALL
if BYR=EYR
GOTO ANN
GOTO RGE
+2 QUIT
+3 ;
ALL SET TEM="ONCOS TOTAL-"
SET TEM=$SELECT(GP=0:TEM_"NON",GP=1:TEM_"ANAL",1:"ALL")
+1 if TEM="ALL"
QUIT
SET XDG=$ORDER(^DIBT("F165.5",TEM,0))
if XDG=""
QUIT
KILL ^DIBT(XDG,1)
+2 IF GP<2
SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(165.5,"AG",GP,XD0))
if XD0=""
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
SET ^DIBT(XDG,1,XD0)=""
+3 IF GP=2
FOR GP=0,2
SET XD0=0
Begin DoDot:1
+4 FOR
SET XD0=$ORDER(^ONCO(165.5,"AG",GP,XD0))
if XD0=""
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
SET ^DIBT(XDG,1,XD0)=""
End DoDot:1
+5 QUIT
+6 ;
ANN SET TEM="ONCOS ANNUAL-"
SET TEM=TEM_$SELECT(GP=1:"ANALYTIC",GP=0:"NON ANAL",1:"ALLCASES")
+1 SET XDG=$ORDER(^DIBT("F165.5",TEM,0))
if XDG=""
QUIT
KILL ^DIBT(XDG,1)
+2 SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(165.5,"AY",+YR,XD0))
if XD0=""
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
Begin DoDot:1
+3 IF GP=2
SET ^DIBT(XDG,1,XD0)=""
QUIT
+4 IF $PIECE(^ONCO(165.5,XD0,0),U,20)=GP
SET ^DIBT(XDG,1,XD0)=""
End DoDot:1
+5 QUIT
+6 ;
RGE SET TEM="ONCOS RANGE-"
SET TEM=$SELECT(GP=1:TEM_"ANALYTIC",GP=0:TEM_"NON ANAL",1:TEM_"ALLCASES")
+1 SET XDG=$ORDER(^DIBT("F165.5",TEM,0))
if XDG=""
QUIT
KILL ^DIBT(XDG,1)
+2 SET XD0=0
FOR YY=BYR:1:EYR
Begin DoDot:1
+3 FOR
SET XD0=$ORDER(^ONCO(165.5,"AY",YY,XD0))
if XD0=""
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
Begin DoDot:2
+4 IF GP=2
SET ^DIBT(XDG,1,XD0)=""
QUIT
+5 IF $PIECE(^ONCO(165.5,XD0,0),U,20)=GP
SET ^DIBT(XDG,1,XD0)=""
End DoDot:2
End DoDot:1
+6 QUIT
ERR ;NO TEMPLATE
+1 SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(165.5,"AG",0,XD0))
if XD0=""
QUIT
EX ;EXIT
+1 DO KIL^ONCOSCT
KILL CT,J,K,%DT,%ZISOS,BYR,EYR,GLO,OT,ROWDEF,TF,W,YR,B,C,CO,DIC,ER,F,GP,ONCOEX
+2 KILL I,HEAD,%T,%I,XCOL
+3 QUIT
