ONCOSSA3.m

ONCOSSA3 ;WASH ISC/SRR-Print life tables ;11/1/93  12:34

 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8

 ;

PRINT ;print actuarial life tables

 ;in:  CASES,LEN,GRP,HEADER,INTS,NGRPS,NPG,XCRT,^TMP($J

 ;out: NPG

 N INT,LEFT,LOSSES,MORTS,PSURV

 S ONCOEX=0 F GRP=1:1:NGRPS Q:ONCOEX  D:CASES(GRP) PRLT

 Q

 ;

PRLT ;print life table

 S (MORTS,LOSSES)=0,LEFT=CASES(GRP),PSURV=100,INTS=INTS(GRP)

 I ($Y+INTS+2<IOSL)&(NPG>0) D WGRP

 E  D WHEAD Q:ONCOEX

 F INT=0:1:INTS Q:ONCOEX  D WINT,WHEAD:INT<INTS&($Y=IOSL)

 Q

 ;

WHEAD ;write header

 D TOF Q:ONCOEX  W $P(HEADER,U,1),"Life Table",?IOM-30,$P(HEADER,U,2),NPG,!

 W "  ",$P(LEN,U,3),?11,"% Alive",?21,"# Left",?31,"Deaths",?41,"Losses",!

 F X=1:1:IOM W "-"

WGRP W ! W:NGRPS>1 "Group ",$C(GRP+64),":  ",^TMP($J,"GRP",GRP),!

 Q

 ;

TOF ;write top of form & bump page

 I XCRT,NPG,'$G(ONCOEX) W *7 R !,"Enter RETURN to continue or '^' to exit: ",X:DTIME S ONCOEX=$S('$T:1,X="^":1,1:0)

 I '$G(ONCOEX) W:$Y @IOF S NPG=NPG+1

 Q

 ;

WINT ;write (& compute) an interval

 S LOSSES=+$G(^TMP($J,"LT",GRP,INT,0)),MORTS=+$G(^(1))

 W $J(INT,5),?12,$J(PSURV,5,1),?22,$J(LEFT,5),?32,$J(MORTS,5)

 W ?42,$J(LOSSES,5),!

 S PSURV=$S(MORTS=0:PSURV,LEFT=0:0,1:PSURV*(1-(MORTS/(LEFT-(LOSSES/2)))))

 S LEFT=LEFT-MORTS-LOSSES

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ONCOSSA3   1272     printed  Apr 09, 2024@21:29:45                                                                                                                                                                                                    Page 2

ONCOSSA3  ;WASH ISC/SRR-Print life tables ;11/1/93  12:34

 +1       ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8

 +2       ;

PRINT     ;print actuarial life tables

 +1       ;in:  CASES,LEN,GRP,HEADER,INTS,NGRPS,NPG,XCRT,^TMP($J

 +2       ;out: NPG

 +3        NEW INT,LEFT,LOSSES,MORTS,PSURV

 +4        SET ONCOEX=0

           FOR GRP=1:1:NGRPS

               if ONCOEX

                   QUIT 

               if CASES(GRP)

                   DO PRLT

 +5        QUIT 

 +6       ;

PRLT      ;print life table

 +1        SET (MORTS,LOSSES)=0

           SET LEFT=CASES(GRP)

           SET PSURV=100

           SET INTS=INTS(GRP)

 +2        IF ($Y+INTS+2<IOSL)&(NPG>0)

               DO WGRP

 +3       IF '$TEST

               DO WHEAD

               if ONCOEX

                   QUIT 

 +4        FOR INT=0:1:INTS

               if ONCOEX

                   QUIT 

               DO WINT

               if INT<INTS&($Y=IOSL)

                   DO WHEAD

 +5        QUIT 

 +6       ;

WHEAD     ;write header

 +1        DO TOF

           if ONCOEX

               QUIT 

           WRITE $PIECE(HEADER,U,1),"Life Table",?IOM-30,$PIECE(HEADER,U,2),NPG,!

 +2        WRITE "  ",$PIECE(LEN,U,3),?11,"% Alive",?21,"# Left",?31,"Deaths",?41,"Losses",!

 +3        FOR X=1:1:IOM

               WRITE "-"

WGRP       WRITE !

           if NGRPS>1

               WRITE "Group ",$CHAR(GRP+64),":  ",^TMP($JOB,"GRP",GRP),!

 +1        QUIT 

 +2       ;

TOF       ;write top of form & bump page

 +1        IF XCRT

               IF NPG

                   IF '$GET(ONCOEX)

                       WRITE *7

                       READ !,"Enter RETURN to continue or '^' to exit: ",X:DTIME

                       SET ONCOEX=$SELECT('$TEST:1,X="^":1,1:0)

 +2        IF '$GET(ONCOEX)

               if $Y

                   WRITE @IOF

               SET NPG=NPG+1

 +3        QUIT 

 +4       ;

WINT      ;write (& compute) an interval

 +1        SET LOSSES=+$GET(^TMP($JOB,"LT",GRP,INT,0))

           SET MORTS=+$GET(^(1))

 +2        WRITE $JUSTIFY(INT,5),?12,$JUSTIFY(PSURV,5,1),?22,$JUSTIFY(LEFT,5),?32,$JUSTIFY(MORTS,5)

 +3        WRITE ?42,$JUSTIFY(LOSSES,5),!

 +4        SET PSURV=$SELECT(MORTS=0:PSURV,LEFT=0:0,1:PSURV*(1-(MORTS/(LEFT-(LOSSES/2)))))

 +5        SET LEFT=LEFT-MORTS-LOSSES

 +6        QUIT