Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSVDSIN

ABSVDSIN.m

Go to the documentation of this file.
ABSVDSIN ;EAP ALTOONA VOLUNTARY PROGRAM  ; 26 Sep 2001  2:04 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
 N ABSVLAST,ABSVDEND,ABSVDTE,ABSVDCNT,ABSVDTOT
 S %DT="AEX",%DT("A")="Select Starting Date: " D ^%DT I +Y<0 G END
 S ABSVDTE=+Y S ABSVDTE=ABSVDTE-.5 S U="^" S ABSVDCNT=0 S ABSVDTOT=0
 S NEWDATE=+Y D CONV S ABSVDATE=NEWDATE K NEWDATE
 S %DT="AEX",%DT("A")="Select Ending Date: " D ^%DT I +Y<0 G END
 S ABSVEND=+Y S ABSVEND=ABSVEND+.5
 S NEWDATE=+Y D CONV S ABSVLAST=NEWDATE K NEWDATE
 S DIC=503334,DIC(0)="AEMNZQ",DIC("A")="Select VOLUNTEER ORGANIZATION CODE// " D ^DIC I Y<0 G END
 S ABSVD=+Y S ABSVDNAM=$P(^ABS(503334,ABSVD,0),U,2)
QUEUE ;;;;;;;;;;;;;;;;;;;;;;;;
 S ZTRTN="START^ABSVDSIN" S ZTDESC="SINGLE ORGANIZATION VALUE PRINT" S ZTSAVE("ABSV*")="" D ^ABSVQ G END
START ;;;;;I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
 D HEAD
 S J=0 F I=1:1 S J=$O(^ABS(503340,J)) Q:'J!(J="")  I $D(^ABS(503340,J,0)) S ZN=^ABS(503340,J,0) S ZTYPE=$P(ZN,U,6) S ZDATE=$P(ZN,U,3) S ZORG=$P(ZN,U,2) I ZDATE>ABSVDTE I ZORG=ABSVD D SUB
 W !!,"TOTAL # OF CASH/CHECK or MONEY ORDER DONATIONS: ",ABSVDCNT
 W !,"TOTAL VALUE of DONATIONS FOR THIS TIME PERIOD: $",ABSVDTOT
END ;;;;;;;;;;;;
 K ABSVDTOT,ZFUND,ZORG,ZDATE,ZN,ABSVDTE,ABSVD,ABSVDATE,ABSVDFUN,ABSVDCNT,DIC,DIC(0),DIC("A")
 K ABSVLAST,ABSVEND
 Q
CONV ;;DATE CONVERTER BLACK BOX.  ** FORMAT 11/04/90 **
 ;;NEEDS VARIABLE NEWDATE WHICH MUST BE FORMAT 2900411 (S NEWDATE=DT)
CONVERT Q:'$D(NEWDATE)
 S:NEWDATE'="" NEWDATE=$E(NEWDATE,4,5)_"/"_$E(NEWDATE,6,7)_"/"_$E(NEWDATE,2,3)
 Q
 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
 W !,ABSVDNAM
 W !,"CASH/CHECK and MONEY ORDER DONATIONS FROM ",ABSVDATE," - ",ABSVLAST
 W !,"Date Rec.",?11,"Tracking#",?25,"TYPE",?30,"POST",?40,"VALUE",?48,"FUND"
 I '$D(IOM) S IOM=79
 W ! F I=1:1:IOM W "="
 S LCNT=5
 Q
SUB ;;;;
 S ABSVDFUN="" S ZFUND=$P(ZN,U,8) I ZFUND'="" S ABSVDFUN=$P(^ABS(503342,ZFUND,0),U,1)
 S NEWDATE=ZDATE D CONV S ABSVDDAT=NEWDATE K NEWDATE
 W !,ABSVDDAT,?11,$P(ZN,U,1),?25,$P(ZN,U,6),?30,$P(ZN,U,5),?40,$P(ZN,U,7),?48,ABSVDFUN S ABSVDCNT=ABSVDCNT+1 S ABSVDTOT=ABSVDTOT+$P(ZN,U,7)
 S LCNT=LCNT+1 I LCNT>22 I $D(IOST) I $E(IOST,1,2)["C-" D LCNT D HEAD
 Q
LCNT ;;;;;;;;;;;returns %=3 if "^" is entered to quit;;;;;;;;;;;
 S %=1 W !,"(Press Any Key to Continue... )" R ANS:300 I ANS="^" S %=3
 K ANS
 Q