VistA-WorldVistAEHR/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVDORG.m

97 lines
4.4 KiB
Mathematica
Raw Permalink Normal View History

2009-11-29 13:37:14 -05:00
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