ONCOSSA ;WASH ISC/SRR,MLH-SURVIVAL ANALYSIS ;11/5/93 15:14
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;ONCOS - used to force responses to setup prompts:
;("F") = file name
;("T") = sort template
;("D") = duration field name^time unit letter^interval letter
; e.g., "MOS FU^M^Y" for months followup, life table in years
;("S") = status expression
;("G") = number of groups^expression
;("G",n) = field number^title for nth group^expression, e.g., VAL(7)=0
;("L") = ] "P" for plots, "Y" to skip yes prompts
;("I") = IOP variable for %ZIS
PRINT ;entry point for qued report (%ZTLOAD)
S U="^",%=0
D GETFILE^ONCOSINP:'$D(ONCOS("FI")) G EX:$G(Y)<0 S FIL=ONCOS("FI"),FNUM=+FIL,GBL=U_$P(FIL,U,3)
S FNUM=+ONCOS("FI") D GETTEMPL^ONCOSINP G:$G(Y)<0 EX S HEADER=$P(Y,U,2),TEMPL=+Y
K ^TMP($J),IO("Q") D GET^ONCOSSA1 G:$G(Y)<0 EX ;get specs
K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP EX
I $D(IO("Q")) S ONCOLST="COND^COND(^FIL^FLDDAT(^FNUM^GBL^GRPEXP^HEADER^I^J^LEN^LENEXP^MAXTIME^MORTEXP^N^NGRPS^NM^ONCOS(^PLOT^TEMPL^VAL" D TASK G EX
U IO D PRT D ^%ZISC K %ZIS,IOP G EX
PRT S (D0,NMORT,NDROP,NPG)=0,XCRT=$S(IOST?1"C".E:1,1:0) D:XCRT WAIT^DICD
F N=1:1 S D0=$S(TEMPL:$O(^DIBT(TEMPL,1,D0)),1:$O(@(GBL_"D0)"))) Q:D0'?1N.N D CTCASE
S %DT="T",X="NOW" D ^%DT X ^DD("DD")
S X=$P(@(GBL_"0)"),U,1)_$S(TEMPL:" Template "_HEADER,1:"")_" "
S HEADER=X_U_$P(Y,"@",1)_" "_$P(Y,"@",2)
I NDROP W !!,$P(HEADER,U,1),?IOM-30,$P(HEADER,U,2) W !!,"Cases dropped: ",NDROP,! D I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y G EX
.W !,"PATIENT",?30,"REASON FOR BEING DROPPED"
.W !,"--------------------------",?30,"----------------------------"
.S DROPD0=0 F S DROPD0=$O(DROP(DROPD0)) Q:DROPD0'>0 D
..W !,$$GET1^DIQ(165.5,DROPD0,.025)," ",$$GET1^DIQ(165.5,DROPD0,.02),?30,$P(DROP(DROPD0),U,1),?51,$P(DROP(DROPD0),U,2)
S HEADER=HEADER_" Page "
S Y=0 F GRP=1:1:NGRPS S (CASES(GRP),INT(GRP))=0
F GRP=0:0 S:GRP INTS(GRP)=Y S GRP=$O(^TMP($J,"LT",GRP)) Q:GRP="" D SLOOP
D PRINT^ONCOSSA3,PLOT^ONCOSSA4:PLOT,TOF^ONCOSSA3
EX K ^TMP($J)
K CASES,COND,D0,FLDDAT,FNUM,GBL,GRP,GRPEXP,HEADER,INTS,LEN,LENEXP
K MAXTIME,MORTEXP,N,NDROP,NGRPS,NMORT,NPG,NTOT,ONCOS,PLOT,POP,TEMPL
K X,XCRT,Y,Z,DROP,DROPD0,DROPRSN
Q
;
CTCASE ;count case
N FLDNUM,GRP,IGRP,MORT,SLEN,VAL,DROPRSN
S DROPRSN=""
W:XCRT&(N#100=1) "." Q:'$D(@(GBL_"D0)")) S FLDNUM=0
F IGRP=1:1 S FLDNUM=$O(FLDDAT(FLDNUM)) Q:FLDNUM="" D GETFLD S VAL(FLDNUM)=Y
S @("MORT="_MORTEXP),@("SLEN="_LENEXP)
I COND S @("GRP="_GRPEXP)
E S GRP=0 F IGRP=1:1:NGRPS I @COND(IGRP) S GRP=IGRP Q
I GRP=0 D G:DROPRSN'="" DROP
.I $D(VAL(38.5)) S VAL=VAL(38.5),DROPRSN="STAGE GROUPING-AJCC^"_$S(VAL=0:0,VAL="U":"Unk/Uns",VAL="NA":"NA",1:VAL) Q
.I $D(VAL(43)) S VAL=VAL(43),DROPRSN="TREATMENT^"_VAL
I SLEN'=0 S SLEN=+SLEN I SLEN=0 S GRP=0,DROPRSN=$P($G(ONCOS("D")),U,1)_"^0"
DROP I GRP<1!(GRP>NGRPS) S NDROP=NDROP+1 S DROP(D0)=DROPRSN Q
S:SLEN>MAXTIME SLEN=MAXTIME,MORT=0
S:'$D(^TMP($J,"LT",GRP,SLEN\+LEN,MORT)) ^(MORT)=0 S ^(MORT)=^(MORT)+1
I PLOT S:'$D(^TMP($J,"KM",GRP,SLEN,MORT)) ^(MORT)=0 S ^(MORT)=^(MORT)+1
Q
;
GETFLD ;get field
;in: D0,GBL,FLDNUM,FLDDAT
;out: Y
S Y="",X=FLDDAT(FLDNUM)
I +X,$D(@(GBL_"D0,$P(X,U,2))")) S Y=$P(^($P(X,U,2)),U,$P(X,U,3))
I '(+X) X $P(X,U,2,99) S Y=X
Q
;
SLOOP ;loop through data & sum totals
S X=-1 F S X=$O(^TMP($J,"LT",GRP,X)) Q:X="" S Y=X D
.I $D(^TMP($J,"LT",GRP,X,0)) S CASES(GRP)=CASES(GRP)+^(0)
.I $D(^TMP($J,"LT",GRP,X,1)) S CASES(GRP)=CASES(GRP)+^(1),NMORT=NMORT+^(1)
Q
TASK ;Queue a task
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
S ZTRTN="PRT^ONCOSSA",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTDESC="ONCOLOGY STATISTICAL REPORT"
F V2=1:1 S V1=$P(ONCOLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
S ZTSAVE("^TMP($J,")=""
D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
K V1,V2,ONCOLST,ZTSK Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSSA 3875 printed Apr 09, 2024@21:30:51 Page 2
ONCOSSA ;WASH ISC/SRR,MLH-SURVIVAL ANALYSIS ;11/5/93 15:14
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;ONCOS - used to force responses to setup prompts:
+3 ;("F") = file name
+4 ;("T") = sort template
+5 ;("D") = duration field name^time unit letter^interval letter
+6 ; e.g., "MOS FU^M^Y" for months followup, life table in years
+7 ;("S") = status expression
+8 ;("G") = number of groups^expression
+9 ;("G",n) = field number^title for nth group^expression, e.g., VAL(7)=0
+10 ;("L") = ] "P" for plots, "Y" to skip yes prompts
+11 ;("I") = IOP variable for %ZIS
PRINT ;entry point for qued report (%ZTLOAD)
+1 SET U="^"
SET %=0
+2 if '$DATA(ONCOS("FI"))
DO GETFILE^ONCOSINP
if $GET(Y)<0
GOTO EX
SET FIL=ONCOS("FI")
SET FNUM=+FIL
SET GBL=U_$PIECE(FIL,U,3)
+3 SET FNUM=+ONCOS("FI")
DO GETTEMPL^ONCOSINP
if $GET(Y)<0
GOTO EX
SET HEADER=$PIECE(Y,U,2)
SET TEMPL=+Y
+4 ;get specs
KILL ^TMP($JOB),IO("Q")
DO GET^ONCOSSA1
if $GET(Y)<0
GOTO EX
+5 KILL IOP,%ZIS
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO EX
+6 IF $DATA(IO("Q"))
SET ONCOLST="COND^COND(^FIL^FLDDAT(^FNUM^GBL^GRPEXP^HEADER^I^J^LEN^LENEXP^MAXTIME^MORTEXP^N^NGRPS^NM^ONCOS(^PLOT^TEMPL^VAL"
DO TASK
GOTO EX
+7 USE IO
DO PRT
DO ^%ZISC
KILL %ZIS,IOP
GOTO EX
PRT SET (D0,NMORT,NDROP,NPG)=0
SET XCRT=$SELECT(IOST?1"C".E:1,1:0)
if XCRT
DO WAIT^DICD
+1 FOR N=1:1
SET D0=$SELECT(TEMPL:$ORDER(^DIBT(TEMPL,1,D0)),1:$ORDER(@(GBL_"D0)")))
if D0'?1N.N
QUIT
DO CTCASE
+2 SET %DT="T"
SET X="NOW"
DO ^%DT
XECUTE ^DD("DD")
+3 SET X=$PIECE(@(GBL_"0)"),U,1)_$SELECT(TEMPL:" Template "_HEADER,1:"")_" "
+4 SET HEADER=X_U_$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2)
+5 IF NDROP
WRITE !!,$PIECE(HEADER,U,1),?IOM-30,$PIECE(HEADER,U,2)
WRITE !!,"Cases dropped: ",NDROP,!
Begin DoDot:1
+6 WRITE !,"PATIENT",?30,"REASON FOR BEING DROPPED"
+7 WRITE !,"--------------------------",?30,"----------------------------"
+8 SET DROPD0=0
FOR
SET DROPD0=$ORDER(DROP(DROPD0))
if DROPD0'>0
QUIT
Begin DoDot:2
+9 WRITE !,$$GET1^DIQ(165.5,DROPD0,.025)," ",$$GET1^DIQ(165.5,DROPD0,.02),?30,$PIECE(DROP(DROPD0),U,1),?51,$PIECE(DROP(DROPD0),U,2)
End DoDot:2
End DoDot:1
IF IOST?1"C".E
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
GOTO EX
+10 SET HEADER=HEADER_" Page "
+11 SET Y=0
FOR GRP=1:1:NGRPS
SET (CASES(GRP),INT(GRP))=0
+12 FOR GRP=0:0
if GRP
SET INTS(GRP)=Y
SET GRP=$ORDER(^TMP($JOB,"LT",GRP))
if GRP=""
QUIT
DO SLOOP
+13 DO PRINT^ONCOSSA3
if PLOT
DO PLOT^ONCOSSA4
DO TOF^ONCOSSA3
EX KILL ^TMP($JOB)
+1 KILL CASES,COND,D0,FLDDAT,FNUM,GBL,GRP,GRPEXP,HEADER,INTS,LEN,LENEXP
+2 KILL MAXTIME,MORTEXP,N,NDROP,NGRPS,NMORT,NPG,NTOT,ONCOS,PLOT,POP,TEMPL
+3 KILL X,XCRT,Y,Z,DROP,DROPD0,DROPRSN
+4 QUIT
+5 ;
CTCASE ;count case
+1 NEW FLDNUM,GRP,IGRP,MORT,SLEN,VAL,DROPRSN
+2 SET DROPRSN=""
+3 if XCRT&(N#100=1)
WRITE "."
if '$DATA(@(GBL_"D0)"))
QUIT
SET FLDNUM=0
+4 FOR IGRP=1:1
SET FLDNUM=$ORDER(FLDDAT(FLDNUM))
if FLDNUM=""
QUIT
DO GETFLD
SET VAL(FLDNUM)=Y
+5 SET @("MORT="_MORTEXP)
SET @("SLEN="_LENEXP)
+6 IF COND
SET @("GRP="_GRPEXP)
+7 IF '$TEST
SET GRP=0
FOR IGRP=1:1:NGRPS
IF @COND(IGRP)
SET GRP=IGRP
QUIT
+8 IF GRP=0
Begin DoDot:1
+9 IF $DATA(VAL(38.5))
SET VAL=VAL(38.5)
SET DROPRSN="STAGE GROUPING-AJCC^"_$SELECT(VAL=0:0,VAL="U":"Unk/Uns",VAL="NA":"NA",1:VAL)
QUIT
+10 IF $DATA(VAL(43))
SET VAL=VAL(43)
SET DROPRSN="TREATMENT^"_VAL
End DoDot:1
if DROPRSN'=""
GOTO DROP
+11 IF SLEN'=0
SET SLEN=+SLEN
IF SLEN=0
SET GRP=0
SET DROPRSN=$PIECE($GET(ONCOS("D")),U,1)_"^0"
DROP IF GRP<1!(GRP>NGRPS)
SET NDROP=NDROP+1
SET DROP(D0)=DROPRSN
QUIT
+1 if SLEN>MAXTIME
SET SLEN=MAXTIME
SET MORT=0
+2 if '$DATA(^TMP($JOB,"LT",GRP,SLEN\+LEN,MORT))
SET ^(MORT)=0
SET ^(MORT)=^(MORT)+1
+3 IF PLOT
if '$DATA(^TMP($JOB,"KM",GRP,SLEN,MORT))
SET ^(MORT)=0
SET ^(MORT)=^(MORT)+1
+4 QUIT
+5 ;
GETFLD ;get field
+1 ;in: D0,GBL,FLDNUM,FLDDAT
+2 ;out: Y
+3 SET Y=""
SET X=FLDDAT(FLDNUM)
+4 IF +X
IF $DATA(@(GBL_"D0,$P(X,U,2))"))
SET Y=$PIECE(^($PIECE(X,U,2)),U,$PIECE(X,U,3))
+5 IF '(+X)
XECUTE $PIECE(X,U,2,99)
SET Y=X
+6 QUIT
+7 ;
SLOOP ;loop through data & sum totals
+1 SET X=-1
FOR
SET X=$ORDER(^TMP($JOB,"LT",GRP,X))
if X=""
QUIT
SET Y=X
Begin DoDot:1
+2 IF $DATA(^TMP($JOB,"LT",GRP,X,0))
SET CASES(GRP)=CASES(GRP)+^(0)
+3 IF $DATA(^TMP($JOB,"LT",GRP,X,1))
SET CASES(GRP)=CASES(GRP)+^(1)
SET NMORT=NMORT+^(1)
End DoDot:1
+4 QUIT
TASK ;Queue a task
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
+2 SET ZTRTN="PRT^ONCOSSA"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+3 SET ZTDESC="ONCOLOGY STATISTICAL REPORT"
+4 FOR V2=1:1
SET V1=$PIECE(ONCOLST,"^",V2)
if V1=""
QUIT
SET ZTSAVE(V1)=""
+5 SET ZTSAVE("^TMP($J,")=""
+6 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
+7 KILL V1,V2,ONCOLST,ZTSK
QUIT
