tldm-universe/CMS/BP.CLOCK/AL.T

*-------------------------------------------------------------------------*
* MSD.FUND.STATUS.REPORT
* AUTHOR  :  AL SURLES
* DATE    :  07-20-93
* PURPOSE :  TO PRINT A REPORT OF PARTNERS WHICH MEET THE STATUS CODE(S),
*            FUND CODE, TRANS IN LAST # OF DAYS, WITHIN A DATE RANGE.
* W/O #   :  130-30712(HDEC) - 07/22/93  AND 130-30727(HDEC) - 08/04/93
* UPDATES:
*-------------------------------------------------------------------------*
$INCLUDE GEN.COM2
$INCLUDE PM
$INCLUDE PM.TRANS
OPEN "PM" TO PM ELSE ABORT "PM"
OPEN "PM.TRANS" TO PMT ELSE ABORT "PM.TRANS"
OPEN "TITLE" TO TITLE.FILE ELSE ABORT "TITLE"
OPEN "FUND.STATUS.WORKFILE" TO WORK ELSE ABORT "FUND.STATUS.WORKFILE"
OPEN "FUND.FILE" TO FUND.FILE ELSE ABORT "FUND.FILE"
*-------------------------------------------------------------------------*
CRT CS
CRT @(0,0):"MSD.FUND.STATUS.REPORT"
CRT @(0,1):RV:SPACE(80):ERV
HD='FUND STATUS REPORT'
HDL=(80-LEN(HD))/2
CRT @(HDL,1):RV:HD:ERV
*-------------------------------------------------------------------------*
CRT @(0,4):CR
EXECUTE "EX PRINTER"
10 * Prompt for fund code to used
CRT @(0,2):CR:"Please input the FUND CODE to be used (EX: 3000) :":
INPUT FUND.CODE
IF FUND.CODE="" OR FUND.CODE=PF3 THEN GO 99
READ FUND.REC FROM FUND.FILE,FUND.CODE ELSE
  CRT @(0,22):"FUND CODE ":RV:" ":FUND.CODE:" ":ERV:" NOT ON FILE"
  RQM ; RQM ; GO 10
END
*----------*
20 * Promt for status code(s) to include
CRT @(0,4):CR:"Please input status code(s) to INCLUDE seperated by"
CRT @(0,5):"a comma (EX: M,A,COM) :":
INPUT STATUS.CODES
IF STATUS.CODES="" OR STATUS.CODES=PF3 THEN GO 99
IF STATUS.CODES=PF1 THEN GO 10
*--------*
30 * Promt for status code(s) to exclude
CRT @(0,7):CR:"Please input the status code(s) to be EXCLUDED seperated by"
CRT @(0,8):"a comma (EXAMPLE: 84,91,95,NL) :":
INPUT EXCL.STATUS
IF EXCL.STATUS=PF3 THEN GO 99
IF EXCL.STATUS=PF1 THEN GO 20
*----------*
40 * PROMPT FOR TRANS IN LAST # OF DAYS
CRT @(0,10):CR:"Please input # of days to check SINCE partner had a TRANS (EX: 14) -"
CRT @(0,11):"means it will check for a trans in the last 14 days :":
INPUT LAST.DAYS
IF LAST.DAYS="" OR LAST.DAYS=PF3 THEN GO 99
IF LAST.DAYS=PF1 THEN GO 30
TEST.DAYS=NUM(LAST.DAYS)
IF NOT(TEST.DAYS) THEN GO 40
*-------*
50 * Prompt for sort criteria for output.
CRT @(0,13):CR:"Do you want report sorted by LAST NAME or by DESCENDING AMOUNT (LN/DA) :":
INPUT RPT.SORT
IF RPT.SORT="" OR RPT.SORT=PF3 THEN GO 99
IF RPT.SORT=PF1 THEN GO 40
IF RPT.SORT="LN" OR RPT.SORT="DA" ELSE GO 50
*--------*
55 * Give user option of excluding names with 0.00 totals
CRT @(0,15):CR:"Do you want to EXCLUDE people whose $ total is zero? (Y/N) :":
INPUT ZERO.ANS
IF ZERO.ANS="" OR ZERO.ANS=PF3 THEN GO 99
IF ZERO.ANS=PF1 THEN GO 50
IF ZERO.ANS[1,1]="Y" OR ZERO.ANS[1,1]="N" ELSE GO 55
*--------*
60 * Check to see if user want total amount within a date range.
CRT @(0,17):CR:"Do you want to PRINT the TOTAL AMOUNT of giving (Y/N) :":
INPUT RANGE.ANS
IF RANGE.ANS="" OR RANGE.ANS=PF3 THEN GO 99
IF RANGE.ANS=PF1 THEN GO 55
IF RANGE.ANS[1,1] = "Y" OR RANGE.ANS[1,1] = "N" ELSE GO 60
IF RANGE.ANS[1,1]="Y" THEN
  65 * Begin date prompt
  CRT @(4,19):CR:"Please input BEGINNING date range (EX: 01/01/93) :":
  INPUT BDATE
  IF BDATE="" OR BDATE=PF3 THEN GO 99
  IF BDATE=PF1 THEN GO 60
  BEGIN.DATE=ICONV(BDATE,"D")
  IF BEGIN.DATE="" OR BEGIN.DATE=0 THEN
    CRT @(0,22):"INVALID DATE FORMAT":CL
    RQM ; GO 65
  END
  *------*
  70 * Ending date prompt
  CRT @(4,20):CR:"Please input ENDING date range (EX: 12/31/93)    :":
  INPUT EDATE
  IF EDATE="" OR EDATE=PF3 THEN GO 99
  IF EDATE=PF1 THEN GO 65
  END.DATE=ICONV(EDATE,"D")
  IF END.DATE="" OR END.DATE=0 THEN
    CRT @(0,22):"INVALID DATE FORMAT":CL
    RQM ; GO 70
  END
END
*------*
80 *
CRT @(0,22):CR:"Is everything correct (Y/N) ? :":
INPUT ANS
IF ANS = "N" THEN GO 10
IF ANS="Y" OR ANS="N" ELSE GO 80
85 *
CRT @(0,2):CR:"THE SELECT CRITERIA IS :"
*-----*
CRT @(0,4):CR:"The FUND CODE criteria is ":RV:" ":FUND.CODE:" ":ERV
*-----*
ST.LEN=LEN(STATUS.CODES)
ST.CD=STATUS.CODES
FOR B=1 TO ST.LEN
  IF ST.CD[B,1]="," THEN ST.CD=ST.CD[1,B-1]:VM:ST.CD[B+1,ST.LEN]
NEXT B
STATUS=""
ST.CNT=DCOUNT(ST.CD,VM)
FOR B=1 TO ST.CNT
  STATUS=STATUS:'"':ST.CD<1,B>:'"'
NEXT B
STATUS=TRIM(STATUS)
CRT @(0,6):"The status code(s) to INCLUDE are ":RV:" ":STATUS:" ":ERV
*-----*
IF EXCL.STATUS="" THEN
  STATUS.EXCL=""
  CRT @(0,8):"The status(s) to EXCLUDE are ":RV:" NONE ":ERV
END ELSE
  ST.LEN=LEN(EXCL.STATUS)
  ST.EX=EXCL.STATUS
  FOR B=1 TO ST.LEN
    IF ST.EX[B,1]="," THEN ST.EX=ST.EX[1,B-1]:VM:ST.EX[B+1,ST.LEN]
  NEXT B
  STATUS.EXCL=""
  ST.CNT=DCOUNT(ST.EX,VM)
  FOR B=1 TO ST.CNT
    STATUS.EXCL=STATUS.EXCL:'"':ST.EX<1,B>:'"'
  NEXT B
  STATUS.EXCL=TRIM(STATUS.EXCL)
  CRT @(0,8):"The status code(s) to EXCLUDE are ":RV:" ":STATUS.EXCL:" ":ERV
END
*-----*
CRT @(0,10):"The last # of days SINCE a transaction is ":RV:" ":LAST.DAYS:" ":ERV
*-----*
IF RPT.SORT="LN" THEN
  CRT @(0,12):"The SORT SEQUENCE is by ":RV:" LAST NAME ":ERV
END ELSE
  CRT @(0,12):"The SORT SEQUENCE IS BY ":RV:" DESCENDING AMOUNT ":ERV
END
*-----*
CRT @(0,14):"To Exclude Names with Zero Totals is ":RV:" ":ZERO.ANS:" ":ERV
*-----*
CRT @(0,16):"To PRINT total amount is ":RV:" ":RANGE.ANS:" ":ERV
*-----*
IF RANGE.ANS[1,1] = "Y" THEN
  CRT @(0,18):"The BEGINING date range is ":RV:" ":OCONV(BEGIN.DATE,"D2/"):" ":ERV
*-----*
  CRT @(0,20):"The ENDING date range is ":RV:" ":OCONV(END.DATE,"D2/"):" ":ERV
END
*-----*
CRT @(0,22):CR:"Are you sure EVERYTHING is correct (Y/N) :":
INPUT ANSWER
IF ANSWER[1,1] = "" OR ANSWER[1,1] = PF3 THEN GO 99
IF ANSWER = PF1 THEN GO 65
IF ANSWER[1,1] = "N" THEN GO 10
IF ANSWER[1,1] = "Y" OR ANSWER[1,1] = "N" ELSE GO 65
*-------------------------------------------------------------------------*
CLEARFILE WORK
90 * SELECT PARTNERS WITH CRITERIA
IF STATUS.EXCL="" THEN
  CMND='SELECT PM WITH STATUS ':STATUS:' '
END ELSE
  CMND='SELECT PM WITH STATUS ':STATUS:' AND WITHOUT STATUS ':STATUS.EXCL:' '
END
EXECUTE CMND
CUTOFF.DATE=DATE()-LAST.DAYS
SPOUSE.FLAG=0
IF ZERO.ANS[1,1]='Y' THEN ZERO.FLAG=1 ELSE ZERO.FLAG=0
95 *
EOF=0 ; REC.READ=0 ; REC.QUAL=0
LOOP
  READNEXT ID ELSE EOF=1
UNTIL EOF DO
  REC.READ=REC.READ+1 ; QUAL=0 ; PMT.REC=""
  IF SPOUSE.FLAG THEN
    ID.PREFIX=OCONV(ID,"G0.1") ; ID.SUFFIX=OCONV(ID,"G1.1")
    IF ID.SUFFIX="1" THEN
      ID=ID.PREFIX:".2"
    END ELSE
      IF ID.SUFFIX="2" THEN 
        ID=ID.PREFIX:".1"
      END ELSE
        GO 97
      END
    END
    READ WORK.REC FROM WORK,ID THEN GO 97
  END
  READ PMT.REC FROM PMT,ID THEN
    TR.CNT=DCOUNT(PMT.REC<TR$DATE>,VM)
    FOR B=1 TO TR.CNT
      IF PMT.REC<TR$DATE,B> GE CUTOFF.DATE OR SPOUSE.FLAG THEN
        FUND=OCONV(PMT.REC<TR$FUND.DEPT,B>,"G0-1")
        IF FUND=FUND.CODE THEN QUAL=1 ; B=99999
      END ELSE
        B=99999
      END
    NEXT B
    IF RANGE.ANS[1,1] = "Y" THEN
      TOT.AMT=0 ; FIRST.DT=DATE() ; LAST.DT=0
      FOR B=1 TO TR.CNT
        FUND=OCONV(PMT.REC<TR$FUND.DEPT,B>,"G0-1")
        IF FUND=FUND.CODE THEN 
          IF PMT.REC<TR$DATE,B> GE BEGIN.DATE THEN
            IF PMT.REC<TR$DATE,B> LE END.DATE THEN
              TOT.AMT=TOT.AMT+PMT.REC<TR$AMOUNT,B>
              IF FIRST.DT GT PMT.REC<TR$DATE,B> THEN FIRST.DT=PMT.REC<TR$DATE,B>
              IF LAST.DT LT PMT.REC<TR$DATE,B> THEN LAST.DT=PMT.REC<TR$DATE,B>
            END
          END ELSE
            B=99999
          END
        END
      NEXT B
    END
    IF ZERO.FLAG AND TOT.AMT LE 0 THEN GO 97
    IF QUAL THEN
      REC.QUAL=REC.QUAL+1
      IF RANGE.ANS[1,1] = "Y" THEN
        WORK.REC=""
        WORK.REC<1>=TOT.AMT
        BDATE=OCONV(FIRST.DT,"D2/") ; EDATE=OCONV(LAST.DT,"D2/")
        BMTH=BDATE[1,2] ; BYR=BDATE[7,2] ; EMTH=EDATE[1,2] ; EYR=EDATE[7,2]
        IF BYR=EYR THEN
          MTH.CNT=(EMTH-BMTH)+1
        END ELSE
          YR.CNT=EYR-BYR
          IF YR.CNT LE 1 THEN
            MTH.CNT=(13-BMTH)+EMTH
          END ELSE
            YR.MTH=(YR.CNT-1)*12
            MNTHS=(13-BMTH)+EMTH
            MTH.CNT=MNTHS+YR.MTH
          END
        END
        AVERAGE=TOT.AMT/MTH.CNT
        WORK.REC<2>=AVERAGE
        WRITE WORK.REC ON WORK,ID
      END ELSE
        WRITE "" ON WORK,ID
      END
    END
  END
  97 *
  IF REM(REC.READ,100)=0 THEN 
    CRT @(0,20):CR:"RECORDS READ :":REC.READ
    CRT @(0,21):"RECORDS QUAL :":REC.QUAL
  END
REPEAT
IF NOT(SPOUSE.FLAG) THEN 
  SPOUSE.FLAG=1
  SELECT WORK
  GO 95
END
*
GOSUB 1000
*
99 * END OF JOB
STOP
*-------------------------------------------------------------------------*
1000 * PRINT REPORT
IF RANGE.ANS = "Y" THEN
  HD="HDEC   FUND   CODE   REPORT   WITHIN   DATE   RANGE   ":OCONV(BEGIN.DATE,"D2/"):"  -  ":OCONV(END.DATE,"D2/")
  HDLN="PARTNER #":SPACE(6):"FULL  NAME":SPACE(25):"ADDRESS":SPACE(23):"CITY - STATE - ZIP":SPACE(10):"TOTAL AMT":SPACE(4):"MONTHLY AVG"
END ELSE
  HD="HDEC     FUND     CODE     REPORT"
  HDLN="PARTNER #":SPACE(6):"FULL  NAME":SPACE(25):"ADDRESS":SPACE(23):"CITY - STATE -ZIP"
END
LNG=LEN(HD)
XLNG=115-LNG
YLNG=XLNG/2
XLNG=YLNG
IF XLNG+YLNG+LNG > 132 THEN YLNG=YLNG-1 ; * In case it's too long.
IF STATUS.EXCL="" THEN STATUS.EXCL="NONE"
HD2="FUND CODE = ":FUND.CODE:SPACE(5):"STATUS(S) = ":STATUS:SPACE(5):"STATUS(S) EXCL = ":STATUS.EXCL:SPACE(5):"TRANS WITHIN THE LAST ":LAST.DAYS:" DAYS"
ALNG=LEN(HD2)
AXLNG=132-ALNG
AYLNG=AXLNG/2
AXLNG=AYLNG
IF AXLNG+AYLNG+LNG > 132 THEN AYLNG=AYLNG-1 ; * In case it's too long.
STR=STR("=",132)
IF RPT.SORT="LN" THEN
  EXECUTE "SSELECT FUND.STATUS.WORKFILE BY LNAME BY 0 "
END ELSE
  EXECUTE "SSELECT FUND.STATUS.WORKFILE BY-DSND AMOUNT BY LNAME BY FNAME "
END
EOF=0 ; PGCNT=0 ; PCNT=0 ; MAXCNT=1 ; PRINTER ON 
LOOP
  READNEXT ID ELSE EOF=1
UNTIL EOF DO
  READ PM.REC FROM PM,ID THEN
    READ WORK.REC FROM WORK,ID ELSE WORK.REC=""
    READ TITLE.REC FROM TITLE.FILE,PM.REC<1> ELSE TITLE.REC=""
    IF PCNT >=50 AND NOT(EOF) THEN
      MAXCNT=1
    END
    IF MAXCNT AND NOT(EOF) THEN
      PRINT CHAR(12)
      PGCNT=PGCNT+1
      HDLN1="PAGE ":PGCNT'R#3':SPACE(XLNG):HD:SPACE(YLNG):OCONV(DATE(),"D2/")
      HDLN2=SPACE(AXLNG):HD2:SPACE(AYLNG)
      PRINT HDLN1
      PRINT
      PRINT HDLN2
      PRINT STR
      PRINT HDLN
      PRINT
      MAXCNT=0
      PCNT=0
    END
    IF TITLE.REC # "" OR TITLE.REC # 0 THEN
      FNAME=TRIM(TITLE.REC<1>:" ":PM.REC<PM$FNAME>:" ":PM.REC<PM$LNAME>)
    END ELSE
      FNAME=TRIM(PM.REC<PM$FNAME:" ":PM.REC<PM$LNAME>)
    END
    ADDR=TRIM(PM.REC<PM$ADDR1>)
    CSZ=TRIM(PM.REC<PM$CITY>:", ":PM.REC<PM$STATE>:"  ":PM.REC<PM$ZIP>[1,5])
    IF RANGE.ANS[1,1] = "Y" THEN
      TAMT=OCONV(WORK.REC<1>,"MR2,$")
      TAVG=OCONV(WORK.REC<2>,"MR2,$")
      PRINT ID'L#15':FNAME'L#35':ADDR'L#30':CSZ'L#28':TAMT'L#13':TAVG'L#11'
    END ELSE
      PRINT ID'L#15':FNAME'L#35':ADDR'L#30':CSZ'L#28'
    END
    PCNT=PCNT+1
  END
REPEAT
RETURN
*