| [613] | 1 | PRCPAWR1 ;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 | ;
|
|---|
| 7 | BUILD ; 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 | ;
|
|---|
| 18 | BUILD1 ; 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 | ;
|
|---|
| 24 | END ; 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 | ;
|
|---|
| 44 | DATA ;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:_________________________________________________
|
|---|
