Routine: ONCOSSA1

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."

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSSA1   3772     printed  Feb 18, 2025@23:52:12                                                                                                                                                                                                    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

ONCOSSA1.m