source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH1B1.m@ 846

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1PRCH1B1 ;WISC/PLT-PRCH1B continued ; 03/01/96 1:27 PM
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 ;
6APREC(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
17Q1 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
22Q2 D YN^PRC0A(.X,.Y,"Ready to Approve","O","YES")
23 I X["^"!(X="")!'Y G EXIT
24APP 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)
28EXIT D EN^DDIOL(" ") QUIT
Note: See TracBrowser for help on using the repository browser.