source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVDSIN.m@ 635

Last change on this file since 635 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1ABSVDSIN ;EAP ALTOONA VOLUNTARY PROGRAM ; 26 Sep 2001 2:04 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
3 N ABSVLAST,ABSVDEND,ABSVDTE,ABSVDCNT,ABSVDTOT
4 S %DT="AEX",%DT("A")="Select Starting Date: " D ^%DT I +Y<0 G END
5 S ABSVDTE=+Y S ABSVDTE=ABSVDTE-.5 S U="^" S ABSVDCNT=0 S ABSVDTOT=0
6 S NEWDATE=+Y D CONV S ABSVDATE=NEWDATE K NEWDATE
7 S %DT="AEX",%DT("A")="Select Ending Date: " D ^%DT I +Y<0 G END
8 S ABSVEND=+Y S ABSVEND=ABSVEND+.5
9 S NEWDATE=+Y D CONV S ABSVLAST=NEWDATE K NEWDATE
10 S DIC=503334,DIC(0)="AEMNZQ",DIC("A")="Select VOLUNTEER ORGANIZATION CODE// " D ^DIC I Y<0 G END
11 S ABSVD=+Y S ABSVDNAM=$P(^ABS(503334,ABSVD,0),U,2)
12QUEUE ;;;;;;;;;;;;;;;;;;;;;;;;
13 S ZTRTN="START^ABSVDSIN" S ZTDESC="SINGLE ORGANIZATION VALUE PRINT" S ZTSAVE("ABSV*")="" D ^ABSVQ G END
14START ;;;;;I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
15 D HEAD
16 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
17 W !!,"TOTAL # OF CASH/CHECK or MONEY ORDER DONATIONS: ",ABSVDCNT
18 W !,"TOTAL VALUE of DONATIONS FOR THIS TIME PERIOD: $",ABSVDTOT
19END ;;;;;;;;;;;;
20 K ABSVDTOT,ZFUND,ZORG,ZDATE,ZN,ABSVDTE,ABSVD,ABSVDATE,ABSVDFUN,ABSVDCNT,DIC,DIC(0),DIC("A")
21 K ABSVLAST,ABSVEND
22 Q
23CONV ;;DATE CONVERTER BLACK BOX. ** FORMAT 11/04/90 **
24 ;;NEEDS VARIABLE NEWDATE WHICH MUST BE FORMAT 2900411 (S NEWDATE=DT)
25CONVERT Q:'$D(NEWDATE)
26 S:NEWDATE'="" NEWDATE=$E(NEWDATE,4,5)_"/"_$E(NEWDATE,6,7)_"/"_$E(NEWDATE,2,3)
27 Q
28HEAD ;;;;;;;;
29 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
30 W !,ABSVDNAM
31 W !,"CASH/CHECK and MONEY ORDER DONATIONS FROM ",ABSVDATE," - ",ABSVLAST
32 W !,"Date Rec.",?11,"Tracking#",?25,"TYPE",?30,"POST",?40,"VALUE",?48,"FUND"
33 I '$D(IOM) S IOM=79
34 W ! F I=1:1:IOM W "="
35 S LCNT=5
36 Q
37SUB ;;;;
38 S ABSVDFUN="" S ZFUND=$P(ZN,U,8) I ZFUND'="" S ABSVDFUN=$P(^ABS(503342,ZFUND,0),U,1)
39 S NEWDATE=ZDATE D CONV S ABSVDDAT=NEWDATE K NEWDATE
40 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)
41 S LCNT=LCNT+1 I LCNT>22 I $D(IOST) I $E(IOST,1,2)["C-" D LCNT D HEAD
42 Q
43LCNT ;;;;;;;;;;;returns %=3 if "^" is entered to quit;;;;;;;;;;;
44 S %=1 W !,"(Press Any Key to Continue... )" R ANS:300 I ANS="^" S %=3
45 K ANS
46 Q
Note: See TracBrowser for help on using the repository browser.