| 1 | ECXUTL1 ;ALB/GTS - Utilities for DSS Extracts ;July 16, 1998
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**9,49**;Dec 22, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | CYFY(ECXFMDT) ;** Return the calandar and fiscal years for a FM date
|
|---|
| 5 | ;
|
|---|
| 6 | ; Input
|
|---|
| 7 | ; ECXFMDT - Fileman formated date
|
|---|
| 8 | ;
|
|---|
| 9 | ; Output
|
|---|
| 10 | ; X - CY begin date^ CY end date^ FY begin date^ FY end date
|
|---|
| 11 | ;
|
|---|
| 12 | N X,Y,Y2
|
|---|
| 13 | S X=""
|
|---|
| 14 | S ECXFMDT=$G(ECXFMDT)\1
|
|---|
| 15 | I ECXFMDT?7N DO
|
|---|
| 16 | .S (Y,Y2)=$E(ECXFMDT,1,3)
|
|---|
| 17 | .I $E(ECXFMDT,4,5)>9 S Y2=Y+1
|
|---|
| 18 | .S X=Y_"0101^"_Y_"1231^"_(Y2-1)_"1001^"_Y2_"0930"
|
|---|
| 19 | Q X
|
|---|
| 20 | ;
|
|---|
| 21 | FISCAL(DATE) ;Return fiscal year
|
|---|
| 22 | ; Input: DATE = Date (FileMan format) (defaults to today)
|
|---|
| 23 | ;Output: YYYY = Fiscal year that input date falls within
|
|---|
| 24 | ;
|
|---|
| 25 | N YEAR
|
|---|
| 26 | I '$G(DATE) S DATE=$$DT^XLFDT()
|
|---|
| 27 | S DATE=$$ECXYM^ECXUTL(DATE)
|
|---|
| 28 | S YEAR=$E(DATE,1,4)
|
|---|
| 29 | I $E(DATE,5,6)>9 S YEAR=YEAR+1
|
|---|
| 30 | Q YEAR
|
|---|
| 31 | ;
|
|---|
| 32 | DTRNG() ;** Prompt the user for a date range
|
|---|
| 33 | ;
|
|---|
| 34 | N ECXBEG,ECXEND,ECXRNG,ENDRNG
|
|---|
| 35 | S ECXRNG=0
|
|---|
| 36 | ;
|
|---|
| 37 | ;* Prompt for beginning date
|
|---|
| 38 | W ! S DIR(0)="DA^:DT:EX",DIR("A")="Enter Start Date: "
|
|---|
| 39 | S DIR("?")="^W ""*** Future dates are not allowed ***"",! D HELP^%DTC"
|
|---|
| 40 | D ^DIR K DIR
|
|---|
| 41 | S:'$D(DIRUT) ECXBEG=+Y
|
|---|
| 42 | K %DT,Y,DTOUT,DUOUT,DIRUT
|
|---|
| 43 | ;
|
|---|
| 44 | ;* Prompt for ending date
|
|---|
| 45 | I $G(ECXBEG) DO
|
|---|
| 46 | .S ENDRNG=$$CYFY(ECXBEG)
|
|---|
| 47 | .S ENDRNG=$S($P(ENDRNG,"^",4)<DT:$P(ENDRNG,"^",4),1:DT)
|
|---|
| 48 | .W ! S DIR(0)="DA^"_ECXBEG_":"_ENDRNG_":EX"
|
|---|
| 49 | .S DIR("A")="Enter End date: "
|
|---|
| 50 | .S DIR("?")="^W ""Future dates and dates after the beginning date's FY end are not allowed."",! D HELP^%DTC"
|
|---|
| 51 | .D ^DIR
|
|---|
| 52 | .S ECXEND=+Y
|
|---|
| 53 | .S:'$D(DIRUT) ECXRNG=ECXBEG_"^"_ECXEND
|
|---|
| 54 | .K DIR,%DT,Y,DIRUT,DTOUT,DUOUT
|
|---|
| 55 | Q ECXRNG
|
|---|
| 56 | ;
|
|---|
| 57 | STRIP(ECXFIELD,ECXLGTH,ECXPOS) ;* Strip blanks from a padded field
|
|---|
| 58 | ;
|
|---|
| 59 | ; Input
|
|---|
| 60 | ; ECXFIELD - Data to remove blanks from
|
|---|
| 61 | ; ECXLGTH - Total length of padded field
|
|---|
| 62 | ; ECXPOS - Front or Back indicator ('F' or 'B')
|
|---|
| 63 | ;
|
|---|
| 64 | ; Output
|
|---|
| 65 | ; ECXVAL - Field with blanks removed
|
|---|
| 66 | ;
|
|---|
| 67 | N ECXPVAL,QVAL
|
|---|
| 68 | S:ECXPOS="B" ECXPVAL=ECXLGTH
|
|---|
| 69 | S:ECXPOS="F" ECXPVAL=1
|
|---|
| 70 | S QVAL=0
|
|---|
| 71 | F Q:QVAL DO
|
|---|
| 72 | .I ECXPOS="B" DO
|
|---|
| 73 | ..S:($E(ECXFIELD,ECXPVAL)'=" ") QVAL=1
|
|---|
| 74 | ..S:($E(ECXFIELD,ECXPVAL)=" ") ECXFIELD=$E(ECXFIELD,1,ECXPVAL-1)
|
|---|
| 75 | ..S ECXPVAL=ECXPVAL-1
|
|---|
| 76 | ..S:(ECXPVAL<1) QVAL=1
|
|---|
| 77 | .I ECXPOS="F" DO
|
|---|
| 78 | ..S:($E(ECXFIELD,1)'=" ") QVAL=1
|
|---|
| 79 | ..S:($E(ECXFIELD,1)=" ") ECXFIELD=$E(ECXFIELD,2,ECXLGTH-(ECXPVAL-1))
|
|---|
| 80 | ..S ECXPVAL=ECXPVAL+1
|
|---|
| 81 | ..S:(ECXPVAL>ECXLGTH) QVAL=1
|
|---|
| 82 | Q ECXFIELD
|
|---|
| 83 | ;
|
|---|
| 84 | PAD(ECXVAL,ECXLGTH,ECXFB,ECXCHAR) ;* Pad the value passed in with ECXCHAR
|
|---|
| 85 | ;
|
|---|
| 86 | ; ECXVAL - The value to pad
|
|---|
| 87 | ; ECXLGTH - The maximum length
|
|---|
| 88 | ; ECXFB - 'F': Pad on front; 'B' Pad on back
|
|---|
| 89 | ; ECXCHAR - The character to pad ECXVAL with
|
|---|
| 90 | ;
|
|---|
| 91 | ; Output
|
|---|
| 92 | ; ECXVAR - The padded result
|
|---|
| 93 | ;
|
|---|
| 94 | N ECXLPCT,ECXVAR
|
|---|
| 95 | I $D(ECXVAL),($D(ECXLGTH)),($D(ECXFB)),($D(ECXCHAR)) DO
|
|---|
| 96 | .S (ECXVAL,ECXVAR)=$E(ECXVAL,1,ECXLGTH)
|
|---|
| 97 | .F ECXLPCT=1:1:ECXLGTH-$L($E(ECXVAR,1,ECXLGTH)) DO
|
|---|
| 98 | ..S:ECXFB="B" ECXVAL=ECXVAL_ECXCHAR
|
|---|
| 99 | ..S:ECXFB="F" ECXVAL=ECXCHAR_ECXVAL
|
|---|
| 100 | I '$D(ECXVAL) S ECXVAL=""
|
|---|
| 101 | Q ECXVAL
|
|---|
