PRCH1A1 ;WISC/PLT - PRCH1A continued ;6/28/96 09:09
V ;;5.1;IFCAP;**215**;Oct 20, 2000;Build 3
;Per VA Directive 6402, this routine should not be modified.
QUIT ;invalid entry
;
RECON(PRCA,PRCRG) ;PRCA= ri of file 440.6, PRCR = %RANGE for matching amt.
N PRCRI,PRCB,PRCC,PRCD,PRCDI,PRCPDT,PRCBOC,PRCCNT,PRCAMT,PRCCOA,PRCVAL,PRCCP,PRCR,PRCSTC,PRCPO,PRCAMTL,PRCAMTH,PRCCR,PRCCL,PRCCTMP
N A,B,C,D
S PRCRI(440.6)=PRCA,PRCCTMP=""
REC D DD S PRCB=^PRCH(440.6,PRCRI(440.6),0),PRCC=$P(PRCB,U,4),PRCPDT=$P(PRCB,U,9),PRCAMT=$P(PRCB,U,14),PRCPO=$P(PRCB,U,21),PRCCR="",PRCCL=PRCC
S PRCRG=+PRCRG,PRCAMTL=PRCAMT-(PRCAMT*PRCRG/100),PRCAMTH=PRCAMT*PRCRG/100+PRCAMT
Q11 ;lookup
D EN^DDIOL("The system is attempting to locate purchase card order...")
Q12 ;PRC*5.1*215 Add DIR to continue in list and compile list of cards
I PRCCTMP'="" S DIR(0)="E" D ^DIR K DIR
S PRCCTMP=PRCCTMP_"^"_PRCCL
S PRCRI(440.5)=$O(^PRC(440.5,"B",PRCCL,0)) S:PRCRI(440.5)<1 PRCRI(440.5)="00" S PRCRI(442)="" G:PRCPO="" MCA
W !,"Matching Card XXXX"_$E(PRCCL,13,16)_", Vendor's Purchase Order #:",!
S X=PRCRI(440.5),X("S")="I PRC(""SITE"")-^(0)=0,$P($G(^(23)),U,8)="_PRCRI(440.5)_","",1,4,5,6,45,40,41,50,51,""'[("",""_$P($G(^(7)),U,2)_"",""),$P(^(0),U)[PRCPO S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
;
; Change below for NOIS CLA-0199-22457.
S X("W")="N A,B,C,D,PRCBK S $P(PRCBK,$C(8),$L(X)+5)="""",A=$G(^(0)),B=$G(^(1)),C=$G(^(7)) D DISP^PRCH1A1"
S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;","EMXS~~AM","Select Purchase Card Order: ")
I Y>0 S PRCRI(442)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
. D YN^PRC0A(.X,.Y," ...Ok for "_$P(^PRC(442,PRCRI(442),0),"^"),"O","YES") S:X["^"!(X="") Y=-1
. QUIT
W " Not Found"
MCA W !,"Matching Card XXXX"_$E(PRCCL,13,16)_", $Amount within Range "_PRCRG_"%:",!
S X=PRCRI(440.5),X("S")="I PRC(""SITE"")-^(0)=0,$P($G(^(23)),U,8)="_PRCRI(440.5)_","",1,4,5,6,45,40,41,50,51,""'[("",""_$P($G(^(7)),U,2)_"",""),$P(^(0),U,16)'<PRCAMTL&($P(^(0),U,16)'>PRCAMTH) S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
S X("W")="N A,B,C,D,PRCBK S $P(PRCBK,$C(8),$L(X)+5)="""",A=$G(^(0)),B=$G(^(1)),C=$G(^(7)) D DISP^PRCH1A1"
S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;","EMXS~~AM","Select Purchase Card Order: ")
I Y>0 S PRCRI(442)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
. D YN^PRC0A(.X,.Y," ...Ok for "_$P(^PRC(442,PRCRI(442),0),"^"),"O","YES") S:X["^"!(X="") Y=-1
. QUIT
W " Not Found"
W W !,"Listing All Purchase Card Orders with Matched Card XXXX"_$E(PRCCL,13,16)_":",!
S X=PRCDUZ_"~",X("S")="I PRC(""SITE"")-^(0)=0,$P($G(^(23)),U,8)="_PRCRI(440.5)_","",1,4,5,6,45,40,41,50,51,""'[("",""_$P($G(^(7)),U,2)_"","") S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
S X("W")="N A,B,C,D,PRCBK S $P(PRCBK,$C(8),$L(X)+5)="""",A=$G(^(0)),B=$G(^(1)),C=$G(^(7)) D DISP^PRCH1A1"
S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;","EMXS~~MCH","Select Purchase Card Order: ")
I Y>0 S PRCRI(442)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
. D YN^PRC0A(.X,.Y," ...Ok for "_$P(^PRC(442,PRCRI(442),0),"^"),"O","YES") S:X["^"!(X="") Y=-1
. QUIT
W " Not Found"
I PRCCR="" S PRCCR=1,PRCCL=PRCC
;PRC*5.1*215 Check for duplicate matching cards
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),"*#") I PRCCTMP'[PRCCL G:PRCCL]"" Q12
I PRCCR=1 S PRCCR=2,PRCCL=PRCC
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) I PRCCTMP'[PRCCL G:PRCCL]"" Q12
D EN^DDIOL("No Purchase Card Order Selected!")
ACT0 S X(1)=$TR($J("",79)," ","_")
S X(2)=" Action Code: SV: Search P.O. by Vendor SP: Search P.O. by P.O. #",X(3)=" ND: Next Document RS: Reselect RD: Redisplay Data"
S Y(1)="Enter an action code"
D FT^PRC0A(.X,.Y,"Action","","") G:X["^"!(X="") EXIT
S Y=$$LU
I Y="ND" G EXIT
I Y="RS" G REC
I Y="RD" D DD G ACT0
I Y'="SV",Y'="SP" D EN^DDIOL("Invalid Action code, try again") G ACT0
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)_"","")"
S A="AEFIMQ~~"_$S(Y="SV":"D",1:"B^C")
D LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;",A,"Select Purchase Card Order by "_$S(Y="SV":"VENDOR",1:"PURCHASE ORDER #")_": ") QUIT:X["^"
I Y<0 G ACT0
S PRCE=$G(^PRC(442,+Y,23)) I $P(PRCE,"^",22)'=PRCDUZ D EN^DDIOL("This order can only be reconciled by "_$P($G(^VA(200,$P(PRCE,"^",22),0)),"^")_" or their approving official.") G ACT0
S PRCRI(442)=+Y
START D DPO S PRCE=^PRC(442,PRCRI(442),0),PRCCP=$P($G(^(23)),"^",16),PRCR=$P($G(^(23)),"^",15) S:PRCR="" PRCR="N"
I $P($G(^PRC(442,PRCRI(442),23)),U,16)]"",$P($G(^(23)),U,16)'=PRCC D EN^DDIOL("The CC-credit card # and purchase card order card # are different.")
I +$P(PRCE,U,16)'=+PRCAMT D EN^DDIOL("WARNING: The CC-charge amount and purchase card order amount are different.")
ACT1 S X(1)=$TR($J("",79)," ","_")
S X(2)=" Action Code: RC: Reconcile DO: Display Order ND: Next Document",X(3)=" RS: Reselect RD: Redisplay Data DC: Display Charges"
S Y(1)="Enter an action code"
D FT^PRC0A(.X,.Y,"Action","","")
G:X["^"!(X="") EXIT
S Y=$$LU
I Y="ND" G EXIT
I Y="RS" G REC
I Y="DO" D G ACT1
. N D0 S D0=PRCRI(442) D SS(1,24),CS,^PRCHDP1,DPO
. QUIT
I Y="RD" D DPO G ACT1
I Y="DC" D DC^PRCH1A(PRCRI(442)),DPO G ACT1
I Y'="RC" D EN^DDIOL("Invalid Action code, try again") G ACT1
RC ;entry point from prch1d, prch1a2
G RC^PRCH1A3
;
EXIT D:$D(IOSTBM) SS(1,24),CS QUIT
;
SS(IOTM,IOBM) ;screen size a-top, b=bottom margin
W @IOSTBM QUIT
;
MC(DX,DY) ;move cursor dx=column #, dy=row number
S DX=DX-1,DY=DY-1 X IOXY QUIT
;
CS W @IOF QUIT
DISP ;
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)," "
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)
QUIT
;
DD ;display document
N A
D CS W ?20,"You are reconciling this credit card CHARGE:"
D PIECE^PRC0B("440.6;^PRCH(440.6,;"_PRCRI(440.6),".01;8;9;13;20;31","E","A")
W !,"Reconcile Doc: ",$G(A(440.6,PRCRI(440.6),.01,"E")),?50,"Purchase Date: ",$G(A(440.6,PRCRI(440.6),8,"E"))
W !,"Vendor Name: ",$G(A(440.6,PRCRI(440.6),31,"E")),?50,"P.O.#: ",$G(A(440.6,PRCRI(440.6),20,"E"))
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)
W !,$TR($J("",78)," ","-")
D SS(6,24),MC(1,5) QUIT
;
DPO N A D DD,SS(12,24),MC(1,5)
W !,?20,"to this IFCAP purchase card order:"
D PIECE^PRC0B("442;^PRC(442,;"_PRCRI(442),".01;.1;.5;1;5;92","E","A")
W !,"IFCAP Order FCP: ",$G(A(442,PRCRI(442),1,"E")),?50,"Purchase Date: ",$G(A(442,PRCRI(442),.1,"E"))
W !,"Vendor Name: ",$G(A(442,PRCRI(442),5,"E")),?50,"P.O.#: ",$G(A(442,PRCRI(442),.01,"E"))
W !,"STATUS: ",$G(A(442,PRCRI(442),.5,"E")),?60,"$Amount: ",$J($G(A(442,PRCRI(442),92,"E")),0,2)
W !,"Total Reconciled Charges: ",$J($P($$FP^PRCH0A(PRCRI(442)),U,2),0,2)
W !,$TR($J("",78)," ","-")
D MC(1,11) QUIT
;
LU() ;low to upper
QUIT $TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCH1A1 7293 printed Oct 16, 2024@18:05:48 Page 2
PRCH1A1 ;WISC/PLT - PRCH1A continued ;6/28/96 09:09
V ;;5.1;IFCAP;**215**;Oct 20, 2000;Build 3
+1 ;Per VA Directive 6402, this routine should not be modified.
+2 ;invalid entry
QUIT
+3 ;
RECON(PRCA,PRCRG) ;PRCA= ri of file 440.6, PRCR = %RANGE for matching amt.
+1 NEW PRCRI,PRCB,PRCC,PRCD,PRCDI,PRCPDT,PRCBOC,PRCCNT,PRCAMT,PRCCOA,PRCVAL,PRCCP,PRCR,PRCSTC,PRCPO,PRCAMTL,PRCAMTH,PRCCR,PRCCL,PRCCTMP
+2 NEW A,B,C,D
+3 SET PRCRI(440.6)=PRCA
SET PRCCTMP=""
REC DO DD
SET PRCB=^PRCH(440.6,PRCRI(440.6),0)
SET PRCC=$PIECE(PRCB,U,4)
SET PRCPDT=$PIECE(PRCB,U,9)
SET PRCAMT=$PIECE(PRCB,U,14)
SET PRCPO=$PIECE(PRCB,U,21)
SET PRCCR=""
SET PRCCL=PRCC
+1 SET PRCRG=+PRCRG
SET PRCAMTL=PRCAMT-(PRCAMT*PRCRG/100)
SET PRCAMTH=PRCAMT*PRCRG/100+PRCAMT
Q11 ;lookup
+1 DO EN^DDIOL("The system is attempting to locate purchase card order...")
Q12 ;PRC*5.1*215 Add DIR to continue in list and compile list of cards
+1 IF PRCCTMP'=""
SET DIR(0)="E"
DO ^DIR
KILL DIR
+2 SET PRCCTMP=PRCCTMP_"^"_PRCCL
+3 SET PRCRI(440.5)=$ORDER(^PRC(440.5,"B",PRCCL,0))
if PRCRI(440.5)<1
SET PRCRI(440.5)="00"
SET PRCRI(442)=""
if PRCPO=""
GOTO MCA
+4 WRITE !,"Matching Card XXXX"_$EXTRACT(PRCCL,13,16)_", Vendor's Purchase Order #:",!
+5 SET X=PRCRI(440.5)
SET X("S")="I PRC(""SITE"")-^(0)=0,$P($G(^(23)),U,8)="_PRCRI(440.5)_","",1,4,5,6,45,40,41,50,51,""'[("",""_$P($G(^(7)),U,2)_"",""),$P(^(0),U)[PRCPO S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
+6 ;
+7 ; Change below for NOIS CLA-0199-22457.
+8 SET X("W")="N A,B,C,D,PRCBK S $P(PRCBK,$C(8),$L(X)+5)="""",A=$G(^(0)),B=$G(^(1)),C=$G(^(7)) D DISP^PRCH1A1"
+9 SET PRCCNT=""
DO LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;","EMXS~~AM","Select Purchase Card Order: ")
+10 IF Y>0
SET PRCRI(442)=+Y
if PRCCNT
Begin DoDot:1
+11 DO YN^PRC0A(.X,.Y," ...Ok for "_$PIECE(^PRC(442,PRCRI(442),0),"^"),"O","YES")
if X["^"!(X="")
SET Y=-1
+12 QUIT
End DoDot:1
if Y>0
GOTO START
if X["^"
GOTO EXIT
+13 WRITE " Not Found"
MCA WRITE !,"Matching Card XXXX"_$EXTRACT(PRCCL,13,16)_", $Amount within Range "_PRCRG_"%:",!
+1 SET X=PRCRI(440.5)
SET X("S")="I PRC(""SITE"")-^(0)=0,$P($G(^(23)),U,8)="_PRCRI(440.5)_","",1,4,5,6,45,40,41,50,51,""'[("",""_$P($G(^(7)),U,2)_"",""),$P(^(0),U,16)'<PRCAMTL&($P(^(0),U,16)'>PRCAMTH) S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
+2 SET X("W")="N A,B,C,D,PRCBK S $P(PRCBK,$C(8),$L(X)+5)="""",A=$G(^(0)),B=$G(^(1)),C=$G(^(7)) D DISP^PRCH1A1"
+3 SET PRCCNT=""
DO LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;","EMXS~~AM","Select Purchase Card Order: ")
+4 IF Y>0
SET PRCRI(442)=+Y
if PRCCNT
Begin DoDot:1
+5 DO YN^PRC0A(.X,.Y," ...Ok for "_$PIECE(^PRC(442,PRCRI(442),0),"^"),"O","YES")
if X["^"!(X="")
SET Y=-1
+6 QUIT
End DoDot:1
if Y>0
GOTO START
if X["^"
GOTO EXIT
+7 WRITE " Not Found"
W WRITE !,"Listing All Purchase Card Orders with Matched Card XXXX"_$EXTRACT(PRCCL,13,16)_":",!
+1 SET X=PRCDUZ_"~"
SET X("S")="I PRC(""SITE"")-^(0)=0,$P($G(^(23)),U,8)="_PRCRI(440.5)_","",1,4,5,6,45,40,41,50,51,""'[("",""_$P($G(^(7)),U,2)_"","") S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
+2 SET X("W")="N A,B,C,D,PRCBK S $P(PRCBK,$C(8),$L(X)+5)="""",A=$G(^(0)),B=$G(^(1)),C=$G(^(7)) D DISP^PRCH1A1"
+3 SET PRCCNT=""
DO LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;","EMXS~~MCH","Select Purchase Card Order: ")
+4 IF Y>0
SET PRCRI(442)=+Y
if PRCCNT
Begin DoDot:1
+5 DO YN^PRC0A(.X,.Y," ...Ok for "_$PIECE(^PRC(442,PRCRI(442),0),"^"),"O","YES")
if X["^"!(X="")
SET Y=-1
+6 QUIT
End DoDot:1
if Y>0
GOTO START
if X["^"
GOTO EXIT
+7 WRITE " Not Found"
+8 IF PRCCR=""
SET PRCCR=1
SET PRCCL=PRCC
+9 ;PRC*5.1*215 Check for duplicate matching cards
+10 IF PRCCR=1
SET PRCRI(440.599)=$ORDER(^PRC(440.5,"B",PRCCL,0))
IF PRCRI(440.599)>0
SET PRCCL=$TRANSLATE($PIECE($GET(^PRC(440.5,PRCRI(440.599),50)),U),"*#")
IF PRCCTMP'[PRCCL
if PRCCL]""
GOTO Q12
+11 IF PRCCR=1
SET PRCCR=2
SET PRCCL=PRCC
+12 IF PRCCR=2
SET PRCRI(440.599)=$ORDER(^PRC(440.5,"ARPC",PRCCL,0))
IF PRCRI(440.599)
SET PRCCL=$PIECE($GET(^PRC(440.5,PRCRI(440.599),0)),U)
IF PRCCTMP'[PRCCL
if PRCCL]""
GOTO Q12
+13 DO EN^DDIOL("No Purchase Card Order Selected!")
ACT0 SET X(1)=$TRANSLATE($JUSTIFY("",79)," ","_")
+1 SET X(2)=" Action Code: SV: Search P.O. by Vendor SP: Search P.O. by P.O. #"
SET X(3)=" ND: Next Document RS: Reselect RD: Redisplay Data"
+2 SET Y(1)="Enter an action code"
+3 DO FT^PRC0A(.X,.Y,"Action","","")
if X["^"!(X="")
GOTO EXIT
+4 SET Y=$$LU
+5 IF Y="ND"
GOTO EXIT
+6 IF Y="RS"
GOTO REC
+7 IF Y="RD"
DO DD
GOTO ACT0
+8 IF Y'="SV"
IF Y'="SP"
DO EN^DDIOL("Invalid Action code, try again")
GOTO ACT0
+9 SET 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)_"","")"
+10 SET A="AEFIMQ~~"_$SELECT(Y="SV":"D",1:"B^C")
+11 DO LOOKUP^PRC0B(.X,.Y,"442;^PRC(442,;",A,"Select Purchase Card Order by "_$SELECT(Y="SV":"VENDOR",1:"PURCHASE ORDER #")_": ")
if X["^"
QUIT
+12 IF Y<0
GOTO ACT0
+13 SET PRCE=$GET(^PRC(442,+Y,23))
IF $PIECE(PRCE,"^",22)'=PRCDUZ
DO EN^DDIOL("This order can only be reconciled by "_$PIECE($GET(^VA(200,$PIECE(PRCE,"^",22),0)),"^")_" or their approving official.")
GOTO ACT0
+14 SET PRCRI(442)=+Y
START DO DPO
SET PRCE=^PRC(442,PRCRI(442),0)
SET PRCCP=$PIECE($GET(^(23)),"^",16)
SET PRCR=$PIECE($GET(^(23)),"^",15)
if PRCR=""
SET PRCR="N"
+1 IF $PIECE($GET(^PRC(442,PRCRI(442),23)),U,16)]""
IF $PIECE($GET(^(23)),U,16)'=PRCC
DO EN^DDIOL("The CC-credit card # and purchase card order card # are different.")
+2 IF +$PIECE(PRCE,U,16)'=+PRCAMT
DO EN^DDIOL("WARNING: The CC-charge amount and purchase card order amount are different.")
ACT1 SET X(1)=$TRANSLATE($JUSTIFY("",79)," ","_")
+1 SET X(2)=" Action Code: RC: Reconcile DO: Display Order ND: Next Document"
SET X(3)=" RS: Reselect RD: Redisplay Data DC: Display Charges"
+2 SET Y(1)="Enter an action code"
+3 DO FT^PRC0A(.X,.Y,"Action","","")
+4 if X["^"!(X="")
GOTO EXIT
+5 SET Y=$$LU
+6 IF Y="ND"
GOTO EXIT
+7 IF Y="RS"
GOTO REC
+8 IF Y="DO"
Begin DoDot:1
+9 NEW D0
SET D0=PRCRI(442)
DO SS(1,24)
DO CS
DO ^PRCHDP1
DO DPO
+10 QUIT
End DoDot:1
GOTO ACT1
+11 IF Y="RD"
DO DPO
GOTO ACT1
+12 IF Y="DC"
DO DC^PRCH1A(PRCRI(442))
DO DPO
GOTO ACT1
+13 IF Y'="RC"
DO EN^DDIOL("Invalid Action code, try again")
GOTO ACT1
RC ;entry point from prch1d, prch1a2
+1 GOTO RC^PRCH1A3
+2 ;
EXIT if $DATA(IOSTBM)
DO SS(1,24)
DO CS
QUIT
+1 ;
SS(IOTM,IOBM) ;screen size a-top, b=bottom margin
+1 WRITE @IOSTBM
QUIT
+2 ;
MC(DX,DY) ;move cursor dx=column #, dy=row number
+1 SET DX=DX-1
SET DY=DY-1
XECUTE IOXY
QUIT
+2 ;
CS WRITE @IOF
QUIT
DISP ;
+1 WRITE " "_PRCBK
SET D=$PIECE(B,U,15)
WRITE " ",$PIECE(A,U)," ",$EXTRACT(D,4,5),"-",$EXTRACT(D,6,7),"-",$EXTRACT(D,2,3)," "
if $PIECE(A,U,2)
WRITE $PIECE(^PRCD(442.5,$PIECE(A,U,2),0),U,2)," "
+2 if $PIECE(C,U)
WRITE $EXTRACT($PIECE(^PRCD(442.3,$PIECE(C,U),0),U),1,34)
WRITE !,?13,"FCP: ",$PIECE($PIECE(A,U,3)," ")," ",$JUSTIFY($PIECE(A,U,16),0,2)
if $PIECE(B,U)
WRITE ?35,$PIECE($GET(^PRC(440,$PIECE(B,U),0)),U)
+3 QUIT
+4 ;
DD ;display document
+1 NEW A
+2 DO CS
WRITE ?20,"You are reconciling this credit card CHARGE:"
+3 DO PIECE^PRC0B("440.6;^PRCH(440.6,;"_PRCRI(440.6),".01;8;9;13;20;31","E","A")
+4 WRITE !,"Reconcile Doc: ",$GET(A(440.6,PRCRI(440.6),.01,"E")),?50,"Purchase Date: ",$GET(A(440.6,PRCRI(440.6),8,"E"))
+5 WRITE !,"Vendor Name: ",$GET(A(440.6,PRCRI(440.6),31,"E")),?50,"P.O.#: ",$GET(A(440.6,PRCRI(440.6),20,"E"))
+6 WRITE !,"TXN REF: ",$GET(A(440.6,PRCRI(440.6),9,"E")),?60,"$Amount: ",$JUSTIFY($GET(A(440.6,PRCRI(440.6),13,"E")),0,2)
+7 WRITE !,$TRANSLATE($JUSTIFY("",78)," ","-")
+8 DO SS(6,24)
DO MC(1,5)
QUIT
+9 ;
DPO NEW A
DO DD
DO SS(12,24)
DO MC(1,5)
+1 WRITE !,?20,"to this IFCAP purchase card order:"
+2 DO PIECE^PRC0B("442;^PRC(442,;"_PRCRI(442),".01;.1;.5;1;5;92","E","A")
+3 WRITE !,"IFCAP Order FCP: ",$GET(A(442,PRCRI(442),1,"E")),?50,"Purchase Date: ",$GET(A(442,PRCRI(442),.1,"E"))
+4 WRITE !,"Vendor Name: ",$GET(A(442,PRCRI(442),5,"E")),?50,"P.O.#: ",$GET(A(442,PRCRI(442),.01,"E"))
+5 WRITE !,"STATUS: ",$GET(A(442,PRCRI(442),.5,"E")),?60,"$Amount: ",$JUSTIFY($GET(A(442,PRCRI(442),92,"E")),0,2)
+6 WRITE !,"Total Reconciled Charges: ",$JUSTIFY($PIECE($$FP^PRCH0A(PRCRI(442)),U,2),0,2)
+7 WRITE !,$TRANSLATE($JUSTIFY("",78)," ","-")
+8 DO MC(1,11)
QUIT
+9 ;
LU() ;low to upper
+1 QUIT $TRANSLATE(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
