| 1 | ABSVDADD ;EAP ALTOONA VOLUNTARY PROGRAM ; 26 Sep 2001 2:04 PM
|
|---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
|
|---|
| 3 | ;NEW DONATIONS ENTRY.
|
|---|
| 4 | I '$D(DUZ) W !!,"DUZ VARIABLE NOT DEFINED. CALL IRM" Q
|
|---|
| 5 | I '$D(DA) Q
|
|---|
| 6 | I '$D(^ABS(503340,DA,0)) Q
|
|---|
| 7 | I '$D(^ABS(503340,DA,4)) Q
|
|---|
| 8 | N ZN,ZN1,X,Y,DINUM
|
|---|
| 9 | N ABSVERR,ABSVDATA,ABSVTYP1,ABSVTYP2,ABSVTYP3,ABSVTYP4,ABSVNUM
|
|---|
| 10 | N ABSVFLAG,ABSVSTNM,ABSVPOSF,ABSVORG,ABSVNAME,ABSVADD1,ABSVADD2
|
|---|
| 11 | N ABSVPURP,ABSVDUZ,ABSVTYPE
|
|---|
| 12 | S U="^" S ABSVDATA="" S ABSVTYP1="Cash/Check |",ABSVTYP2=" |",ABSVTYP3="Money Order|",ABSVTYP4="| |"
|
|---|
| 13 | S ABSVTYPE=$P(^ABS(503340,DA,0),U,6) S ABSVNUM=$P(^ABS(503340,DA,0),U,1)
|
|---|
| 14 | I ABSVTYPE'=1 QUIT
|
|---|
| 15 | I ABSVTYPE="1" S ABSVFLAG=1
|
|---|
| 16 | ;I '$D(ABSVFLAG) I ABSVTYPE'="M" D SUB1 G END
|
|---|
| 17 | S ABSVXA="Do you want to create a Temporary Receipt" D ^ABSVYN I %'=1 G END
|
|---|
| 18 | S ABSVSTNM="" I '$D(ABSV("SITE")) D SITESET I $D(ABSVERR) I ABSVERR=1 G END
|
|---|
| 19 | ;D ^ABSVSITE I '$D(ABSV("SITE")) W !,"SITE PARAMETERS FILE IS NOT COMPLETE. NO SITE SPECIFIED" G END
|
|---|
| 20 | ;IF ABSV("SITE")="" W !,"SITE PARAMETERS FILE IS NOT COMPLETE. NO SITE SPECIFIED" G END
|
|---|
| 21 | S ABSVSTNM=ABSV("SITE")_" "_ABSV("SITENAME") S ABSVSITE=ABSV("INST")
|
|---|
| 22 | D CREATE
|
|---|
| 23 | S ZN=^ABS(503340,DA,0) S ABSVPOSF=$P(ZN,U,5) S ABSVORG=$P(ZN,U,2) I $D(^ABS(503334,ABSVORG,0)) S ABSVORG=$P(^ABS(503334,ABSVORG,0),U,2)
|
|---|
| 24 | S ZN1=^ABS(503340,DA,4) S ABSVNAME=$P(ZN1,U,1) S ABSVADD1=$P(ZN1,U,2)
|
|---|
| 25 | S ABSVPURP="" I $D(^ABS(503340,DA,2)) S ABSVPURP=$P(^ABS(503340,DA,2),U,3)
|
|---|
| 26 | ;S X="T" D ^%DT
|
|---|
| 27 | S ABSVDUZ="" I $D(^VA(200,DUZ,0)) S ABSVDUZ=$P(^VA(200,DUZ,0),U,1)
|
|---|
| 28 | S ABSVSTAT=$P(ZN1,U,5) I ABSVSTAT'="" I $D(^DIC(5,ABSVSTAT,0)) S ABSVSTAT=$P(^DIC(5,ABSVSTAT,0),U,2)
|
|---|
| 29 | S ABSVADD2=$P(ZN1,U,3) S ABSVCITY=$P(ZN1,U,4) S ABSVZIP=$P(ZN1,U,6) S ABSVALL=ABSVCITY_", "_ABSVSTAT_" "_ABSVZIP
|
|---|
| 30 | S ABSVAMOU=$P(ZN,U,7) S X="T" D ^%DT S ABSVDATE=+Y S ABSVPOST=$P(ZN,U,8)
|
|---|
| 31 | S ^ABS(503344,ABSVDA,0)=ABSVDA_U_ABSVNAME_U_ABSVADD1_U_ABSVALL_U_ABSVTYPE_U_ABSVAMOU_U_ABSVDUZ_U_ABSVDATE_U_ABSVNUM_U_ABSVADD2_U_ABSVORG_U_ABSVSTNM
|
|---|
| 32 | S ^ABS(503344,ABSVDA,1)=ABSVPOSF_U_ABSVPOST_U_ABSVPURP
|
|---|
| 33 | QUEUE ;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 34 | I $D(Y) S NEWDATE=+Y D CONV S ABSVDATE=NEWDATE K NEWDATE
|
|---|
| 35 | S ZTRTN="START^ABSVDADD" S ZTDESC="TEMPORARY DONATIONS RECEIPT" S ZTSAVE("ABSV*")="" D ^ABSVQ G END
|
|---|
| 36 | START I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
|
|---|
| 37 | D HEADER,WRITE
|
|---|
| 38 | END ;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 39 | K ZN,ZN1,ABSVFLAG,ABSVTYPE,%A
|
|---|
| 40 | Q
|
|---|
| 41 | YESNO ;;YES/NO PROCESSOR UTILITY
|
|---|
| 42 | ;;OPTIONAL VARIABLE %A WHICH EQUALS QUESTION TEXT
|
|---|
| 43 | ;;RETURNS % : 1=YES, 2=NO, 3=^, 4=ANYTHING ELSE ASK AGAIN.
|
|---|
| 44 | ASKIT S:'$D(%A) %A="Do you want to continue"
|
|---|
| 45 | S %B="Enter 'Yes' or 'No'. Enter '^' to Quit."
|
|---|
| 46 | W !,%A_"? (Y/N) // " R ANS:$S($D(DTIME):DTIME,1:300) I (ANS["?")!(ANS="") W *7,!,%B G ASKIT
|
|---|
| 47 | I ANS["^" S %=3 Q
|
|---|
| 48 | S ANS=$E(ANS,1) S %=$S(ANS="Y":1,ANS="y":1,ANS="N":2,ANS="n":2,1:4) I ANS=4 G ASKIT
|
|---|
| 49 | K ANS,%A,%B Q
|
|---|
| 50 | SUB1 ;;;;;;;;;;;;;;;;;
|
|---|
| 51 | W !,"NOTE: Cannot create Temporary Receipt."
|
|---|
| 52 | W !,"Type of Donation is not Cash/Check or Money Order."
|
|---|
| 53 | Q
|
|---|
| 54 | CREATE ;;;;;;;;;CREATE LOG ENTRY IN DONATIONS TEMPORARY RECEIPT FILE;;;;
|
|---|
| 55 | S DIC="^ABS(503344,",DLAYGO=503344,DIC(0)="LM" D NOW^%DTC S DT=X
|
|---|
| 56 | GET L ^ABS("RECEIPT") S X=$S($D(^ABS("RECEIPT")):+^("RECEIPT")+1,1:1),^("RECEIPT")=X L G:$D(^ABS(503344,X)) GET S DINUM=X D FILE^DICN G:+Y<0 GET
|
|---|
| 57 | W !!,"THIS TEMPORARY RECEIPT LOG ENTRY HAS BEEN ASSIGNED NUMBER: ",+Y S ABSVDA=+Y
|
|---|
| 58 | Q
|
|---|
| 59 | HEADER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 60 | W !,"**** ******* "
|
|---|
| 61 | W !," **** *********" W " DEPARTMENT OF VETERAN AFFAIRS "
|
|---|
| 62 | W !," **** *** ****" W " TEMPORARY RECEIPT FOR FUNDS "
|
|---|
| 63 | W !," *******************" W " ",ABSVSTNM
|
|---|
| 64 | W !," ******* **** "
|
|---|
| 65 | W !," ***** **** "
|
|---|
| 66 | W !
|
|---|
| 67 | Q
|
|---|
| 68 | WRITE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 69 | I '$D(IOM) S IOM=79
|
|---|
| 70 | W ! F I=1:1:IOM W "="
|
|---|
| 71 | S ABSVDATA=ABSVNAME_U_ABSVADD1_U_ABSVADD2_U_ABSVALL_U_ABSVAMOU_U_ABSVDUZ
|
|---|
| 72 | S CHECK="|(x) " S UNCHECK="|( ) " S BAR="| "
|
|---|
| 73 | I $D(ABSVTYPE) I ABSVTYPE="M" S ABSVTYP3=CHECK_ABSVTYP3 S ABSVTYP2=UNCHECK_ABSVTYP2 S ABSVTYP1=UNCHECK_ABSVTYP1 S ABSVTYP4=BAR_ABSVTYP4
|
|---|
| 74 | I $D(ABSVTYPE) I ABSVTYPE="C" S ABSVTYP1=CHECK_ABSVTYP1 S ABSVTYP2=UNCHECK_ABSVTYP2 S ABSVTYP3=UNCHECK_ABSVTYP3 S ABSVTYP4=BAR_ABSVTYP4
|
|---|
| 75 | I $D(ABSVTYPE) I ABSVTYPE="" S ABSVTYP2=UNCHECK_ABSVTYP2 S ABSVTYP1=UNCHECK_ABSVTYP1 S ABSVTYP3=UNCHECK_ABSVTYP3 S ABSVTYP4=CHECK_ABSVTYP4
|
|---|
| 76 | S ABSVDOLA=$P(ABSVDATA,U,5) D DOLL
|
|---|
| 77 | ;S X="T" D ^%DT S NEWDATE=+Y D CONV S ABSVDATE=NEWDATE K NEWDATE
|
|---|
| 78 | W !,"ORG: ",$E(ABSVORG,1,23),?30,"| TYPE OF FUNDS |",?48,"AMOUNT: ",ABSVDOLA
|
|---|
| 79 | W !,$P(ABSVDATA,U,1),?30,"| CASH/CHECK |",?48,"ISSUED BY: ",$P(ABSVDATA,U,6)
|
|---|
| 80 | W !,$P(ABSVDATA,U,2),?30,ABSVTYP4,?48,"DATE ISSUED: ",ABSVDATE
|
|---|
| 81 | I $P(ABSVDATA,U,3)="" W !,$P(ABSVDATA,U,4),?30,ABSVTYP4,?48,"LOG FILE#: ",ABSVDA G LINEPRT
|
|---|
| 82 | W !,$P(ABSVDATA,U,3),?30,ABSVTYP4,?48,"LOG FILE#: ",ABSVDA
|
|---|
| 83 | W !,$P(ABSVDATA,U,4),?30,"|",?46,"|"
|
|---|
| 84 | LINEPRT W ! F I=1:1:IOM W "="
|
|---|
| 85 | I '$D(ABSVPOSF) S ABSVPOSF=""
|
|---|
| 86 | S ABSVGPFN="" I ABSVPOST'="" I $D(^ABS(503342,ABSVPOST,0)) S ABSVGPFN=$P(^ABS(503342,ABSVPOST,0),U,3)
|
|---|
| 87 | I $D(ABSVPOST) I ABSVPOST'="" I $D(^ABS(503342,ABSVPOST,0)) S ABSVPOST=$P(^ABS(503342,ABSVPOST,0),U,1)
|
|---|
| 88 | I '$D(ABSVPOST) S ABSVPOST=""
|
|---|
| 89 | W !,"POST: ",ABSVPOSF W ?30,"|FUND: ",ABSVPOST," ","(",ABSVGPFN,")"
|
|---|
| 90 | W ! F I=1:1:IOM W "="
|
|---|
| 91 | I ABSVPURP'="" I $D(^ABS(503345,ABSVPURP,0)) S ABSVPURP=$P(^ABS(503345,ABSVPURP,0),U,1)
|
|---|
| 92 | W !,"PURPOSE OF DONATION: ",ABSVPURP
|
|---|
| 93 | Q
|
|---|
| 94 | DOLL ;;;;;;;;;;DOLLAR CONVERTER;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 95 | I ABSVDOLA="" Q
|
|---|
| 96 | I $E(ABSVDOLA)'="$" S ABSVDOLA="$"_ABSVDOLA
|
|---|
| 97 | I ABSVDOLA'["." S ABSVDOLA=ABSVDOLA_".00"
|
|---|
| 98 | Q
|
|---|
| 99 | CONV ;;DATE CONVERTER BLACK BOX. ** FORMAT 11/04/90 **
|
|---|
| 100 | ;;NEEDS VARIABLE NEWDATE WHICH MUST BE FORMAT 2900411 (S NEWDATE=DT)
|
|---|
| 101 | CONVERT Q:'$D(NEWDATE)
|
|---|
| 102 | S:NEWDATE'="" NEWDATE=$E(NEWDATE,4,5)_"/"_$E(NEWDATE,6,7)_"/"_$E(NEWDATE,2,3)
|
|---|
| 103 | Q
|
|---|
| 104 | SITESET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 105 | D ^ABSVSITE I '$D(ABSV("SITE")) W !,"SITE PARAMETERS FILE IS NOT COMPLETE. NO SITE SPECIFIED" S ABSVERR=1 Q
|
|---|
| 106 | IF ABSV("SITE")="" W !,"SITE PARAMETERS FILE IS NOT COMPLETE. NO SITE SPECIFIED" S ABSVERR=1 Q
|
|---|
| 107 | Q
|
|---|
| 108 | BLURB ;;CALLED FROM ENTRY ACTION ON OPTION DELETE A DONATION ENTRY;;
|
|---|
| 109 | W !!,"*********************************************************"
|
|---|
| 110 | W !,"* THIS REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY *"
|
|---|
| 111 | W !,"*********************************************************"
|
|---|
| 112 | W !!
|
|---|
| 113 | Q
|
|---|
