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

ABSVDLET ;EAP ALTOONA VOLUNTARY DONATIONS PACKAGE  ; 26 Sep 2001  2:04 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**25,26**;JULY 6, 1994
 ;TEMPORARY RECEIPT FOR FUNDS
 I '$D(DUZ) W !,"DUZ NOT DEFINED. CALL IRM!" Q
 N ABSVSTAT,ABSVDATE,ABSVAMOU,ABSVDON,ABSVSTRE,ABSVCITY,ABSVDATA
 N ABSVFLAG,ABSVNAME,ABSVTYP1,ABSVTYP2,ABSVTYP3,ABSVTYPE,I,Y
 N ABSVRAWD,ABSVCHEK,ABSVFUND,ABSVPURP,ABSVDOLL,ABSVDA,NAME,DIRUT
 N ABSVMONY,ABSVISS,ABSVLIN1,ABSVLIN2,ABSVZM1,ABSVZN,ABSVREF,ABSVORG
 N ABSVPENN,ABSVGPFN,ABSVSITE,ABSVPRIM,ABSVSTR2,ABSVTYP4,ABSVDOLA,ABSVPOSF
 N X,J,I,CHECK,UNCHECK,DIC,DLAYGO,DA
 I $D(IOF) W @IOF
 S ABSVSTAT="" D ^ABSVSITE I '$D(ABSV("SITE")) G END
 IF ABSV("SITE")="" G END
 S ABSVSTAT=ABSV("SITE")_" "_ABSV("SITENAME") S ABSVSITE=ABSV("INST")
 D WARN^ABSVDLE1
 I '$D(DTIME) S DTIME=300
 I '$D(IOM) S IOM=79
 S U="^"
 S ABSVDATA=""
DONUM ;
 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
 I Y<0 G MANUAL
 S DA=+Y S ABSVDA=+Y
 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)
 S ABSVGPFN="" I ABSVFUND>"" I $D(^ABS(503342,ABSVFUND,0)) S ABSVGPFN=$P(^ABS(503342,ABSVFUND,0),U,3)
 S ABSVORGN=$P(ABSVZN,U,2)
 W !!,"Donor            : ",ABSVORG
 W !,"Don. File #      : ",ABSVREF
 I '$D(^ABS(503340,DA,5)) G MISSING
 I ABSVTYPE="" W !,"THE TYPE OF FUNDS FIELD IS MISSING FROM THIS ENTRY IN THE DONATIONS FILE!" G MISSING
 I ABSVTYPE'=1 W !!,"Type of Donation is NOT Cash/Check. Cannot create Temporary Receipt!" QUIT
 S DIC=503340,DA=+Y,DR="1.7;1.71;1.72;20;21.5;22",X="ABSVNAME;ABSVSTRE;ABSVSTR2;ABSVCITY;ABSVPENN;ABSVZIP"
 D EXT^ABSVU2(DIC,DA,DR,X)
 S ABSVCITY=ABSVCITY_", "_ABSVPENN_" "_ABSVZIP
 S ABSVPURP="" I $D(^ABS(503340,DA,2)) S ABSVPURP=$P(^ABS(503340,DA,2),"^",3)
 G SKIP
MISSING W !!,"There is INCORRECT or MISSING data listed for entry #"_ABSVREF
 D NOTE^ABSVDLE1
 D YESNO^ABSVDLE1 I %'=1 G END
 G MANUAL
SKIP S X="T" D ^%DT S NEWDATE=+Y S ABSVRAWD=+Y D CONV^ABSVDLE1 S ABSVDATE=NEWDATE K NEWDATE
 W ! S DIC("A")="Employee Issuing Temporary Receipt: ",DIC=200,DIC(0)="QEAMNZ" D ^DIC K DIC I Y<0 G END
 S ABSVISS=$P(Y,U,2)
 I ABSVISS=""!(ABSVISS="^") G END
 S NAME=ABSVISS D NAMEFLIP^ABSVDLE1 S ABSVISS=NAME K NAME
 S ABSVISS=$E(ABSVISS,1,20)
 I $D(IOF) W @IOF
 S ABSVMONY=$S(ABSVTYPE=1:"CASH/CHECK",ABSVTYPE="M":"MONEY ORDER",ABSVTYPE="O":"OTHER",1:"")
 S ABSVPOC=ABSVNAME I ABSVFUND>"" I $D(^ABS(503342,ABSVFUND,0)) S ABSVFUND=$P(^ABS(503342,ABSVFUND,0),"^",1)
 W !!,"Organization     : ",ABSVORG
 W !,"Donor            : ",ABSVPOC
 W !,"Address 1        : ",ABSVSTRE
 W !,"Address 2        : ",ABSVSTR2
 W !,"City, State & Zip: ",ABSVCITY
 W !,"AMOUNT           : ",ABSVAMOU
 W !,"TYPE OF DONATION : ",ABSVMONY
 W !,"DATE OF ISSUE    : ",ABSVDATE
 W !,"ISSUED BY        : ",ABSVISS
 W !,"POST FUND        : ",ABSVFUND
 W !,"POST FUND#       : ",ABSVGPFN
 W !,"POST             : ",ABSVPOSF
 W !,"PURPOSE          : ",ABSVPURP
 W ! S %A="Is this information correct? Say NO to enter it manually" D YESNO^ABSVDLE1 K %A I %="^" G END
 I %'=1 G MANUAL
NEWREC D CREATE^ABSVDLE3
 S X="T" D ^%DT S NEWDATE=+Y S ZHDATE1=+Y D CONV^ABSVDLE1 S ZHDATE=NEWDATE K NEWDATE
 S ZTRTN="START2^ABSVDLET" S ZTDESC="TEMPORARY DONATIONS RECEIPT" S ZTSAVE("ABSV*")="" D ^ABSVQ D END2 QUIT
MANUAL ;
 S X="T" D ^%DT S NEWDATE=+Y S ZHDATE1=+Y D CONV^ABSVDLE1 S ZHDATE=NEWDATE K NEWDATE
 D WARN2^ABSVDLE1
 D CREATE^ABSVDLE2
 I $D(IOF) W @IOF
 S ZTRTN="START^ABSVDLET" S ZTDESC="TEMPORARY DONATIONS RECEIPT" S ZTSAVE("ABSV*")="" D ^ABSVQ D END QUIT
START I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
 D HEADER^ABSVDLE1 D WRITE^ABSVDLE3
END ;
 K ABSVGPFN,ABSVDOLL,ABSVDA,NAME,DIR("A"),DIR("?"),DIRUT,DIR(0),DIR("T")
 K X,J,I,CHECK,UNCHECK,DIC,DIC(0),DLAYGO,DA
 Q
START2 I $D(IOST) I IOST["C-VT" I $D(IOF) W @IOF
 D HEADER^ABSVDLE1 D WRITE^ABSVDLE3
END2 ;
 K ABSVGPFN,ABSVDOLL,ABSVDA,NAME,DIR("A"),DIR("?"),DIRUT,DIR(0),DIR("T")
 K X,J,I,CHECK,UNCHECK,DIC,DIC(0),DLAYGO,DA
 Q