source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH1A2.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 7.7 KB
Line 
1PRCH1A2 ;WISC/PLT-PRCH1A continued ;6/10/97 15:22
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ;invalid entry
5 ;
6RECON(PRCA,PRCB,PRCRG) ;PRCA= ri of file 442, PRCB =ri of file 200,PRCRG=reconcile range %
7 ;X=return variable =1 if reconciled with final charge, =0 not final charge
8 N PRCRI,PRCC,PRCD,PRCDI,PRCPDT,PRCBOC,PRCCNT,PRCAMT,PRCCOA,PRCVAL,PRCCP,PRCR,PRCSTC,PRCPO,PRCAMTL,PRCAMTH,PRCER,PRCCR,PRCCL
9 N A,B,C,D
10 S PRCRI(442)=PRCA,PRCRI(200)=PRCB,PRCRI(440.5)=$P($G(^PRC(442,PRCRI(442),23)),"^",8)
11 D DPO
12 I 'PRCRI(440.5) D EN^DDIOL("This is not a purchase card order.") S PRCER=1 G EXIT
13 S A="^"_$P(^PRC(440.5,PRCRI(440.5),0),"^",8,10)_"^"
14 I A'[("^"_PRCB_"^") D EN^DDIOL("This order can only be reconciled by its card holder or (alt) approving officials.") S PRCER=2 G EXIT
15 S PRCB=$G(^PRC(442,PRCRI(442),7))
16 I ",1,4,5,6,45,40,41,50,51,"[(","_$P(PRCB,U,2)_",") D EN^DDIOL("The purchase card order has a wrong status to reconcile.") S PRCER=3 G EXIT
17 S X="~"
18REC D:X'="~" DPO S PRCB=^PRC(442,PRCRI(442),23),PRCC=$P(PRCB,U,8),PRCAMT=$P(^(0),U,16),PRCPO=$P(^(0),U),PRCDUZ=$P(PRCB,"^",22),PRCCR=""
19 I 'PRCDUZ D EN^DDIOL("The purchase card holder in the purchase card order file (#442) is missing!") S PRCER=4 G EXIT
20 I 'PRCC D EN^DDIOL("The purchase card # in the purchase card order file (#442) is missing!") S PRCER=4.1 G EXIT
21 S PRCRG=+PRCRG,PRCAMTL=PRCAMT-(PRCAMT*PRCRG/100),PRCAMTH=PRCAMT*PRCRG/100+PRCAMT
22 S PRCC=$P($G(^PRC(440.5,PRCC,0)),U),PRCCL=PRCC
23Q11 ;lookup
24 D EN^DDIOL("The system is attempting to locate credit card charge...")
25Q12 S PRCRI(440.6)="" G:PRCPO="" MCA
26 W !,"Matching Card XXXX"_$E(PRCCL,13,16)_", Vendor's Purchase Order #:",!
27 S X="N"_PRCDUZ_"~",X("S")="I $P(^(0),U,21)]"""",PRCPO-$P(^(0),U,8)=0,$P(^(0),U,4)="_PRCCL_",PRCPO[$P(^(0),U,21) S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
28 ;
29 ; Change below for NOIS CLA-0199-22457
30 S X("W")="N PRCBK S $P(PRCBK,$C(8),$L(X)+4)="""" W PRCBK,"" "",$E($P(^(0),U,9),4,5)_""-""_$E($P(^(0),U,9),6,7)_""-""_$E($P(^(0),U,9),2,3),"" $"",$J($P(^(0),U,14),0,2),"" "",$P(^(0),U,21) W:$D(^(6)) "" "",$P(^(6),U,1)"
31 S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Selec Credit Card Charge: ")
32 I Y>0 S PRCRI(440.6)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
33 . D YN^PRC0A(.X,.Y," ...Ok for "_$P(^PRCH(440.6,PRCRI(440.6),0),U,21)_" "_$P($G(^(6)),U),"O","YES") S:X["^"!(X="") Y=-1
34 . QUIT
35 W " Not Found"
36MCA W !,"Matching Card XXXX"_$E(PRCCL,13,16)_", $Amount within Range "_PRCRG_"%:",!
37 S X="N"_PRCDUZ_"~",X("S")="I PRCPO-$P(^(0),U,8)=0,$P(^(0),U,4)="_PRCCL_",$P(^(0),U,14)'<PRCAMTL&($P(^(0),U,14)'>PRCAMTH) S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
38 S X("W")="N PRCBK S $P(PRCBK,$C(8),$L(X)+4)="""" W PRCBK,"" "",$E($P(^(0),U,9),4,5)_""-""_$E($P(^(0),U,9),6,7)_""-""_$E($P(^(0),U,9),2,3),"" $"",$J($P(^(0),U,14),0,2),"" "",$P(^(0),U,21) W:$D(^(6)) "" "",$P(^(6),U,1)"
39 S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Select Purchase Card Charge: ")
40 I Y>0 S PRCRI(440.6)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
41 . D YN^PRC0A(.X,.Y," ...Ok for "_$P(^PRCH(440.6,PRCRI(440.6),0),U,21)_" "_$P($G(^(6)),U),"O","YES") S:X["^"!(X="") Y=-1
42 . QUIT
43 W " Not Found"
44W W !,"Listing All Credit Card Charges with Matched Card XXXX"_$E(PRCCL,13,16)_":",!
45 S X="N"_PRCDUZ_"~",X("S")="I PRCPO-$P(^(0),U,8)=0,$P(^(0),U,4)="_PRCCL_" S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
46 S X("W")="N PRCBK S $P(PRCBK,$C(8),$L(X)+4)="""" W PRCBK,"" "",$E($P(^(0),U,9),4,5)_""-""_$E($P(^(0),U,9),6,7)_""-""_$E($P(^(0),U,9),2,3),"" $"",$J($P(^(0),U,14),0,2),"" "",$P(^(0),U,21) W:$D(^(6)) "" "",$P(^(6),U,1)"
47 S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Select Purchase Card Charge: ")
48 I Y>0 S PRCRI(440.6)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
49 . D YN^PRC0A(.X,.Y," ...Ok for "_$P(^PRCH(440.6,PRCRI(440.6),0),U,21)_" "_$P($G(^(6)),U),"O","YES") S:X["^"!(X="") Y=-1
50 . QUIT
51 W " Not Found"
52 I PRCCR="" S PRCCR=1,PRCCL=PRCC
53 I PRCCR=1 S PRCRI(440.599)=$O(^PRC(440.5,"B",PRCCL,0)) I PRCRI(440.599)>0 S PRCCL=$TR($P($G(^PRC(440.5,PRCRI(440.599),50)),U),"*#") G:PRCCL]"" Q12
54 I PRCCR=1 S PRCCR=2,PRCCL=PRCC
55 I PRCCR=2 S PRCRI(440.599)=$O(^PRC(440.5,"ARPC",PRCCL,0)) I PRCRI(440.599) S PRCCL=$P($G(^PRC(440.5,PRCRI(440.599),0)),U) G:PRCCL]"" Q12
56 D EN^DDIOL("No Credit Card Charges Selected!")
57ACT0 S X(1)=$TR($J("",79)," ","_")
58 S X(2)=" Action Code: RS: Reselect Charges RD: Redisplay Data",X(3)=" NP: Next Purchase Order DC: Display Charges"
59 S Y(1)="Enter an action code"
60 D FT^PRC0A(.X,.Y,"Action","","") G:X["^"!(X="") EXIT
61 S Y=$$LU
62 I Y="NP" G EXIT
63 I Y="RS" G REC
64 I Y="RD" D DPO G ACT0
65 I Y="DC" D DC^PRCH1A(PRCRI(442)),DPO G ACT0
66 D EN^DDIOL("Invalid Action code, try again") G ACT0
67 ;
68START D DD S PRCE=^PRCH(440.6,PRCRI(440.6),0),PRCCP=$P(PRCE,"^",4),PRCR=$P($G(^(23)),"^",15) S:PRCR="" PRCR="N"
69 D DD S PRCE=^PRCH(440.6,PRCRI(440.6),0),PRCCP=$P(PRCE,U,4)
70 I PRCCP]"",PRCCP'=PRCC D EN^DDIOL("The CC-credit card # and purchase card order card # are different.")
71 I +$P(PRCE,U,14)'=+PRCAMT D EN^DDIOL("WARNING: The CC-charge amount and purchase card order amount are different.")
72 S PRCE=^PRC(442,PRCRI(442),0),PRCCP=$P($G(^(23)),"^",16),PRCR=$P($G(^(23)),"^",15) S:PRCR="" PRCR="N"
73ACT1 S X(1)=$TR($J("",79)," ","_")
74 S X(2)=" Action Code: RC: Reconcile DO: Display Order RS: Reselect Charges",X(3)=" RD: Redisplay Data DC: Display Charges"
75 S Y(1)="Enter an action code"
76 D FT^PRC0A(.X,.Y,"Action","","")
77 G:X["^"!(X="") EXIT
78 S Y=$$LU
79 I Y="RS" G REC
80 I Y="DO" D G ACT1
81 . N D0 S D0=PRCRI(442) D SS(1,24),CS,^PRCHDP1,DD
82 . QUIT
83 I Y="RD" D DD G ACT1
84 I Y="DC" D DC^PRCH1A(PRCRI(442)),DD G ACT1
85 I Y'="RC" D EN^DDIOL("Invalid Action code, try again") G ACT1
86RC ;call reconcile routine PRCH1A1
87 D RC^PRCH1A1
88 I $P($G(^PRCH(440.6,PRCRI(440.6),1)),"^",4)="Y" S PRCER=-1 G EXIT
89 D DPO
90 D YN^PRC0A(.X,.Y,"Reconcile More Credit Card Charges to This Purchase Order","O","NO")
91 I Y G REC
92EXIT I $G(PRCER)>0 D FT^PRC0A(.X,.Y,"Enter 'RETURN' to Continue","O")
93 D:$D(IOSTBM) SS(1,24),CS
94 S X=$S($G(PRCER)=-1:1,1:0)
95 QUIT
96 ;
97SS(IOTM,IOBM) ;screen size a-top, b=bottom margin
98 W @IOSTBM QUIT
99 ;
100MC(DX,DY) ;move cursor dx=column #, dy=row number
101 S DX=DX-1,DY=DY-1 X IOXY QUIT
102 ;
103CS W @IOF QUIT
104DISP ;
105 QUIT
106 W PRCBK S D=$P(B,U,15) W " ",$P(A,U)," ",$E(D,4,5),"-",$E(D,6,7),"-",$E(D,2,3)," " W:$P(A,U,2) $P(^PRCD(442.5,$P(A,U,2),0),U,2)," "
107 W:$P(C,U) $E($P(^PRCD(442.3,$P(C,U),0),U),1,34) W !,?13,"FCP: ",$P($P(A,U,3)," ")," ",$J($P(A,U,16),0,2) W:$P(B,U) ?35,$P($G(^PRC(440,$P(B,U),0)),U)
108 QUIT
109 ;
110DPO ;display purchase order
111 N A
112 D CS W ?18,"You are reconciling this PURCHASE CARD ORDER:"
113 D PIECE^PRC0B("442;^PRC(442,;"_PRCRI(442),".01;.1;.5;1;5;92","E","A")
114 W !,"IFCAP Order FCP: ",$G(A(442,PRCRI(442),1,"E")),?50,"Purchase Date: ",$G(A(442,PRCRI(442),.1,"E"))
115 W !,"Vendor Name: ",$G(A(442,PRCRI(442),5,"E")),?50,"P.O.#: ",$G(A(442,PRCRI(442),.01,"E"))
116 W !,"STATUS: ",$G(A(442,PRCRI(442),.5,"E")),?60,"$Amount: ",$J($G(A(442,PRCRI(442),92,"E")),0,2)
117 W !,"Total Reconciled Charges: ",$J($P($$FP^PRCH0A(PRCRI(442)),U,2),0,2)
118 W !,$TR($J("",78)," ","-")
119 D SS(7,24),MC(1,6) QUIT
120 ;
121DD N A D DPO,SS(12,24),MC(1,6)
122 W !,?20,"to this credit card CHARGE:"
123 D PIECE^PRC0B("440.6;^PRCH(440.6,;"_PRCRI(440.6),".01;8;9;13;20;31","E","A")
124 W !,"Reconcile Doc: ",$G(A(440.6,PRCRI(440.6),.01,"E")),?50,"Purchase Date: ",$G(A(440.6,PRCRI(440.6),8,"E"))
125 W !,"Vendor Name: ",$G(A(440.6,PRCRI(440.6),31,"E")),?50,"P.O.#: ",$G(A(440.6,PRCRI(440.6),20,"E"))
126 W !,"TXN REF: ",$G(A(440.6,PRCRI(440.6),9,"E")),?60,"$Amount: ",$J($G(A(440.6,PRCRI(440.6),13,"E")),0,2)
127 W !,$TR($J("",78)," ","-")
128 D MC(1,11) QUIT
129 ;
130LU() ;low to upper
131 QUIT $TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Note: See TracBrowser for help on using the repository browser.