H
*
FGMNAME1 IF E K DISK REMOTE
FDVTRAN9 IF E K DISK REMOTE
FCOMMENT1 UF A E K DISK REMOTE
D DATEISO S D DATFMT(*ISO)
DARX S 4A DIM(11) years
DAR$ S 7S 0 DIM(11) year's gift total
*********************************************************************
C FILLNB BEGSR
C KEY01 KLIST
C KFLD K1 6 0
C KFLD K2 2 0
* Get the "02" record information:
C Z-ADD 02 K2
C KEY01 CHAIN RGMNAME1 54
C 'GNTYPE' SETATR GNTYPE 'text'
C 'GNNAME' SETATR GNNAME 'text'
C 'GNLIN1' SETATR GNLIN1 'text'
C 'GNLIN2' SETATR GNLIN2 'text'
C 'GNLIN3' SETATR GNLIN3 'text'
C 'GNCITY' SETATR GNCITY 'text'
C 'GNSTAT' SETATR GNSTAT 'text'
C 'GNZIP' SETATR GNZIP 'text'
C 'GNZIPO' SETATR GNZIPO 'text'
C 'GNPHON' SETATR GNPHON 'text'
* Put the value into the label on the screen
C 'STXNAME' SETATR GNNAME 'label'
* Get the "01" record information:
C Z-ADD 01 K2
C KEY01 CHAIN RGMNAME1 54
C 'SSN' SETATR GNLIN3 'text'
C* Fill the Gift pages
C EXSR FILLGIFT
C EXSR GRASR
C* Clear the Notes page:
C 'MLE000007C' SETATR *BLANKS 'text'
C EXSR FILLCOMMENT
C ENDSR
*********************************************************************
C GRA0000049 BEGACT CREATE MAIN
* Fill array x-axis for graph:
C *YEAR SUB 10 YEAR 4 0
C Z-ADD 1 I 2 0
C I DOWLE 11
C MOVE YEAR ARX(I)
C ADD 1 YEAR
C ADD 1 I
C END
C EXSR GRASR
C ENDACT
*********************************************************************
C BIGSR BEGSR
C 'Amount' CAT 'x000':3 YLABEL 20
C 'GRA0000049' SETATR YLABEL 'YAxisLabel'
C 'GRA0000049' SETATR 2 'COLORAREA'
C 'GRA0000049' SETATR '255:200:255' 'COLORMIX'
C Z-ADD 1 I 2 0
B2 C I DOWLE 11
C DIV (H) 1000 AR$(I)
C ADD 1 I
C END
C ENDSR
*********************************************************************
C GRASR BEGSR
C SHOWGRAPH IFEQ 'YES'
C 'GRA0000049' SETATR 1 'STARTNEW'
* don't show if no $.$$
C XFOOT AR$ TOTAL 10 0
B1 C TOTAL IFLE *ZEROS
C 'GRA0000049' SETATR 0 'visible'
X1 C ELSE
C 'GRA0000049' SETATR 1 'visible'
* Find range of giving:
C MOVE *BLANKS YLABEL
C SETOFF 303132
C Z-ADD 1 I 2 0
B2 C I DOWLE 11
B3 C SELECT
C AR$(I) WHENGE 9000
C MOVE *ON *IN30
C AR$(I) WHENGE 25000
C MOVE *ON *IN31
C AR$(I) WHENGE 100000
C MOVE *ON *IN32
E3 C ENDSL
C ADD 1 I
E2 C END
* Adjust the array for the number of places shown:
B2 C SELECT
C *IN32 WHENEQ *ON
C EXSR BIGSR
*
C *IN31 WHENEQ *ON
C EXSR BIGSR
*
C *IN30 WHENEQ *ON
C EXSR BIGSR
C OTHER
C 'Amount' CAT '- dollars':1 YLABEL
C 'GRA0000049' SETATR YLABEL 'YAxisLabel'
C 'GRA0000049' SETATR 2 'COLORAREA'
C 'GRA0000049' SETATR '200:255:200' 'COLORMIX'
E2 C ENDSL
C Z-ADD 1 I 2 0
B2 C I DOWLE 11
* Set graph:
C MOVE ARX(I) YEARA 4
C 'GRA0000049' SETATR I 'DATAPOINT'
C 'GRA0000049' SETATR YEARA 'BARLABEL'
C 'GRA0000049' SETATR AR$(I) 'DATAVALUE'
C 'GRA0000049' SETATR 9 'COLORAREA'
C 'GRA0000049' SETATR '255:255:255' 'COLORMIX'
C ADD 1 I
E2 C END
C 'GRA0000049' SETATR 1 'usedata'
E1 C ENDIF
*
C ENDIF
C ENDSR
**
*********************************************************************
C MAIN BEGACT CREATE MAIN
C *ENTRY PLIST
C PARM TMP6 6
C MOVE TMP6 K1
C EXSR FILLNB
C ENDACT
*********************************************************************
C CRF0000034 BEGACT NOTIFY MAIN
C 'CRF0000034' GETATR 'attrvalue' TMPCRF 6 99
C MOVE TMPCRF K1
C EXSR FILLNB
*
C ENDACT
*********************************************************************
C FILLAMOUNT BEGSR
C* Make a positive number to display:
C DVTRSG MULT DVTRAM DVTRAM
C DVTRAM MULT -1 DVTRAM
C* Fill array for graph:
C Z-ADD 1 I
C DVTRFY LOOKUP ARX(I) 99
C 99 ADD DVTRAM AR$(I)
C* Fix date for display:
C MOVE DVTRDT DVTRD6
C *YMD TEST(D) DVTRD6 98
B3 C *IN98 IFEQ *OFF
C *YMD MOVE DVTRD6 DATEISO
C *MDY MOVE DATEISO DVTRD6 6 0
X3 C ELSE
C Z-ADD *ZEROS DVTRD6
E3 C END
C WRITE SFLGIFTS
B3 C DVTRAM IFLT *ZEROS
C 'SFLGIFTS' SETATR SINDEX 'Index'
C 'SFLGIFTS' SETATR 3 'ColNumber'
C 'SFLGIFTS' SETATR *RED 'CellFGClr'
X3 C ELSE
C 'SFLGIFTS' SETATR 3 'ColNumber'
C 'SFLGIFTS' SETATR *BLACK 'CellFGClr'
E3 C END
C ADD 1 SINDEX
C
C ENDSR
*********************************************************************
C FILLGIFT BEGSR
C 'MNI_H' GETATR 'checked' TMP 1 0
B0 C TMP IFEQ 1
*
C CLEAR SFLGIFTS
C Z-ADD *ZEROS AR$
C Z-ADD 1 SINDEX 3 0
C K1 SETLL RDVTRAN9
C K1 READE RDVTRAN9 9999
*
B1 C *IN99 DOWEQ *OFF
B2 C DVTRDC IFEQ 'C'
-2 C DVTRDC OREQ 'D'
C EXSR FILLAMOUNT
E2 C ENDIF
C* Get next record, see if the loop is done yet.
C K1 READE RDVTRAN9 9999
E1 C ENDDO
*
E0 C ENDIF
C ENDSR
*********************************************************************
C MNI_P BEGACT MENUSELECT MAIN
C 'MNI_P' GETATR 'checked' TMP 1 0
C TMP IFEQ 1
C 'MNI_P' SETATR 0 'checked'
C ELSE
C 'MNI_P' SETATR 1 'checked'
C END
C ENDACT
*********************************************************************
*
C MNI_H BEGACT MENUSELECT MAIN
C 'MNI_H' GETATR 'checked' TMP
C TMP IFEQ 1
C 'MNI_H' SETATR 0 'checked'
C ELSE
C 'MNI_H' SETATR 1 'checked'
C END
*
C ENDACT
*********************************************************************
C MNI_R BEGACT MENUSELECT MAIN
*
C 'MNI_R' GETATR 'checked' TMP 1 0
C TMP IFEQ 1
C 'MNI_R' SETATR 0 'checked'
C 'GRA0000049' SETATR 0 'visible'
C MOVE 'NO ' SHOWGRAPH 3
C ELSE
C 'MNI_R' SETATR 1 'checked'
C 'GRA0000049' SETATR 1 'visible'
C MOVE 'YES' SHOWGRAPH
C END
*
C ENDACT
*********************************************************************
*
C MNIEXIT BEGACT MENUSELECT MAIN
C MOVE *ON *INLR
*
C ENDACT
*********************************************************************
*
C CRF00025B5 BEGACT NOTIFY MAIN
C 'CRF00025B5' GETATR 'attrvalue' TMPCRF 6 99
C MOVE TMPCRF K1
C EXSR FILLNB
*
C ENDACT
*********************************************************************
*
C MNI_R BEGACT CREATE MAIN
C MOVE 'YES' SHOWGRAPH
*
C ENDACT
*********************************************************************
*
C CAN000002F BEGACT CREATE MAIN
*
C ENDACT
*********************************************************************
*
C CAL000007B BEGACT CREATE MAIN
*
C ENDACT
*********************************************************************
C FILLCOMMENT BEGSR
C MOVE 'SO' COTYPE
C KEYCOMMENT SETLL RCOMMENT
C KEYCOMMENT READE RCOMMENT 9999
C *IN99 IFEQ *OFF
C 'MLE000007C' SETATR COMMENT 'text'
C END
C ENDSR
*********************************************************************
C WRITECOMMENT BEGSR
C 'MLE000007C' GETATR 'text' TMP2096 2096
C Z-ADD GNIDNO COIDNO
C MOVE 'SO' COTYPE
C MOVE *DATE COTIKL
C KEYCOMMENT SETLL RCOMMENT
C KEYCOMMENT READE RCOMMENT 9999
C MOVE TMP2096 COMMENT
C *IN99 IFEQ *OFF
* If the record found, and notebook not blank, update it.
C COMMENT IFNE *BLANKS
C UPDATE RCOMMENT
C ELSE
* If the record found, and notebook is blank, delete it.
C DELETE RCOMMENT
C END
C ELSE
* If the record not found, write it.
C COMMENT IFNE *BLANKS
C WRITE RCOMMENT
C END
C END
C ENDSR
*********************************************************************
C MLE000007C BEGACT CREATE MAIN
C KEYCOMMENT KLIST
C KFLD GNIDNO
C KFLD COTYPE
C EXSR FILLCOMMENT
*
C ENDACT
*********************************************************************
*
C PSB000007E BEGACT PRESS MAIN
C EXSR WRITECOMMENT
*
C ENDACT
*********************************************************************
*
C CRF0000080 BEGACT NOTIFY MAIN
*
C 'CRF0000080' GETATR 'attrvalue' TMPCRF 6 99
C MOVE TMPCRF K1
C EXSR FILLNB
*
C ENDACT
*********************************************************************
* *
* Window . . : *
* *
* Part . . . : *
* *
* Event . . : *
* *
* Description: *
* *
* Change activity: *
* *
* Who Date Flag Description *
* --- ------ ---- ---------------------------------------------- *
* *
*********************************************************************
*
C CRF0001E71 BEGACT NOTIFY MAIN
*
C ENDACT
*********************************************************************
* *
* Window . . : *
* *
* Part . . . : *
* *
* Event . . : *
* *
* Description: *
* *
* Change activity: *
* *
* Who Date Flag Description *
* --- ------ ---- ---------------------------------------------- *
* *
*********************************************************************
*
C CRF0007E36 BEGACT NOTIFY MAIN
*
C ENDACT
*********************************************************************
|
