source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH2A.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1PRCH2A ;WISC/PLT-DAILY PURCHASE CARD CHARGES STATEMENT ; 6/28/99 3:18pm
2V ;;5.1;IFCAP;**8**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ;invalid entry
5 ;
6EN ;print daily purchase card charges statement
7 N PRCA,PRCB,PRCDATE,PRCDATEF,PRCDATEE,PRCDUZ,PRCNAME
8 N A,B,C
9 S PRCDUZ=DUZ
10Q1 ;statement from date
11 S A=$$DATE^PRC0C($H-2,"H") D DT^PRC0A(.X,.Y,"For Credit Card Charge Statement Beginning Date: ","AO",$P(A,"^",4)_"/"_$P(A,"^",5)_"/"_$E($P(A,"^",3),3,4))
12 I X["^"!(X="") G EXIT
13 I $E(Y,6,7)<1 D EN^DDIOL("Date missing! Enter date format: MM/DD/YY") G Q1
14 S PRCDATEF=Y
15Q2 ;statement ending date
16 S A=$$DATE^PRC0C(PRCDATEF,"I") D DT^PRC0A(.X,.Y,"For Credit Card Charge Statement Ending Date: ","AO",$P(A,"^",4)_"/"_$P(A,"^",5)_"/"_$E($P(A,"^",3),3,4))
17 I X["^"!(X="") G Q1
18 I $E(Y,6,7)<1 D EN^DDIOL("Date missing! Enter date format: MM/DD/YY") G Q2
19 I Y<PRCDATEF D EN^DDIOL("The beginning and ending dates are not in order") G Q2
20 S PRCDATEE=Y
21 G:'$G(PRCOPT) START
22Q3 ;select card holder
23 S PRCDI="200;^VA(200,;"
24 S X("S")="I Y-DUZ,$D(^PRC(440.5,""MAAH"",DUZ,+Y))"
25 D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQS","Select Purchase Card Holder: ")
26 I Y<0!(X="") G Q1
27 K X S PRCRI(200)=+Y,PRCDUZ=+Y
28 ;
29START N L,DIC,FLDS,BY,FR,TO,DHD
30 S DIC="^PRCH(440.6,",L=0,BY="#STATEMENT DATE;C1,@STATION NUMBER,@INTERNAL(CARD HOLDER),+""XXXXXXXXXXXX""_$E(CREDIT CARD NUMBER;C1;S1;""CHARGE DATA for CREDIT CARD #: "",13,16)"
31 S FR=PRCDATEF_",1,"_PRCDUZ_",0",TO=PRCDATEE_",9999,"_PRCDUZ_",~"
32 S PRCNAME=$P(^VA(200,PRCDUZ,0),"^"),PRCDATE=$$MDY(PRCDATEF)_" - "_$$MDY(PRCDATEE)
33 S DHD="E-Charge Statement for "_PRCNAME_" Statement Date: "_PRCDATE
34 S FLDS=".01;C1;S1;""Charge Id"",8;""PO Date"",31;L30;""Vendor"",20;C5;""P.O. #"",9;""TXN Ref"",&13;C60;R15;""Charge $AMT"",41;""IFCAP P.O. #"";C5;L16,6;""TXN DATE"",15;C50"
35 D EN1^DIP G:$G(PRCOPT) Q3
36EXIT QUIT
37 ;
38MDY(A) ;EV = MM/DD/YY
39 QUIT $E(A,4,5)_"/"_$E(A,6,7)_"/"_$E(A,2,3)
40 ;
41EN1 ;from approving official menu
42 N PRCOPT
43 S PRCOPT=1
44 G EN
45 ;
46EN2 ;from print unregistered card charges option
47 S PRCOPT=2
48 S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
49 S DIC="^PRCH(440.6,",L=0
50 S FLDS="3;""Credit Card #"";C1;N;L16,8;""PO Date"",31;L30;""Vendor"",20;C5;""P.O. #"",9;""TXN Ref"",&13;C60;R15;""Charge $AMT"",.01;C5;""Charge Id"",6;""TXN DATE"",15;C50"
51 S DHD="Unregistered Credit Card Charges for Station #: "_PRC("SITE")
52 S BY(0)="^PRCH(440.6,""ST"",""N~"","
53 S L(0)=1
54 S BY="3",FR="0",TO="99999999999999999999999"
55 S DIS(0)="I $D(PRC(""SITE"")),$P(^PRCH(440.6,D0,0),""^"",8)=PRC(""SITE"")"
56 D EN1^DIP
57 QUIT
58 ;
59EN3 ;charge card reg exception option
60 N PRC
61 S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
62 S DIC="^PRC(440.5,",L=0
63 S FLDS="60;""Charge Card #"";C1;S1;N,59;""Exp. Date"";L15,51;""Replaced Card #"",52;C5;""Card Holder"";L30,7;C36;""IFCAP CARD HOLDER"";L25,63;L10;C62;""FCP #"",53;C5;""Station"";L8,61;C22;""S.P. Limit"";L15,62;""M.P. Limit"";L15"
64 S FLDS(1)="55;C5;""Fund Code"";L15,56;""ACC Code"";L15,57;""Cost Center"";L15,58;""BOC"";L15"
65 S DHD="Charge Card Reg. Exception List"
66 S BY(0)="^PRC(440.5,""ST"","
67 S L(0)=2
68 S BY="@70,@.01",FR="E",TO="E"
69 S DIOEND="I Y'[""^"" D EOR^PRCH2A"
70 S:$D(ZTIO) IOP=ZTIO
71 S DIS(0)="I $D(PRC(""SITE"")),$P($G(^PRC(440.5,D0,2)),""^"",3)=PRC(""SITE"")"
72 D EN1^DIP
73 QUIT
74EOR W !!,"* - Invalid data, it must be corrected by the charge card company.",!,"# - New charge card data may not match the old one.",!!,"END OF REPORT"
75 I $E(IOST,1,2)="C-",'$D(ZTQUEUED) D EOP^PRC0A(.X,.Y,"Enter return to continue","","")
76 QUIT
Note: See TracBrowser for help on using the repository browser.