| 1 | PRCH1B1 ;WISC/PLT-PRCH1B continued ; 03/01/96  1:27 PM | 
|---|
| 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 | APREC(PRCA) ;approve reconciled purchase card orders | 
|---|
| 7 | N PRC,PRCB,PRCC,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRCST | 
|---|
| 8 | N A,B,C,X,Y | 
|---|
| 9 | S PRCRI(442)=PRCA G APP | 
|---|
| 10 | D PIECE^PRC0B("442;^PRC(442,;"_PRCRI(442),".01;.5;91;92;13;56","E","A") | 
|---|
| 11 | W !,"PURCHASE CARD ORDER: ",$G(A(442,PRCRI(442),.01,"E")),?40,"STATUS: ",$G(A(442,PRCRI(442),.5,"E")) | 
|---|
| 12 | W !,"TOTAL AMOUNT: ",$J($G(A(442,PRCRI(442),91,"E")),8,2),?40,"NET AMOUNT: ",$J($G(A(442,PRCRI(442),92,"E")),8,2) | 
|---|
| 13 | W !,"EST. SHIP/HANDLING: ",$J($G(A(442,PRCRI(442),13,"E")),8,2) | 
|---|
| 14 | W !,"PURCHASE CARD ORDER BY: ",$G(A(442,PRCRI(442),56,"E")) | 
|---|
| 15 | S PRC("SITE")=$P($G(A(442,PRCRI(442),.01,"E")),"-") | 
|---|
| 16 | K A | 
|---|
| 17 | Q1 D YN^PRC0A(.X,.Y,"Display Purchase Card Order","O","NO") | 
|---|
| 18 | I X["^"!(X="") G EXIT | 
|---|
| 19 | I Y D | 
|---|
| 20 | . N D0 S D0=PRCRI(442) D ^PRCHDP1 | 
|---|
| 21 | . QUIT | 
|---|
| 22 | Q2 D YN^PRC0A(.X,.Y,"Ready to Approve","O","YES") | 
|---|
| 23 | I X["^"!(X="")!'Y G EXIT | 
|---|
| 24 | APP S PRCST=$S($D(^PRC(442,PRCRI(442),6)):41,1:40) | 
|---|
| 25 | D EDIT^PRC0B(.X,"442;^PRC(442,;"_PRCRI(442),".5///"_PRCST_";57////"_DUZ) | 
|---|
| 26 | N APPDATE,TEMP,P4406 S TEMP=X D NOW^%DTC S APPDATE=X,X=TEMP | 
|---|
| 27 | S P4406="" F  S P4406=$O(^PRCH(440.6,"PO",PRCRI(442),P4406)) Q:P4406=""  D EDIT^PRC0B(.X,"440.6;^PRCH(440.6,;"_P4406,"26///"_APPDATE_";27////"_DUZ) | 
|---|
| 28 | EXIT D EN^DDIOL(" ") QUIT | 
|---|