| 1 | PRCH1A ;WISC/PLT-PURCHASE CARD RECONCILIATION ;8/28/98 11:46
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ;invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | EN ;reconcile purchase card order
|
|---|
| 7 | N PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRC,PRCC,PRCE,PRCF,PRCG,PRCVAL,PRCQT,PRCSST,PRCSTC
|
|---|
| 8 | N PRCSELF,PRCCN,PRCCNT,PRCR
|
|---|
| 9 | N A,B,C
|
|---|
| 10 | I $G(IOSTBM)="" S X="IOSTBM" D ENDR^%ZISS I $G(IOSTBM)="" D EN^DDIOL("Wrong type terminal (missing IOSTBM)!") QUIT
|
|---|
| 11 | I $G(IOXY)="" D EN^DDIOL("Wrong type terminal (missing IOXY)!") QUIT
|
|---|
| 12 | Q1 ;station
|
|---|
| 13 | S PRCSST=1 D STA^PRCSUT S PRCSTC=SI G:$G(PRC("SITE"))=""!(Y<0)!(PRCSTC<1) EXIT
|
|---|
| 14 | S PRCRI(420)=+PRC("SITE"),PRCR=$P($G(^PRC(411,PRCRI(420),9)),"^",7)
|
|---|
| 15 | Q2 S B="O^1:Auto Charge Selection;2:Manual Charge Selection;3:Reconcile by Purchase Card Order #"
|
|---|
| 16 | K X,Y S Y(1)="^W ""Enter an option number 1 to 3."""
|
|---|
| 17 | D SC^PRC0A(.X,.Y,"Select Number",B,"")
|
|---|
| 18 | S A=Y K X,Y
|
|---|
| 19 | G EXIT:A=""!(A["^")
|
|---|
| 20 | S PRCOPT=+A G:PRCOPT=3 Q7
|
|---|
| 21 | S PRCSELF=1 I $D(^PRC(440.5,"MAA",DUZ)) D G Q2:X=""!(X["^") S PRCSELF=Y
|
|---|
| 22 | . D YN^PRC0A(.X,.Y,"Reconcile for your own purchase card orders","O","")
|
|---|
| 23 | . QUIT
|
|---|
| 24 | S PRCCN="" I PRCOPT=1,PRCSELF S PRCDUZ=DUZ G AUTO
|
|---|
| 25 | Q21 I PRCSELF S X("S")="I $P(^(2),U,3)=PRC(""SITE""),$P(^(0),U,8)=DUZ"
|
|---|
| 26 | E S X("S")="I $P(^(2),U,3)=PRC(""SITE""),$P(^(0),U,9)=DUZ!($P(^(0),U,10)=DUZ)"
|
|---|
| 27 | S X("W")="W "" "",$P(^(0),U,11),"" "" W:$P(^(0),U,8) $P($G(^VA(200,$P(^(0),U,8),0)),U)"
|
|---|
| 28 | D LOOKUP^PRC0B(.X,.Y,"440.5;^PRC(440.5,;","AEMOQS~~G^MAA^H^D","Select Purchase Credit Card/Holder: ")
|
|---|
| 29 | I X["^"!(X="")!(Y<1) G Q1
|
|---|
| 30 | S PRCRI(440.5)=+Y,PRCDUZ=$P(^PRC(440.5,PRCRI(440.5),0),U,8),PRCCN=$P(^(0),U)
|
|---|
| 31 | G:PRCOPT=1 AUTO
|
|---|
| 32 | Q3 ;select oracle cc-record
|
|---|
| 33 | W !! D EN^DDIOL("Manual Select by Listing Unreconciled C-payment document:")
|
|---|
| 34 | S X("S")="I $P(^(0),U,8)=PRC(""SITE""),$P(^(0),U,4)="_PRCCN_" S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
|
|---|
| 35 | ;
|
|---|
| 36 | ; Change below for NOIS CLA-0199-22457
|
|---|
| 37 | 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)"
|
|---|
| 38 | S X="N"_PRCDUZ_"~",PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EOQS~~ST","Select C-payment document: ")
|
|---|
| 39 | I Y<0!(X="") S PRCQT="^" D EN^DDIOL("MANUAL reconciliation ends") G Q2
|
|---|
| 40 | K X S PRCRI(440.6)=+Y
|
|---|
| 41 | D RECON^PRCH1A1(PRCRI(440.6),PRCR)
|
|---|
| 42 | I X["^"!$D(DUOUT)!PRCCNT S PRCQT="^" D EN^DDIOL("MANUAL reconciliation ends") G Q2
|
|---|
| 43 | G Q3
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | Q7 ;select purchase order
|
|---|
| 47 | S X("S")="I PRC(""SITE"")-^(0)=0,$P(^(0),U,2)=25,$P($G(^(23)),U,22),"",1,4,5,6,45,40,41,50,51,""'[("",""_$P($G(^(7)),U,2)_"","")"
|
|---|
| 48 | S X("W")="N A,B,C,D,PRCBK S $P(PRCBK,$C(8),$L(X)+4)="""",A=$G(^(0)),B=$G(^(1)),C=$G(^(7)) D DISP^PRCH1A1"
|
|---|
| 49 | D LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;","AEFIMQ~~B^C","Select Purchase Card Order #: ") G:X["^" Q1
|
|---|
| 50 | I Y<0 G Q2
|
|---|
| 51 | S PRCRI(442)=+Y
|
|---|
| 52 | D RECON^PRCH1A2(PRCRI(442),DUZ,PRCR) G Q7
|
|---|
| 53 | ;
|
|---|
| 54 | AUTO ;start auto
|
|---|
| 55 | S PRCRI(440.6)=""
|
|---|
| 56 | F S PRCRI(440.6)=$O(^PRCH(440.6,"ST","N"_PRCDUZ_"~",PRCRI(440.6))) QUIT:'PRCRI(440.6) S A=^PRCH(440.6,PRCRI(440.6),0) I $P(A,"^",8)=PRC("SITE"),PRCSELF!($P(A,U,4)=PRCCN&'PRCSELF) D RECON^PRCH1A1(PRCRI(440.6),PRCR) QUIT:$D(DUOUT)!($G(X)["^")
|
|---|
| 57 | K DUOUT
|
|---|
| 58 | D EN^DDIOL("AUTO reconciliation ends.")
|
|---|
| 59 | EXIT QUIT
|
|---|
| 60 | ;
|
|---|
| 61 | DC(PRCA) ;diplay all charges, PRCA =IEN of file 442
|
|---|
| 62 | N L,DIC,FLDS,BY,FR,TO,DHD
|
|---|
| 63 | S DIC="^PRCH(440.6,",L=0,BY="@NUMBER",(FR,TO)=""
|
|---|
| 64 | S BY(0)="^PRCH(440.6,""PO"","_PRCA_",",L(0)=1
|
|---|
| 65 | S DHD="All Reconciled Charges for "_$P($G(^PRC(442,PRCA,0)),U)_" with AMOUNT $"_$J($P($G(^(0)),U,16),0,2)
|
|---|
| 66 | S PRCA=$O(^PRCH(440.6,"PO",PRCA,0))
|
|---|
| 67 | S FLDS=".01;""Charge Id"",8;""PO Date"",31;L30;""Vendor"",20;C5;""P.O. #"",9;""TXN Ref"",&13;C60;R15;""Reconciled $AMT"""
|
|---|
| 68 | I PRCA D EN1^DIP
|
|---|
| 69 | D EOP^PRC0A(.X,.Y,$S(PRCA:"End of All Reconciled Charge List",1:"No Reconciled Charges for This P.O. Order")_" and Hit 'Return' to Continue","","")
|
|---|
| 70 | QUIT
|
|---|
