source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVDADD.m@ 1261

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

initial load of WorldVistAEHR

File size: 6.2 KB
Line 
1ABSVDADD ;EAP ALTOONA VOLUNTARY PROGRAM ; 26 Sep 2001 2:04 PM
2V ;;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
33QUEUE ;;;;;;;;;;;;;;;;;;;;;;;;
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
36START I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
37 D HEADER,WRITE
38END ;;;;;;;;;;;;;;;;;;;;;;;;
39 K ZN,ZN1,ABSVFLAG,ABSVTYPE,%A
40 Q
41YESNO ;;YES/NO PROCESSOR UTILITY
42 ;;OPTIONAL VARIABLE %A WHICH EQUALS QUESTION TEXT
43 ;;RETURNS % : 1=YES, 2=NO, 3=^, 4=ANYTHING ELSE ASK AGAIN.
44ASKIT 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
50SUB1 ;;;;;;;;;;;;;;;;;
51 W !,"NOTE: Cannot create Temporary Receipt."
52 W !,"Type of Donation is not Cash/Check or Money Order."
53 Q
54CREATE ;;;;;;;;;CREATE LOG ENTRY IN DONATIONS TEMPORARY RECEIPT FILE;;;;
55 S DIC="^ABS(503344,",DLAYGO=503344,DIC(0)="LM" D NOW^%DTC S DT=X
56GET 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
59HEADER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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
68WRITE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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,"|"
84LINEPRT 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
94DOLL ;;;;;;;;;;DOLLAR CONVERTER;;;;;;;;;;;;;;;;;;;;;;;;
95 I ABSVDOLA="" Q
96 I $E(ABSVDOLA)'="$" S ABSVDOLA="$"_ABSVDOLA
97 I ABSVDOLA'["." S ABSVDOLA=ABSVDOLA_".00"
98 Q
99CONV ;;DATE CONVERTER BLACK BOX. ** FORMAT 11/04/90 **
100 ;;NEEDS VARIABLE NEWDATE WHICH MUST BE FORMAT 2900411 (S NEWDATE=DT)
101CONVERT Q:'$D(NEWDATE)
102 S:NEWDATE'="" NEWDATE=$E(NEWDATE,4,5)_"/"_$E(NEWDATE,6,7)_"/"_$E(NEWDATE,2,3)
103 Q
104SITESET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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
108BLURB ;;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
Note: See TracBrowser for help on using the repository browser.