ONCOSSA1 ;WASH ISC/SRR-SURVIAL ANALYSIS CONT-1 ;4/16/92 18:31
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
CHKCOND ;check condition
;in: DIC,TIN,^DD(FNUM
;out: P = 0 if OK
; TOU = condition
; FLDDAT(f) = 1^node^piece^codes for real; 0^expression for computed
;do: ^DIM
N C,E,FLDOK,FLD,L,Q
S E=1,(FLDOK,P)=0,TOU="",Q=$C(34)
F L=1:1:$L(TIN) S C=$E(TIN,L),TOU=TOU_C S:C=Q E=1-E I C?1U,E D CHK
I P W !,?20,"Re-enter condition - may need explicit quotes." Q
I 'FLDOK W !,?20,"No valid fields - please re-enter." S P=1 Q
S X="S X="_TOU D ^DIM I $D(X)=0 S P=1 W !," Check MUMPS syntax."
Q
;
CHK ;check for field
S FLD=C
CHK1 S L=L+1,C=$E(TIN,L),TOU=TOU_C I C?1UN!(C=" ") S FLD=FLD_C G CHK1
Q:FLD'?1U.UNP S X=FLD D ^DIC
I Y=-1 W !,?20,"Field ",FLD," ???" S P=1 Q
S FLDOK=1,X=+Y D SETFD
S Y=$F(TOU,FLD),X=$E(TOU,1,Y-1-$L(FLD))_"VAL("_X_")"_$E(TOU,Y,99),TOU=X
Q
;
SETFD ;set FLDDAT( with field info
;in: X,^DD(FNUM,
;out: FLDDAT(,Y
Q:$D(FLDDAT(X))!'$D(^DD(FNUM,X,0)) S Y=^(0)
I $P(Y,U,2)["C" S Y="0"_U_$P(Y,U,5,99)
E S %=$S($P(Y,U,2)["S":U_$P(Y,U,3),1:""),Y=$P(Y,U,4),Y="1"_U_$P(Y,";",1)_U_+$P(Y,";",2)_%
S FLDDAT(X)=Y
Q
;
GET ;get specs for survival analysis
;in: ^DD(FNUM,
;out: LEN = conversion divisor^duration unit^interval unit
; COND = 1 for subgroup expression, 0 for group conditions
; (n) = nth group condition
; FLDDAT = see CHKCOND
; MAXTIME= maximum time allowed
; NGRPS = number of subgroups
; MORTEXP= dead expression
; LENEXP = duration expression
; GRPEXP = subgroup expression
; PLOT = 1 for curves plotted
; ^TMP($J,"GRP",n) = title for nth group
;do: CHKCOND,^DIC,^DIM
N DIC,P,TIN,TOU
S DIC="^DD(FNUM,",DIC("S")="I +$P(^(0),U,2)=0 "
S DIC("A")="Select survival DURATION field: "
S LEN=$S($D(ONCOS("D")):ONCOS("D"),1:""),TIN=$P(LEN,U,1)
I TIN'="" W !,"DURATION field: ",TIN G GET11
GET1 S DIC(0)="AEQ" D ^DIC Q:Y<0 S TIN=$P(Y,U,2)
GET11 S DIC(0)="E" D CHKCOND G:P GET1 S LENEXP=TOU,TIN=$P(LEN,U,2) G:TIN'="" GET21
GET2 W !,"DURATION unit (Day, Wk, Mo, Yr): " R TIN:DTIME E S TIN="^"
I TIN[U S Y=-1 Q
GET21 S TIN=$E(TIN,1) S:TIN?1L TIN=$C($A(TIN)-32)
I '$F("DWMY",TIN) W !,"Enter a time unit letter such as 'D' for Days" G GET2
S $P(LEN,U,1,2)=$S(TIN="D":"365.25^Days",TIN="W":"52^Weeks",TIN="M":"12^Mos",1:"1^Yrs")
S MAXTIME=+LEN*10,TIN=$P(LEN,U,3) G:TIN'="" GET23
GET22 W !,"INTERVAL unit (Mo, Yr): Yr// " R TIN:DTIME E S TIN="^"
S:TIN="" TIN="Y" I TIN[U S Y=-1 Q
GET23 S TIN=$E(TIN,1) S:TIN?1L TIN=$C($A(TIN)-32)
I '$F("MY",TIN) W !,"Enter 'M' for Months or 'Y' for Years" G GET22
I TIN="Y" S $P(LEN,U,3)="Yrs"
E S $P(LEN,U,3)="Mos",TIN=$P(LEN,U,1),$P(LEN,U,1)=TIN/12
GET3 I $D(ONCOS("S")) S TIN=ONCOS("S") W !,"STATUS expression: ",TIN G GET4
W !,"Enter survival STATUS expression: " R TIN:DTIME E S TIN="^"
I TIN[U S Y=-1 Q
G:TIN'?."?" GET4 W !!,"Enter an expression like 'STATUS=0' to indicate"
W !,"that the patient is dead. In this example, 'STATUS' is"
W !,"the name of a field that is a set of codes, for which 1 means"
W !,"'living' and 0 means 'dead'.",! G GET3
GET4 D CHKCOND G:P GET3 S MORTEXP=TOU
I $D(ONCOS("G")) S NGRPS=+ONCOS("G") G:NGRPS GET41
R !,"Number of sub-groups: 1// ",NGRPS:DTIME E S NGRPS="^"
S:NGRPS="" NGRPS=1 I NGRPS[U S Y=-1 Q
GET41 I NGRPS=1 S COND=1,GRPEXP=1
E D SETGRPS^ONCOSSA2 G:NGRPS=1 GET41
I $D(ONCOS("L")) S PLOT=$S(ONCOS("L")["P":1,1:0) Q:ONCOS("L")["Y" G GET5
S Y="Do you want curves plotted? No// "
D GETYES^ONCOSINP Q:Y=-1 S PLOT=$T
GET5 W ! S Y="Survival analysis for "
S Y=Y_$S(TEMPL:"template "_HEADER,1:"ALL cases")
S Y=Y_" - OK? Yes// " D GETYES^ONCOSINP S:'$T Y=-1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSSA1 3772 printed Sep 23, 2025@20:01:48 Page 2
ONCOSSA1 ;WASH ISC/SRR-SURVIAL ANALYSIS CONT-1 ;4/16/92 18:31
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
CHKCOND ;check condition
+1 ;in: DIC,TIN,^DD(FNUM
+2 ;out: P = 0 if OK
+3 ; TOU = condition
+4 ; FLDDAT(f) = 1^node^piece^codes for real; 0^expression for computed
+5 ;do: ^DIM
+6 NEW C,E,FLDOK,FLD,L,Q
+7 SET E=1
SET (FLDOK,P)=0
SET TOU=""
SET Q=$CHAR(34)
+8 FOR L=1:1:$LENGTH(TIN)
SET C=$EXTRACT(TIN,L)
SET TOU=TOU_C
if C=Q
SET E=1-E
IF C?1U
IF E
DO CHK
+9 IF P
WRITE !,?20,"Re-enter condition - may need explicit quotes."
QUIT
+10 IF 'FLDOK
WRITE !,?20,"No valid fields - please re-enter."
SET P=1
QUIT
+11 SET X="S X="_TOU
DO ^DIM
IF $DATA(X)=0
SET P=1
WRITE !," Check MUMPS syntax."
+12 QUIT
+13 ;
CHK ;check for field
+1 SET FLD=C
CHK1 SET L=L+1
SET C=$EXTRACT(TIN,L)
SET TOU=TOU_C
IF C?1UN!(C=" ")
SET FLD=FLD_C
GOTO CHK1
+1 if FLD'?1U.UNP
QUIT
SET X=FLD
DO ^DIC
+2 IF Y=-1
WRITE !,?20,"Field ",FLD," ???"
SET P=1
QUIT
+3 SET FLDOK=1
SET X=+Y
DO SETFD
+4 SET Y=$FIND(TOU,FLD)
SET X=$EXTRACT(TOU,1,Y-1-$LENGTH(FLD))_"VAL("_X_")"_$EXTRACT(TOU,Y,99)
SET TOU=X
+5 QUIT
+6 ;
SETFD ;set FLDDAT( with field info
+1 ;in: X,^DD(FNUM,
+2 ;out: FLDDAT(,Y
+3 if $DATA(FLDDAT(X))!'$DATA(^DD(FNUM,X,0))
QUIT
SET Y=^(0)
+4 IF $PIECE(Y,U,2)["C"
SET Y="0"_U_$PIECE(Y,U,5,99)
+5 IF '$TEST
SET %=$SELECT($PIECE(Y,U,2)["S":U_$PIECE(Y,U,3),1:"")
SET Y=$PIECE(Y,U,4)
SET Y="1"_U_$PIECE(Y,";",1)_U_+$PIECE(Y,";",2)_%
+6 SET FLDDAT(X)=Y
+7 QUIT
+8 ;
GET ;get specs for survival analysis
+1 ;in: ^DD(FNUM,
+2 ;out: LEN = conversion divisor^duration unit^interval unit
+3 ; COND = 1 for subgroup expression, 0 for group conditions
+4 ; (n) = nth group condition
+5 ; FLDDAT = see CHKCOND
+6 ; MAXTIME= maximum time allowed
+7 ; NGRPS = number of subgroups
+8 ; MORTEXP= dead expression
+9 ; LENEXP = duration expression
+10 ; GRPEXP = subgroup expression
+11 ; PLOT = 1 for curves plotted
+12 ; ^TMP($J,"GRP",n) = title for nth group
+13 ;do: CHKCOND,^DIC,^DIM
+14 NEW DIC,P,TIN,TOU
+15 SET DIC="^DD(FNUM,"
SET DIC("S")="I +$P(^(0),U,2)=0 "
+16 SET DIC("A")="Select survival DURATION field: "
+17 SET LEN=$SELECT($DATA(ONCOS("D")):ONCOS("D"),1:"")
SET TIN=$PIECE(LEN,U,1)
+18 IF TIN'=""
WRITE !,"DURATION field: ",TIN
GOTO GET11
GET1 SET DIC(0)="AEQ"
DO ^DIC
if Y<0
QUIT
SET TIN=$PIECE(Y,U,2)
GET11 SET DIC(0)="E"
DO CHKCOND
if P
GOTO GET1
SET LENEXP=TOU
SET TIN=$PIECE(LEN,U,2)
if TIN'=""
GOTO GET21
GET2 WRITE !,"DURATION unit (Day, Wk, Mo, Yr): "
READ TIN:DTIME
IF '$TEST
SET TIN="^"
+1 IF TIN[U
SET Y=-1
QUIT
GET21 SET TIN=$EXTRACT(TIN,1)
if TIN?1L
SET TIN=$CHAR($ASCII(TIN)-32)
+1 IF '$FIND("DWMY",TIN)
WRITE !,"Enter a time unit letter such as 'D' for Days"
GOTO GET2
+2 SET $PIECE(LEN,U,1,2)=$SELECT(TIN="D":"365.25^Days",TIN="W":"52^Weeks",TIN="M":"12^Mos",1:"1^Yrs")
+3 SET MAXTIME=+LEN*10
SET TIN=$PIECE(LEN,U,3)
if TIN'=""
GOTO GET23
GET22 WRITE !,"INTERVAL unit (Mo, Yr): Yr// "
READ TIN:DTIME
IF '$TEST
SET TIN="^"
+1 if TIN=""
SET TIN="Y"
IF TIN[U
SET Y=-1
QUIT
GET23 SET TIN=$EXTRACT(TIN,1)
if TIN?1L
SET TIN=$CHAR($ASCII(TIN)-32)
+1 IF '$FIND("MY",TIN)
WRITE !,"Enter 'M' for Months or 'Y' for Years"
GOTO GET22
+2 IF TIN="Y"
SET $PIECE(LEN,U,3)="Yrs"
+3 IF '$TEST
SET $PIECE(LEN,U,3)="Mos"
SET TIN=$PIECE(LEN,U,1)
SET $PIECE(LEN,U,1)=TIN/12
GET3 IF $DATA(ONCOS("S"))
SET TIN=ONCOS("S")
WRITE !,"STATUS expression: ",TIN
GOTO GET4
+1 WRITE !,"Enter survival STATUS expression: "
READ TIN:DTIME
IF '$TEST
SET TIN="^"
+2 IF TIN[U
SET Y=-1
QUIT
+3 if TIN'?."?"
GOTO GET4
WRITE !!,"Enter an expression like 'STATUS=0' to indicate"
+4 WRITE !,"that the patient is dead. In this example, 'STATUS' is"
+5 WRITE !,"the name of a field that is a set of codes, for which 1 means"
+6 WRITE !,"'living' and 0 means 'dead'.",!
GOTO GET3
GET4 DO CHKCOND
if P
GOTO GET3
SET MORTEXP=TOU
+1 IF $DATA(ONCOS("G"))
SET NGRPS=+ONCOS("G")
if NGRPS
GOTO GET41
+2 READ !,"Number of sub-groups: 1// ",NGRPS:DTIME
IF '$TEST
SET NGRPS="^"
+3 if NGRPS=""
SET NGRPS=1
IF NGRPS[U
SET Y=-1
QUIT
GET41 IF NGRPS=1
SET COND=1
SET GRPEXP=1
+1 IF '$TEST
DO SETGRPS^ONCOSSA2
if NGRPS=1
GOTO GET41
+2 IF $DATA(ONCOS("L"))
SET PLOT=$SELECT(ONCOS("L")["P":1,1:0)
if ONCOS("L")["Y"
QUIT
GOTO GET5
+3 SET Y="Do you want curves plotted? No// "
+4 DO GETYES^ONCOSINP
if Y=-1
QUIT
SET PLOT=$TEST
GET5 WRITE !
SET Y="Survival analysis for "
+1 SET Y=Y_$SELECT(TEMPL:"template "_HEADER,1:"ALL cases")
+2 SET Y=Y_" - OK? Yes// "
DO GETYES^ONCOSINP
if '$TEST
SET Y=-1
+3 QUIT
