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
HEAD ;;;;;;;;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HABSVDSIN 2362 printed Jan 14, 2021@17:31:51 Page 2
ABSVDSIN ;EAP ALTOONA VOLUNTARY PROGRAM ; 26 Sep 2001 2:04 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
+1 NEW ABSVLAST,ABSVDEND,ABSVDTE,ABSVDCNT,ABSVDTOT
+2 SET %DT="AEX"
SET %DT("A")="Select Starting Date: "
DO ^%DT
IF +Y<0
GOTO END
+3 SET ABSVDTE=+Y
SET ABSVDTE=ABSVDTE-.5
SET U="^"
SET ABSVDCNT=0
SET ABSVDTOT=0
+4 SET NEWDATE=+Y
DO CONV
SET ABSVDATE=NEWDATE
KILL NEWDATE
+5 SET %DT="AEX"
SET %DT("A")="Select Ending Date: "
DO ^%DT
IF +Y<0
GOTO END
+6 SET ABSVEND=+Y
SET ABSVEND=ABSVEND+.5
+7 SET NEWDATE=+Y
DO CONV
SET ABSVLAST=NEWDATE
KILL NEWDATE
+8 SET DIC=503334
SET DIC(0)="AEMNZQ"
SET DIC("A")="Select VOLUNTEER ORGANIZATION CODE// "
DO ^DIC
IF Y<0
GOTO END
+9 SET ABSVD=+Y
SET ABSVDNAM=$PIECE(^ABS(503334,ABSVD,0),U,2)
QUEUE ;;;;;;;;;;;;;;;;;;;;;;;;
+1 SET ZTRTN="START^ABSVDSIN"
SET ZTDESC="SINGLE ORGANIZATION VALUE PRINT"
SET ZTSAVE("ABSV*")=""
DO ^ABSVQ
GOTO END
START ;;;;;I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
+1 DO HEAD
+2 SET J=0
FOR I=1:1
SET J=$ORDER(^ABS(503340,J))
if 'J!(J="")
QUIT
IF $DATA(^ABS(503340,J,0))
SET ZN=^ABS(503340,J,0)
SET ZTYPE=$PIECE(ZN,U,6)
SET ZDATE=$PIECE(ZN,U,3)
SET ZORG=$PIECE(ZN,U,2)
IF ZDATE>ABSVDTE
IF ZORG=ABSVD
DO SUB
+3 WRITE !!,"TOTAL # OF CASH/CHECK or MONEY ORDER DONATIONS: ",ABSVDCNT
+4 WRITE !,"TOTAL VALUE of DONATIONS FOR THIS TIME PERIOD: $",ABSVDTOT
END ;;;;;;;;;;;;
+1 KILL ABSVDTOT,ZFUND,ZORG,ZDATE,ZN,ABSVDTE,ABSVD,ABSVDATE,ABSVDFUN,ABSVDCNT,DIC,DIC(0),DIC("A")
+2 KILL ABSVLAST,ABSVEND
+3 QUIT
CONV ;;DATE CONVERTER BLACK BOX. ** FORMAT 11/04/90 **
+1 ;;NEEDS VARIABLE NEWDATE WHICH MUST BE FORMAT 2900411 (S NEWDATE=DT)
CONVERT if '$DATA(NEWDATE)
QUIT
+1 if NEWDATE'=""
SET NEWDATE=$EXTRACT(NEWDATE,4,5)_"/"_$EXTRACT(NEWDATE,6,7)_"/"_$EXTRACT(NEWDATE,2,3)
+2 QUIT
HEAD ;;;;;;;;
+1 IF $DATA(IOST)
IF IOST["C-VT"
IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,ABSVDNAM
+3 WRITE !,"CASH/CHECK and MONEY ORDER DONATIONS FROM ",ABSVDATE," - ",ABSVLAST
+4 WRITE !,"Date Rec.",?11,"Tracking#",?25,"TYPE",?30,"POST",?40,"VALUE",?48,"FUND"
+5 IF '$DATA(IOM)
SET IOM=79
+6 WRITE !
FOR I=1:1:IOM
WRITE "="
+7 SET LCNT=5
+8 QUIT
SUB ;;;;
+1 SET ABSVDFUN=""
SET ZFUND=$PIECE(ZN,U,8)
IF ZFUND'=""
SET ABSVDFUN=$PIECE(^ABS(503342,ZFUND,0),U,1)
+2 SET NEWDATE=ZDATE
DO CONV
SET ABSVDDAT=NEWDATE
KILL NEWDATE
+3 WRITE !,ABSVDDAT,?11,$PIECE(ZN,U,1),?25,$PIECE(ZN,U,6),?30,$PIECE(ZN,U,5),?40,$PIECE(ZN,U,7),?48,ABSVDFUN
SET ABSVDCNT=ABSVDCNT+1
SET ABSVDTOT=ABSVDTOT+$PIECE(ZN,U,7)
+4 SET LCNT=LCNT+1
IF LCNT>22
IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)["C-"
DO LCNT
DO HEAD
+5 QUIT
LCNT ;;;;;;;;;;;returns %=3 if "^" is entered to quit;;;;;;;;;;;
+1 SET %=1
WRITE !,"(Press Any Key to Continue... )"
READ ANS:300
IF ANS="^"
SET %=3
+2 KILL ANS
+3 QUIT
