| 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:_________________________________________________
 | 
|---|