source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAWR1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1PRCPAWR1 ;WISC/DWA,RFJ-print register approval form (end of report) ;11 Mar 94
2 ;;5.1;IFCAP;**4**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7BUILD ; build tmp global for printing the report
8 N DA,DATA,TRANID
9 K ^TMP($J,"PRCPAWR0 DA")
10 ; build selected adjustements only
11 I $O(^TMP($J,"PRCPAWR0",""))'="" D Q
12 . S TRANID="" F S TRANID=$O(^TMP($J,"PRCPAWR0",TRANID)) Q:$E(TRANID)'="A" D BUILD1
13 ; build all adjustments
14 S TRANID="A" F S TRANID=$O(^PRCP(445.2,"T",PRCP("I"),TRANID)) Q:$E(TRANID)'="A" D BUILD1
15 Q
16 ;
17 ;
18BUILD1 ; build tmp global with adjustment data
19 S DA=0 F S DA=$O(^PRCP(445.2,"T",PRCP("I"),TRANID,DA)) Q:'DA S DATA=$G(^PRCP(445.2,DA,0)) I DATA'="" D
20 . I $P(DATA,"^",20)="" S ^TMP($J,"PRCPAWR0 DA",TRANID,DA)=""
21 Q
22 ;
23 ;
24END ; print end of report information
25 W !!,"----------- S U M M A R Y O F I T E M A C C O U N T C O D E S ----------"
26 S TOTAL=0,ACCT=0 F S ACCT=$O(ACCOUNT(ACCT)) Q:ACCT=""!$G(PRCPFLAG) S DATA=ACCOUNT(ACCT) D
27 . I $X>40 W !
28 . E W ?40
29 . W "ACCT: ",ACCT,?($S($X<10:10,1:50)),"INV AMOUNT: ",$J(DATA,12,2) S TOTAL=TOTAL+DATA
30 . I $Y>(IOSL-2),$X>40,$O(^TMP($J,"ACCT",ACCT))'="" D:$G(SCREEN) P^PRCPUREP Q:$D(PRCPFLAG) D H^PRCPAWR0
31 K ACCOUNT
32 I $D(PRCPFLAG) Q
33 W !!,"TOTAL DOLLAR AMOUNT OF INVENTORY VALUE ADJUSTMENT (UNAPPROVED): ",$J(TOTAL,0,2)
34 I $D(PRCPMSG) W !!,PRCPMSG
35 I '$G(PRCPMULT) Q ;all adjustments printed on same report
36 K DATA F %=1:1 S DATA=$P($T(DATA+%),";",3,99) Q:DATA="" S DATA(%)=DATA
37 I $Y>(IOSL-%-2) D:$G(SCREEN) P^PRCPUREP Q:$D(PRCPFLAG) D H^PRCPAWR0
38 W ! S %=0 F S %=$O(DATA(%)) Q:'% W !,DATA(%)
39 I $O(^TMP($J,"PRCPAWR0 DA",TRANID))'="" D:$G(SCREEN) P^PRCPUREP W @IOF
40 S PAGE=0
41 Q
42 ;
43 ;
44DATA ;print signature at bottom of report
45 ;;CERTIFICATION -- THE SUPPLIES LISTED ON THIS REQUEST HAVE BEEN PROPERLY
46 ;;ADJUSTED BY QUANTITY AND VALUE.
47 ;;
48 ;;ITEM NUMBERS APPROVED [#MI]:__________________________________________________
49 ;;
50 ;;SIGNATURE ACCOUNTABLE OFFICER:________________________________________________
51 ;;
52 ;;SIGNATURE APPROVING OFFICIAL:_________________________________________________
Note: See TracBrowser for help on using the repository browser.