source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVDLE3.m@ 635

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1ABSVDLE3 ;EAP ALTOONA TEMPORARY RECEIPTS ; 26 Sep 2001 2:04 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
3 ;PRINTOUT TEMPORARY RECEIPT FROM DONATIONS FILE & CREATE LOG FILE ENTRY IN 503344
4WRITE ;
5 I '$D(ABSVNUMB) QUIT
6 S U="^" I '$D(IOM) S IOM=80
7 W ! F I=1:1:IOM W "="
8 I '$D(^ABS(503344,ABSVNUMB,0)) W !,"ENTRY IS NOT DEFINED IN FILE 503344" QUIT
9 S ABSVDOLA=ABSVAMOU D DOLL^ABSVDLE1 S ABSVAMOU=ABSVDOLA
10 I ABSVORG="" W !,"NO ORGANIZATION NAME FOR THIS ENTRY" Q
11 W !,ABSVORG,?31,"| TYPE OF FUNDS | AMOUNT: ",ABSVAMOU
12 W !,ABSVNAME,?31,"| CASH/CHECK | ISSUED BY: ",ABSVISS
13 W !,ABSVSTRE,?31,"| | DATE ISSUED: ",ABSVDATE
14 I ABSVSTR2'="" D ADDRESS G SKIP
15 I ABSVSTR2="" D NOADD
16SKIP W ! F I=1:1:IOM W "="
17 W !,"POST: ",ABSVPOSF,?31,"| FUND: ",ABSVFUND," #",ABSVGPFN
18 W ! F I=1:1:IOM W "="
19 W !,"PURPOSE OF DONATION: ",ABSVPURP
20SET ;SET PIECES INTO 503344
21 S ABSVDALL=ABSVNUMB_U_ABSVNAME_U_ABSVSTRE_U_ABSVCITY_U_"C"_U_ABSVAMOU_U_ABSVISS_U_ABSVRAWD_U_ABSVREF_U_ABSVSTR2_U_ABSVORGN_U_ABSVPURP
22 S ABSVTWO=ABSVPOSF_U_ABSVFUND_U_ABSVPURP_U_ABSVORG
23 S ^ABS(503344,ABSVNUMB,0)=ABSVDALL
24 S ^ABS(503344,ABSVNUMB,1)=ABSVTWO
25 Q
26END ;
27 Q
28ADDRESS ;
29 W !,ABSVSTR2,?31,"| | LOG FILE#: ",ABSVNUMB
30 W !,ABSVCITY,?31,"| |"
31 Q
32NOADD ;
33 W !,ABSVCITY,?31,"| | LOG FILE#: ",ABSVNUMB
34 Q
35CREATE ;CREATE FILE 503344 ENTRY
36 S DIC="^ABS(503344,",DLAYGO=503344,DIC(0)="LM" D NOW^%DTC S DT=X
37GET 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
38 W !!,"THIS TEMPORARY RECEIPT LOG ENTRY HAS BEEN ASSIGNED NUMBER: ",+Y S ABSVNUMB=+Y
39 Q
40DOLLAR ;
41 I '$D(ABSVDOLL) Q
42 I ABSVDOLL="" Q
43 I ABSVDOLL'["." S ONE=ABSVDOLL S TWO="00"
44 I ABSVDOLL["." S ONE=$P(ABSVDOLL,".",1) S TWO=$P(ABSVDOLL,".",2) I $L(TWO)<2 S TWO=TWO_"0"
45 S LEN=$L(ONE)
46 I LEN<3 S ABSVDOLL="$"_ONE_"."_TWO
47 I LEN=3 S ABSVDOLL="$"_ONE_"."_TWO
48 I LEN=4 S ABSVDOLL="$"_$E(ONE,1)_","_$E(ONE,2,4)_"."_TWO
49 I LEN=5 S ABSVDOLL="$"_$E(ONE,1,2)_","_$E(ONE,3,5)_"."_TWO
50 I LEN=6 S ABSVDOLL="$"_$E(ONE,1,2)_","_$E(ONE,3,6)_"."_TWO
51 I LEN=7 S ABSVDOLL="$"_$E(ONE,1,2)_","_$E(ONE,3,7)_"."_TWO
52 K ONE,TWO
53 Q
54LINER W !,"====================================================================="
55 Q
Note: See TracBrowser for help on using the repository browser.