source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVDORG.m@ 1270

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1ABSVDORG ;EAP ALTOONA PRINT ORGANIZATION STATISTICS ; 26 Sep 2001 2:04 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
3 N ABSVDOLL,ABSVDTOT,ABSVDBEG,U,ABSVDREC,ABSVDORG,ABSVDVAL,ABSVDATE
4 N DNUM,ANS,ABSVDTYP,CT,ZN,ZN1,J,I,U,HOLD,NEWDATE,GRANDMON
5 N ABSVLAST,ABSVDREC,ABSVDEND,ABSVDMON,ABSVMON2,ABSVMON3,GRANDTOT
6KILLTEMP I $D(^ABSVDTMP) S J=0 F I=1:1 S J=$O(^ABSVDTMP(J)) Q:'J!(J="") I $D(^ABSVDTMP(J)) K ^ABSVDTMP(J)
7 I $D(^ABSVDTEM) S J=0 F I=1:1 S J=$O(^ABSVDTEM(J)) Q:'J!(J="") I $D(^ABSVDTEM(J)) K ^ABSVDTEM(J)
8 S U="^" S HOLD=0
9GETDATE D ^ABSVSITE Q:'%
10 S %DT="AEX",%DT("A")="Select Starting Date: " D ^%DT I +Y<0 G END
11 S NEWDATE=+Y D CONV S ABSVDATE=NEWDATE K NEWDATE
12 S ABSVDBEG=+Y S ABSVDBEG=ABSVDBEG-.5
13 S %DT="AEX",%DT("A")="Select Ending Date: " D ^%DT I +Y<0 G END
14 S NEWDATE=+Y D CONV S ABSVLAST=NEWDATE K NEWDATE
15 S ABSVDEND=+Y S ABSVDEND=ABSVDEND+.5
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 ABSVDREC=$P(ZN,U,3) I $P(ZN,"^",15)=ABSV("INST"),ABSVDREC>ABSVDBEG,ABSVDREC<ABSVDEND S ABSVDORG=$P(ZN,U,2) S ABSVDVAL=$P(ZN,U,7) D SETGLOB
17QUEUE ;
18 S ZTRTN="START^ABSVDORG" S ZTDESC="DONATIONS ORGANIZATION STATISTICS" S ZTSAVE("ABSV*")="" D ^ABSVQ D END QUIT
19START ;
20 D HEADER
21 S ABSVDTOT=0 S ABSVDMON=0
22 S J=0 F I=1:1 S J=$O(^ABSVDTMP(J)) Q:'J!(J="") I $D(^ABSVDTMP(J)) S ZN1=^ABSVDTMP(J) I $D(^ABS(503334,J,0)) S ABSVDNAM=$P(^ABS(503334,J,0),U,2) D DOLLAR,DOLL2 W !,$E(ABSVDNAM,1,25),?41,DNUM,?51,ABSVDOLL D TOTAL S CT=CT+1 I CT>20 D RESET
23 D LINER^ABSVDLE3
24 S ABSVDOLL=ABSVDMON S ABSVMON2=ABSVDMON
25 ;D DOLLAR^ABSVDLE3 S ABSVDMON=ABSVDOLL
26 W !," TOTAL = ",?41,$J($FN(ABSVDTOT,",",0),8),?51,$J($FN(ABSVDMON,",",2),12)
27 ;BREAK BETWEEN REPORTS
28 I $D(IOST) I IOST["C-VT" W !!,"Hit Any Key to Continue... " R ANS:$S($D(DTIME):DTIME,1:300)
29 I $D(IOST) I IOST["P-" W !!
30NOTCASH D HEAD2
31 S GRANDTOT=ABSVDTOT S GRANDMON=ABSVMON2
32 S ABSVDTOT=0 S ABSVMON2=0
33 S J=0 F I=1:1 S J=$O(^ABSVDTEM(J)) Q:'J!(J="") I $D(^ABSVDTEM(J)) S ZN1=^ABSVDTEM(J) I $D(^ABS(503334,J,0)) S ABSVDNAM=$P(^ABS(503334,J,0),U,2) D DOLLAR,DOLL2 W !,$E(ABSVDNAM,1,25),?41,DNUM,?51,ABSVDOLL D TOTAL2 S CT=CT+1 I CT>20 D RESET2
34 D LINER^ABSVDLE3
35 S ABSVDOLL=ABSVMON2 S ABSVMON3=ABSVMON2
36 W !," TOTAL = ",?41,$J($FN(ABSVDTOT,",",0),8),?51,$J($FN(ABSVMON2,",",2),12)
37 S GRANDTOT=GRANDTOT+ABSVDTOT S GRANDMON=GRANDMON+ABSVMON3
38 W !!,"TOTAL DONATIONS (",ABSVDATE,"-",ABSVLAST,") = ",?38,$J($FN(GRANDTOT,",",0),8)
39 ;S ABSVDOLL=GRANDMON D DOLLAR^ABSVDLE3 S GRANDMON=ABSVDOLL
40 W !,"TOTAL VALUE OF DONATIONS (",ABSVDATE,"-",ABSVLAST,") = ",?51,$J($FN(GRANDMON,",",2),12)
41END ;
42 Q
43SETGLOB ;
44 S ABSVDTYP=$P(ZN,U,6) G:ABSVDTYP="" OTHER
45 I ABSVDTYP=1 G SKIP
46 I ABSVDTYP'=1 G OTHER
47SKIP I '$D(^ABSVDTMP(ABSVDORG)) S ^ABSVDTMP(ABSVDORG)="0^0"
48 S HOLD=$P(^ABSVDTMP(ABSVDORG),U,1) S HOLD2=$P(^ABSVDTMP(ABSVDORG),U,2)
49 S $P(^ABSVDTMP(ABSVDORG),U,1)=HOLD+ABSVDVAL S $P(^ABSVDTMP(ABSVDORG),U,2)=HOLD2+1
50 K HOLD,HOLD2
51 Q
52OTHER ;DO THIS IF TYPE IS NOT CASH OR MONEY ORDER
53 I '$D(^ABSVDTEM(ABSVDORG)) S ^ABSVDTEM(ABSVDORG)="0^0"
54 S HOLD3=$P(^ABSVDTEM(ABSVDORG),U,1) S HOLD4=$P(^ABSVDTEM(ABSVDORG),U,2)
55 S $P(^ABSVDTEM(ABSVDORG),U,1)=HOLD3+ABSVDVAL S $P(^ABSVDTEM(ABSVDORG),U,2)=HOLD4+1
56 K HOLD3,HOLD4
57 Q
58TOTAL ;
59 S ABSVDTOT=ABSVDTOT+$P(ZN1,U,2) S ABSVDMON=ABSVDMON+$P(ZN1,U,1)
60 Q
61TOTAL2 ;
62 S ABSVDTOT=ABSVDTOT+$P(ZN1,U,2) S ABSVMON2=ABSVMON2+$P(ZN1,U,1)
63 Q
64CONV ;;DATE CONVERTER BLACK BOX. ** FORMAT 11/04/90 **
65 ;;NEEDS VARIABLE NEWDATE WHICH MUST BE FORMAT 2900411 (S NEWDATE=DT)
66CONVERT Q:'$D(NEWDATE)
67 S:NEWDATE'="" NEWDATE=$E(NEWDATE,4,5)_"/"_$E(NEWDATE,6,7)_"/"_$E(NEWDATE,2,3)
68 Q
69RESET ;
70 I $D(IOST) I IOST["C-VT" W !!,"Hit Any Key to Continue... " R ANS:$S($D(DTIME):DTIME,1:300) D HEADER
71 Q
72RESET2 ;
73 I $D(IOST) I IOST["C-VT" W !!,"Hit Any Key to Continue... " R ANS:$S($D(DTIME):DTIME,1:300) D HEAD2
74 Q
75HEADER ;
76 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
77 W !,"CASH/CHECK STATISTICS FROM ",ABSVDATE," TO ",ABSVLAST," FOR STATION ",ABSV("SITE")
78 W !,"ORGANIZATION",?41,"#DONATIONS",?57,"VALUE"
79 D LINER^ABSVDLE3
80 S CT=5
81 Q
82HEAD2 ;
83 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
84 W !,"DONATIONS OF ALL OTHER TYPES FROM ",ABSVDATE," TO ",ABSVLAST," FOR STATION ",ABSV("SITE")
85 W !,"ORGANIZATION",?41,"#DONATIONS",?57,"VALUE"
86 D LINER^ABSVDLE3
87 S CT=5
88 Q
89DOLLAR ;
90 S ABSVDOLL=$P(ZN1,U,1) I ABSVDOLL="" Q
91 S ABSVDOLL=$J($FN(ABSVDOLL,",",2),12)
92 QUIT
93DOLL2 ;
94 S DNUM=$P(ZN1,U,2) I DNUM="" Q
95 S DNUM=$J($FN(DNUM,",",0),8)
96 QUIT
Note: See TracBrowser for help on using the repository browser.