- 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 Mar 13, 2025@21:30:28 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
