- PRCH1A2 ;WISC/PLT-PRCH1A continued ;6/10/97 15:22
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUIT ;invalid entry
- ;
- RECON(PRCA,PRCB,PRCRG) ;PRCA= ri of file 442, PRCB =ri of file 200,PRCRG=reconcile range %
- ;X=return variable =1 if reconciled with final charge, =0 not final charge
- N PRCRI,PRCC,PRCD,PRCDI,PRCPDT,PRCBOC,PRCCNT,PRCAMT,PRCCOA,PRCVAL,PRCCP,PRCR,PRCSTC,PRCPO,PRCAMTL,PRCAMTH,PRCER,PRCCR,PRCCL
- N A,B,C,D
- S PRCRI(442)=PRCA,PRCRI(200)=PRCB,PRCRI(440.5)=$P($G(^PRC(442,PRCRI(442),23)),"^",8)
- D DPO
- I 'PRCRI(440.5) D EN^DDIOL("This is not a purchase card order.") S PRCER=1 G EXIT
- S A="^"_$P(^PRC(440.5,PRCRI(440.5),0),"^",8,10)_"^"
- 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
- S PRCB=$G(^PRC(442,PRCRI(442),7))
- 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
- S X="~"
- REC 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=""
- I 'PRCDUZ D EN^DDIOL("The purchase card holder in the purchase card order file (#442) is missing!") S PRCER=4 G EXIT
- I 'PRCC D EN^DDIOL("The purchase card # in the purchase card order file (#442) is missing!") S PRCER=4.1 G EXIT
- S PRCRG=+PRCRG,PRCAMTL=PRCAMT-(PRCAMT*PRCRG/100),PRCAMTH=PRCAMT*PRCRG/100+PRCAMT
- S PRCC=$P($G(^PRC(440.5,PRCC,0)),U),PRCCL=PRCC
- Q11 ;lookup
- D EN^DDIOL("The system is attempting to locate credit card charge...")
- Q12 S PRCRI(440.6)="" G:PRCPO="" MCA
- W !,"Matching Card XXXX"_$E(PRCCL,13,16)_", Vendor's Purchase Order #:",!
- 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"
- ;
- ; Change below for NOIS CLA-0199-22457
- 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)"
- S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Selec Credit Card Charge: ")
- I Y>0 S PRCRI(440.6)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
- . 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
- . QUIT
- W " Not Found"
- MCA W !,"Matching Card XXXX"_$E(PRCCL,13,16)_", $Amount within Range "_PRCRG_"%:",!
- 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"
- 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)"
- S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Select Purchase Card Charge: ")
- I Y>0 S PRCRI(440.6)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
- . 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
- . QUIT
- W " Not Found"
- W W !,"Listing All Credit Card Charges with Matched Card XXXX"_$E(PRCCL,13,16)_":",!
- 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"
- 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)"
- S PRCCNT="" D LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Select Purchase Card Charge: ")
- I Y>0 S PRCRI(440.6)=+Y D:PRCCNT G START:Y>0,EXIT:X["^"
- . 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
- . QUIT
- W " Not Found"
- I PRCCR="" S PRCCR=1,PRCCL=PRCC
- 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
- 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) G:PRCCL]"" Q12
- D EN^DDIOL("No Credit Card Charges Selected!")
- ACT0 S X(1)=$TR($J("",79)," ","_")
- S X(2)=" Action Code: RS: Reselect Charges RD: Redisplay Data",X(3)=" NP: Next Purchase Order 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="NP" G EXIT
- I Y="RS" G REC
- I Y="RD" D DPO G ACT0
- I Y="DC" D DC^PRCH1A(PRCRI(442)),DPO G ACT0
- D EN^DDIOL("Invalid Action code, try again") G ACT0
- ;
- START D DD S PRCE=^PRCH(440.6,PRCRI(440.6),0),PRCCP=$P(PRCE,"^",4),PRCR=$P($G(^(23)),"^",15) S:PRCR="" PRCR="N"
- D DD S PRCE=^PRCH(440.6,PRCRI(440.6),0),PRCCP=$P(PRCE,U,4)
- I PRCCP]"",PRCCP'=PRCC D EN^DDIOL("The CC-credit card # and purchase card order card # are different.")
- I +$P(PRCE,U,14)'=+PRCAMT D EN^DDIOL("WARNING: The CC-charge amount and purchase card order amount are different.")
- S PRCE=^PRC(442,PRCRI(442),0),PRCCP=$P($G(^(23)),"^",16),PRCR=$P($G(^(23)),"^",15) S:PRCR="" PRCR="N"
- ACT1 S X(1)=$TR($J("",79)," ","_")
- S X(2)=" Action Code: RC: Reconcile DO: Display Order RS: Reselect Charges",X(3)=" 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="RS" G REC
- I Y="DO" D G ACT1
- . N D0 S D0=PRCRI(442) D SS(1,24),CS,^PRCHDP1,DD
- . QUIT
- I Y="RD" D DD G ACT1
- I Y="DC" D DC^PRCH1A(PRCRI(442)),DD G ACT1
- I Y'="RC" D EN^DDIOL("Invalid Action code, try again") G ACT1
- RC ;call reconcile routine PRCH1A1
- D RC^PRCH1A1
- I $P($G(^PRCH(440.6,PRCRI(440.6),1)),"^",4)="Y" S PRCER=-1 G EXIT
- D DPO
- D YN^PRC0A(.X,.Y,"Reconcile More Credit Card Charges to This Purchase Order","O","NO")
- I Y G REC
- EXIT I $G(PRCER)>0 D FT^PRC0A(.X,.Y,"Enter 'RETURN' to Continue","O")
- D:$D(IOSTBM) SS(1,24),CS
- S X=$S($G(PRCER)=-1:1,1:0)
- 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 ;
- QUIT
- 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
- ;
- DPO ;display purchase order
- N A
- D CS W ?18,"You are reconciling this 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 SS(7,24),MC(1,6) QUIT
- ;
- DD N A D DPO,SS(12,24),MC(1,6)
- W !,?20,"to 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 MC(1,11) QUIT
- ;
- LU() ;low to upper
- QUIT $TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCH1A2 7982 printed Apr 23, 2025@18:19:32 Page 2
- PRCH1A2 ;WISC/PLT-PRCH1A continued ;6/10/97 15:22
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;invalid entry
- QUIT
- +3 ;
- RECON(PRCA,PRCB,PRCRG) ;PRCA= ri of file 442, PRCB =ri of file 200,PRCRG=reconcile range %
- +1 ;X=return variable =1 if reconciled with final charge, =0 not final charge
- +2 NEW PRCRI,PRCC,PRCD,PRCDI,PRCPDT,PRCBOC,PRCCNT,PRCAMT,PRCCOA,PRCVAL,PRCCP,PRCR,PRCSTC,PRCPO,PRCAMTL,PRCAMTH,PRCER,PRCCR,PRCCL
- +3 NEW A,B,C,D
- +4 SET PRCRI(442)=PRCA
- SET PRCRI(200)=PRCB
- SET PRCRI(440.5)=$PIECE($GET(^PRC(442,PRCRI(442),23)),"^",8)
- +5 DO DPO
- +6 IF 'PRCRI(440.5)
- DO EN^DDIOL("This is not a purchase card order.")
- SET PRCER=1
- GOTO EXIT
- +7 SET A="^"_$PIECE(^PRC(440.5,PRCRI(440.5),0),"^",8,10)_"^"
- +8 IF A'[("^"_PRCB_"^")
- DO EN^DDIOL("This order can only be reconciled by its card holder or (alt) approving officials.")
- SET PRCER=2
- GOTO EXIT
- +9 SET PRCB=$GET(^PRC(442,PRCRI(442),7))
- +10 IF ",1,4,5,6,45,40,41,50,51,"[(","_$PIECE(PRCB,U,2)_",")
- DO EN^DDIOL("The purchase card order has a wrong status to reconcile.")
- SET PRCER=3
- GOTO EXIT
- +11 SET X="~"
- REC if X'="~"
- DO DPO
- SET PRCB=^PRC(442,PRCRI(442),23)
- SET PRCC=$PIECE(PRCB,U,8)
- SET PRCAMT=$PIECE(^(0),U,16)
- SET PRCPO=$PIECE(^(0),U)
- SET PRCDUZ=$PIECE(PRCB,"^",22)
- SET PRCCR=""
- +1 IF 'PRCDUZ
- DO EN^DDIOL("The purchase card holder in the purchase card order file (#442) is missing!")
- SET PRCER=4
- GOTO EXIT
- +2 IF 'PRCC
- DO EN^DDIOL("The purchase card # in the purchase card order file (#442) is missing!")
- SET PRCER=4.1
- GOTO EXIT
- +3 SET PRCRG=+PRCRG
- SET PRCAMTL=PRCAMT-(PRCAMT*PRCRG/100)
- SET PRCAMTH=PRCAMT*PRCRG/100+PRCAMT
- +4 SET PRCC=$PIECE($GET(^PRC(440.5,PRCC,0)),U)
- SET PRCCL=PRCC
- Q11 ;lookup
- +1 DO EN^DDIOL("The system is attempting to locate credit card charge...")
- Q12 SET PRCRI(440.6)=""
- if PRCPO=""
- GOTO MCA
- +1 WRITE !,"Matching Card XXXX"_$EXTRACT(PRCCL,13,16)_", Vendor's Purchase Order #:",!
- +2 SET X="N"_PRCDUZ_"~"
- SET 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"
- +3 ;
- +4 ; Change below for NOIS CLA-0199-22457
- +5 SET 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)"
- +6 SET PRCCNT=""
- DO LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Selec Credit Card Charge: ")
- +7 IF Y>0
- SET PRCRI(440.6)=+Y
- if PRCCNT
- Begin DoDot:1
- +8 DO YN^PRC0A(.X,.Y," ...Ok for "_$PIECE(^PRCH(440.6,PRCRI(440.6),0),U,21)_" "_$PIECE($GET(^(6)),U),"O","YES")
- if X["^"!(X="")
- SET Y=-1
- +9 QUIT
- End DoDot:1
- if Y>0
- GOTO START
- if X["^"
- GOTO EXIT
- +10 WRITE " Not Found"
- MCA WRITE !,"Matching Card XXXX"_$EXTRACT(PRCCL,13,16)_", $Amount within Range "_PRCRG_"%:",!
- +1 SET X="N"_PRCDUZ_"~"
- SET 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"
- +2 SET 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)"
- +3 SET PRCCNT=""
- DO LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Select Purchase Card Charge: ")
- +4 IF Y>0
- SET PRCRI(440.6)=+Y
- if PRCCNT
- Begin DoDot:1
- +5 DO YN^PRC0A(.X,.Y," ...Ok for "_$PIECE(^PRCH(440.6,PRCRI(440.6),0),U,21)_" "_$PIECE($GET(^(6)),U),"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 Credit Card Charges with Matched Card XXXX"_$EXTRACT(PRCCL,13,16)_":",!
- +1 SET X="N"_PRCDUZ_"~"
- SET X("S")="I PRCPO-$P(^(0),U,8)=0,$P(^(0),U,4)="_PRCCL_" S:PRCCNT="""" PRCCNT=+Y S:PRCCNT-Y PRCCNT=0"
- +2 SET 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)"
- +3 SET PRCCNT=""
- DO LOOKUP^PRC0B(.X,.Y,"440.6;^PRCH(440.6,;","EMS~~ST","Select Purchase Card Charge: ")
- +4 IF Y>0
- SET PRCRI(440.6)=+Y
- if PRCCNT
- Begin DoDot:1
- +5 DO YN^PRC0A(.X,.Y," ...Ok for "_$PIECE(^PRCH(440.6,PRCRI(440.6),0),U,21)_" "_$PIECE($GET(^(6)),U),"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 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 PRCCL]""
- GOTO Q12
- +10 IF PRCCR=1
- SET PRCCR=2
- SET PRCCL=PRCC
- +11 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 PRCCL]""
- GOTO Q12
- +12 DO EN^DDIOL("No Credit Card Charges Selected!")
- ACT0 SET X(1)=$TRANSLATE($JUSTIFY("",79)," ","_")
- +1 SET X(2)=" Action Code: RS: Reselect Charges RD: Redisplay Data"
- SET X(3)=" NP: Next Purchase Order DC: Display Charges"
- +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="NP"
- GOTO EXIT
- +6 IF Y="RS"
- GOTO REC
- +7 IF Y="RD"
- DO DPO
- GOTO ACT0
- +8 IF Y="DC"
- DO DC^PRCH1A(PRCRI(442))
- DO DPO
- GOTO ACT0
- +9 DO EN^DDIOL("Invalid Action code, try again")
- GOTO ACT0
- +10 ;
- START DO DD
- SET PRCE=^PRCH(440.6,PRCRI(440.6),0)
- SET PRCCP=$PIECE(PRCE,"^",4)
- SET PRCR=$PIECE($GET(^(23)),"^",15)
- if PRCR=""
- SET PRCR="N"
- +1 DO DD
- SET PRCE=^PRCH(440.6,PRCRI(440.6),0)
- SET PRCCP=$PIECE(PRCE,U,4)
- +2 IF PRCCP]""
- IF PRCCP'=PRCC
- DO EN^DDIOL("The CC-credit card # and purchase card order card # are different.")
- +3 IF +$PIECE(PRCE,U,14)'=+PRCAMT
- DO EN^DDIOL("WARNING: The CC-charge amount and purchase card order amount are different.")
- +4 SET PRCE=^PRC(442,PRCRI(442),0)
- SET PRCCP=$PIECE($GET(^(23)),"^",16)
- SET PRCR=$PIECE($GET(^(23)),"^",15)
- if PRCR=""
- SET PRCR="N"
- ACT1 SET X(1)=$TRANSLATE($JUSTIFY("",79)," ","_")
- +1 SET X(2)=" Action Code: RC: Reconcile DO: Display Order RS: Reselect Charges"
- SET X(3)=" 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="RS"
- GOTO REC
- +7 IF Y="DO"
- Begin DoDot:1
- +8 NEW D0
- SET D0=PRCRI(442)
- DO SS(1,24)
- DO CS
- DO ^PRCHDP1
- DO DD
- +9 QUIT
- End DoDot:1
- GOTO ACT1
- +10 IF Y="RD"
- DO DD
- GOTO ACT1
- +11 IF Y="DC"
- DO DC^PRCH1A(PRCRI(442))
- DO DD
- GOTO ACT1
- +12 IF Y'="RC"
- DO EN^DDIOL("Invalid Action code, try again")
- GOTO ACT1
- RC ;call reconcile routine PRCH1A1
- +1 DO RC^PRCH1A1
- +2 IF $PIECE($GET(^PRCH(440.6,PRCRI(440.6),1)),"^",4)="Y"
- SET PRCER=-1
- GOTO EXIT
- +3 DO DPO
- +4 DO YN^PRC0A(.X,.Y,"Reconcile More Credit Card Charges to This Purchase Order","O","NO")
- +5 IF Y
- GOTO REC
- EXIT IF $GET(PRCER)>0
- DO FT^PRC0A(.X,.Y,"Enter 'RETURN' to Continue","O")
- +1 if $DATA(IOSTBM)
- DO SS(1,24)
- DO CS
- +2 SET X=$SELECT($GET(PRCER)=-1:1,1:0)
- +3 QUIT
- +4 ;
- 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 QUIT
- +2 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)," "
- +3 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)
- +4 QUIT
- +5 ;
- DPO ;display purchase order
- +1 NEW A
- +2 DO CS
- WRITE ?18,"You are reconciling this PURCHASE CARD ORDER:"
- +3 DO PIECE^PRC0B("442;^PRC(442,;"_PRCRI(442),".01;.1;.5;1;5;92","E","A")
- +4 WRITE !,"IFCAP Order FCP: ",$GET(A(442,PRCRI(442),1,"E")),?50,"Purchase Date: ",$GET(A(442,PRCRI(442),.1,"E"))
- +5 WRITE !,"Vendor Name: ",$GET(A(442,PRCRI(442),5,"E")),?50,"P.O.#: ",$GET(A(442,PRCRI(442),.01,"E"))
- +6 WRITE !,"STATUS: ",$GET(A(442,PRCRI(442),.5,"E")),?60,"$Amount: ",$JUSTIFY($GET(A(442,PRCRI(442),92,"E")),0,2)
- +7 WRITE !,"Total Reconciled Charges: ",$JUSTIFY($PIECE($$FP^PRCH0A(PRCRI(442)),U,2),0,2)
- +8 WRITE !,$TRANSLATE($JUSTIFY("",78)," ","-")
- +9 DO SS(7,24)
- DO MC(1,6)
- QUIT
- +10 ;
- DD NEW A
- DO DPO
- DO SS(12,24)
- DO MC(1,6)
- +1 WRITE !,?20,"to this credit card CHARGE:"
- +2 DO PIECE^PRC0B("440.6;^PRCH(440.6,;"_PRCRI(440.6),".01;8;9;13;20;31","E","A")
- +3 WRITE !,"Reconcile Doc: ",$GET(A(440.6,PRCRI(440.6),.01,"E")),?50,"Purchase Date: ",$GET(A(440.6,PRCRI(440.6),8,"E"))
- +4 WRITE !,"Vendor Name: ",$GET(A(440.6,PRCRI(440.6),31,"E")),?50,"P.O.#: ",$GET(A(440.6,PRCRI(440.6),20,"E"))
- +5 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)
- +6 WRITE !,$TRANSLATE($JUSTIFY("",78)," ","-")
- +7 DO MC(1,11)
- QUIT
- +8 ;
- LU() ;low to upper
- +1 QUIT $TRANSLATE(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
