source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVDLET.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1ABSVDLET ;EAP ALTOONA VOLUNTARY DONATIONS PACKAGE ; 26 Sep 2001 2:04 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
3 ;TEMPORARY RECEIPT FOR FUNDS
4 I '$D(DUZ) W !,"DUZ NOT DEFINED. CALL IRM!" Q
5 N ABSVSTAT,ABSVDATE,ABSVAMOU,ABSVDON,ABSVSTRE,ABSVCITY,ABSVDATA
6 N ABSVFLAG,ABSVNAME,ABSVTYP1,ABSVTYP2,ABSVTYP3,ABSVTYPE,I,Y
7 N ABSVRAWD,ABSVCHEK,ABSVFUND,ABSVPURP,ABSVDOLL,ABSVDA,NAME,DIRUT
8 N ABSVMONY,ABSVISS,ABSVLIN1,ABSVLIN2,ABSVZM1,ABSVZN,ABSVREF,ABSVORG
9 N ABSVPENN,ABSVGPFN,ABSVSITE,ABSVPRIM,ABSVSTR2,ABSVTYP4,ABSVDOLA,ABSVPOSF
10 N X,J,I,CHECK,UNCHECK,DIC,DLAYGO,DA
11 I $D(IOF) W @IOF
12 S ABSVSTAT="" D ^ABSVSITE I '$D(ABSV("SITE")) G END
13 IF ABSV("SITE")="" G END
14 S ABSVSTAT=ABSV("SITE")_" "_ABSV("SITENAME") S ABSVSITE=ABSV("INST")
15 D WARN^ABSVDLE1
16 I '$D(DTIME) S DTIME=300
17 I '$D(IOM) S IOM=79
18 S U="^"
19 S ABSVDATA=""
20DONUM ;
21 S DIC("A")="Select Donations Tracking Number: ",DIC=503340,DIC(0)="QEAMNZ" D ^DIC K DIC I Y<0 W ! S %A="Do you want to enter this receipt using the Manual entry method" D YESNO^ABSVDLE1 K %A I %'=1 G END
22 I Y<0 G MANUAL
23 S DA=+Y S ABSVDA=+Y
24 I $D(^ABS(503340,DA,0)) S ABSVZN=^ABS(503340,DA,0) S ABSVREF=$P(ABSVZN,U,1) S ABSVORG=$P(ABSVZN,U,14) S ABSVTYPE=$P(ABSVZN,U,6) S ABSVAMOU=$P(ABSVZN,U,7) S ABSVFUND=$P(ABSVZN,U,8) S ABSVPOSF=$P(ABSVZN,U,5)
25 S ABSVGPFN="" I ABSVFUND>"" I $D(^ABS(503342,ABSVFUND,0)) S ABSVGPFN=$P(^ABS(503342,ABSVFUND,0),U,3)
26 S ABSVORGN=$P(ABSVZN,U,2)
27 W !!,"Donor : ",ABSVORG
28 W !,"Don. File # : ",ABSVREF
29 I '$D(^ABS(503340,DA,5)) G MISSING
30 I ABSVTYPE="" W !,"THE TYPE OF FUNDS FIELD IS MISSING FROM THIS ENTRY IN THE DONATIONS FILE!" G MISSING
31 I ABSVTYPE'=1 W !!,"Type of Donation is NOT Cash/Check. Cannot create Temporary Receipt!" QUIT
32 S DIC=503340,DA=+Y,DR="1.7;1.71;1.72;20;21.5;22",X="ABSVNAME;ABSVSTRE;ABSVSTR2;ABSVCITY;ABSVPENN;ABSVZIP"
33 D EXT^ABSVU2(DIC,DA,DR,X)
34 S ABSVCITY=ABSVCITY_", "_ABSVPENN_" "_ABSVZIP
35 S ABSVPURP="" I $D(^ABS(503340,DA,2)) S ABSVPURP=$P(^ABS(503340,DA,2),"^",3)
36 G SKIP
37MISSING W !!,"There is INCORRECT or MISSING data listed for entry #"_ABSVREF
38 D NOTE^ABSVDLE1
39 D YESNO^ABSVDLE1 I %'=1 G END
40 G MANUAL
41SKIP S X="T" D ^%DT S NEWDATE=+Y S ABSVRAWD=+Y D CONV^ABSVDLE1 S ABSVDATE=NEWDATE K NEWDATE
42 W ! S DIC("A")="Employee Issuing Temporary Receipt: ",DIC=200,DIC(0)="QEAMNZ" D ^DIC K DIC I Y<0 G END
43 S ABSVISS=$P(Y,U,2)
44 I ABSVISS=""!(ABSVISS="^") G END
45 S NAME=ABSVISS D NAMEFLIP^ABSVDLE1 S ABSVISS=NAME K NAME
46 S ABSVISS=$E(ABSVISS,1,20)
47 I $D(IOF) W @IOF
48 S ABSVMONY=$S(ABSVTYPE=1:"CASH/CHECK",ABSVTYPE="M":"MONEY ORDER",ABSVTYPE="O":"OTHER",1:"")
49 S ABSVPOC=ABSVNAME I ABSVFUND>"" I $D(^ABS(503342,ABSVFUND,0)) S ABSVFUND=$P(^ABS(503342,ABSVFUND,0),"^",1)
50 W !!,"Organization : ",ABSVORG
51 W !,"Donor : ",ABSVPOC
52 W !,"Address 1 : ",ABSVSTRE
53 W !,"Address 2 : ",ABSVSTR2
54 W !,"City, State & Zip: ",ABSVCITY
55 W !,"AMOUNT : ",ABSVAMOU
56 W !,"TYPE OF DONATION : ",ABSVMONY
57 W !,"DATE OF ISSUE : ",ABSVDATE
58 W !,"ISSUED BY : ",ABSVISS
59 W !,"POST FUND : ",ABSVFUND
60 W !,"POST FUND# : ",ABSVGPFN
61 W !,"POST : ",ABSVPOSF
62 W !,"PURPOSE : ",ABSVPURP
63 W ! S %A="Is this information correct? Say NO to enter it manually" D YESNO^ABSVDLE1 K %A I %="^" G END
64 I %'=1 G MANUAL
65NEWREC D CREATE^ABSVDLE3
66 S X="T" D ^%DT S NEWDATE=+Y S ZHDATE1=+Y D CONV^ABSVDLE1 S ZHDATE=NEWDATE K NEWDATE
67 S ZTRTN="START2^ABSVDLET" S ZTDESC="TEMPORARY DONATIONS RECEIPT" S ZTSAVE("ABSV*")="" D ^ABSVQ D END2 QUIT
68MANUAL ;
69 S X="T" D ^%DT S NEWDATE=+Y S ZHDATE1=+Y D CONV^ABSVDLE1 S ZHDATE=NEWDATE K NEWDATE
70 D WARN2^ABSVDLE1
71 D CREATE^ABSVDLE2
72 I $D(IOF) W @IOF
73 S ZTRTN="START^ABSVDLET" S ZTDESC="TEMPORARY DONATIONS RECEIPT" S ZTSAVE("ABSV*")="" D ^ABSVQ D END QUIT
74START I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
75 D HEADER^ABSVDLE1 D WRITE^ABSVDLE3
76END ;
77 K ABSVGPFN,ABSVDOLL,ABSVDA,NAME,DIR("A"),DIR("?"),DIRUT,DIR(0),DIR("T")
78 K X,J,I,CHECK,UNCHECK,DIC,DIC(0),DLAYGO,DA
79 Q
80START2 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
81 D HEADER^ABSVDLE1 D WRITE^ABSVDLE3
82END2 ;
83 K ABSVGPFN,ABSVDOLL,ABSVDA,NAME,DIR("A"),DIR("?"),DIRUT,DIR(0),DIR("T")
84 K X,J,I,CHECK,UNCHECK,DIC,DIC(0),DLAYGO,DA
85 Q
Note: See TracBrowser for help on using the repository browser.