source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVDORG.m@ 1397

ABSVDORG ;EAP ALTOONA PRINT ORGANIZATION STATISTICS  ; 26 Sep 2001  2:04 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
 N ABSVDOLL,ABSVDTOT,ABSVDBEG,U,ABSVDREC,ABSVDORG,ABSVDVAL,ABSVDATE
 N DNUM,ANS,ABSVDTYP,CT,ZN,ZN1,J,I,U,HOLD,NEWDATE,GRANDMON
 N ABSVLAST,ABSVDREC,ABSVDEND,ABSVDMON,ABSVMON2,ABSVMON3,GRANDTOT
KILLTEMP 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)
 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)
 S U="^" S HOLD=0
GETDATE D ^ABSVSITE Q:'%
 S %DT="AEX",%DT("A")="Select Starting Date: " D ^%DT I +Y<0 G END
 S NEWDATE=+Y D CONV S ABSVDATE=NEWDATE K NEWDATE
 S ABSVDBEG=+Y S ABSVDBEG=ABSVDBEG-.5
 S %DT="AEX",%DT("A")="Select Ending Date: " D ^%DT I +Y<0 G END
 S NEWDATE=+Y D CONV S ABSVLAST=NEWDATE K NEWDATE
 S ABSVDEND=+Y S ABSVDEND=ABSVDEND+.5
 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
QUEUE ;
 S ZTRTN="START^ABSVDORG" S ZTDESC="DONATIONS ORGANIZATION STATISTICS" S ZTSAVE("ABSV*")="" D ^ABSVQ D END QUIT
START ;
 D HEADER
 S ABSVDTOT=0 S ABSVDMON=0
 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
 D LINER^ABSVDLE3
 S ABSVDOLL=ABSVDMON S ABSVMON2=ABSVDMON
 ;D DOLLAR^ABSVDLE3 S ABSVDMON=ABSVDOLL
 W !,"            TOTAL = ",?41,$J($FN(ABSVDTOT,",",0),8),?51,$J($FN(ABSVDMON,",",2),12)
 ;BREAK BETWEEN REPORTS
 I $D(IOST) I IOST["C-VT" W !!,"Hit Any Key to Continue...  " R ANS:$S($D(DTIME):DTIME,1:300)
 I $D(IOST) I IOST["P-" W !!
NOTCASH D HEAD2
 S GRANDTOT=ABSVDTOT S GRANDMON=ABSVMON2
 S ABSVDTOT=0 S ABSVMON2=0
 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
 D LINER^ABSVDLE3
 S ABSVDOLL=ABSVMON2 S ABSVMON3=ABSVMON2
 W !,"            TOTAL = ",?41,$J($FN(ABSVDTOT,",",0),8),?51,$J($FN(ABSVMON2,",",2),12)
 S GRANDTOT=GRANDTOT+ABSVDTOT S GRANDMON=GRANDMON+ABSVMON3
 W !!,"TOTAL DONATIONS (",ABSVDATE,"-",ABSVLAST,")  =   ",?38,$J($FN(GRANDTOT,",",0),8)
 ;S ABSVDOLL=GRANDMON D DOLLAR^ABSVDLE3 S GRANDMON=ABSVDOLL
 W !,"TOTAL VALUE OF DONATIONS (",ABSVDATE,"-",ABSVLAST,") = ",?51,$J($FN(GRANDMON,",",2),12)
END ;
 Q
SETGLOB ;
 S ABSVDTYP=$P(ZN,U,6) G:ABSVDTYP="" OTHER
 I ABSVDTYP=1 G SKIP
 I ABSVDTYP'=1 G OTHER
SKIP I '$D(^ABSVDTMP(ABSVDORG)) S ^ABSVDTMP(ABSVDORG)="0^0"
 S HOLD=$P(^ABSVDTMP(ABSVDORG),U,1) S HOLD2=$P(^ABSVDTMP(ABSVDORG),U,2)
 S $P(^ABSVDTMP(ABSVDORG),U,1)=HOLD+ABSVDVAL S $P(^ABSVDTMP(ABSVDORG),U,2)=HOLD2+1
 K HOLD,HOLD2
 Q
OTHER ;DO THIS IF TYPE IS NOT CASH OR MONEY ORDER
 I '$D(^ABSVDTEM(ABSVDORG)) S ^ABSVDTEM(ABSVDORG)="0^0"
 S HOLD3=$P(^ABSVDTEM(ABSVDORG),U,1) S HOLD4=$P(^ABSVDTEM(ABSVDORG),U,2)
 S $P(^ABSVDTEM(ABSVDORG),U,1)=HOLD3+ABSVDVAL S $P(^ABSVDTEM(ABSVDORG),U,2)=HOLD4+1
 K HOLD3,HOLD4
 Q
TOTAL ;
 S ABSVDTOT=ABSVDTOT+$P(ZN1,U,2) S ABSVDMON=ABSVDMON+$P(ZN1,U,1)
 Q
TOTAL2 ;
 S ABSVDTOT=ABSVDTOT+$P(ZN1,U,2) S ABSVMON2=ABSVMON2+$P(ZN1,U,1)
 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
RESET ;
 I $D(IOST) I IOST["C-VT" W !!,"Hit Any Key to Continue...  " R ANS:$S($D(DTIME):DTIME,1:300) D HEADER
 Q
RESET2 ;
 I $D(IOST) I IOST["C-VT" W !!,"Hit Any Key to Continue...  " R ANS:$S($D(DTIME):DTIME,1:300) D HEAD2
 Q
HEADER ;
 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
 W !,"CASH/CHECK STATISTICS FROM ",ABSVDATE," TO ",ABSVLAST," FOR STATION ",ABSV("SITE")
 W !,"ORGANIZATION",?41,"#DONATIONS",?57,"VALUE"
 D LINER^ABSVDLE3
 S CT=5
 Q
HEAD2 ;
 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
 W !,"DONATIONS OF ALL OTHER TYPES FROM ",ABSVDATE," TO ",ABSVLAST," FOR STATION ",ABSV("SITE")
 W !,"ORGANIZATION",?41,"#DONATIONS",?57,"VALUE"
 D LINER^ABSVDLE3
 S CT=5
 Q
DOLLAR ;
 S ABSVDOLL=$P(ZN1,U,1) I ABSVDOLL="" Q
 S ABSVDOLL=$J($FN(ABSVDOLL,",",2),12)
 QUIT
DOLL2 ;
 S DNUM=$P(ZN1,U,2) I DNUM="" Q
 S DNUM=$J($FN(DNUM,",",0),8)
 QUIT