| [613] | 1 | PRCPRADJ ;WISC/RFJ-adjustment voucher recap (option, whse) ;9.9.97
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | N %,%DT,%H,%I,DEFAULT,PRCPDATE,PRCPSUMM,X,Y
|
|---|
| 6 | K X S X(1)="The Adjustment Voucher Recap Report will print all adjustments to the inventory point for a specified month-year."
|
|---|
| 7 | I PRCP("DPTYPE")="W" S X(2)="The report will sort Warehouse inventory items by the NSN and the date of the adjustment."
|
|---|
| 8 | E S X(2)="The report will sort Primary and Secondary inventory items by the description and the date of the adjustment."
|
|---|
| 9 | D DISPLAY^PRCPUX2(40,79,.X)
|
|---|
| 10 | S Y=$E(DT,1,5)_"00" D DD^%DT S DEFAULT=Y
|
|---|
| 11 | K X S X(1)="Select the Adjustment Month-Year to display" D DISPLAY^PRCPUX2(2,40,.X)
|
|---|
| 12 | S %DT("A")="Print Adjustment Voucher Recap for Month-Year: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
|
|---|
| 13 | S PRCPDATE=Y
|
|---|
| 14 | S PRCPSUMM=$$SUMMARY^PRCPURS0 I PRCPSUMM<0 Q
|
|---|
| 15 | W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
|
|---|
| 16 | . S ZTDESC="Adjustment Voucher Recap",ZTRTN="DQ^PRCPRADJ"
|
|---|
| 17 | . S ZTSAVE("PRCP*")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 18 | W !!,"<*> please wait <*>"
|
|---|
| 19 | DQ ; queue starts here
|
|---|
| 20 | I PRCP("DPTYPE")'="W" D DQ^PRCPRADP Q
|
|---|
| 21 | ; adjustment voucher recap for whse
|
|---|
| 22 | N ACCT,DA,DATA,DATE,DATEREPT,FCP,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,REASON,SCREEN,TOTAL,TOTALM,TOTALP
|
|---|
| 23 | K ^TMP($J,"PRCPRADJ")
|
|---|
| 24 | S DATE=$E(PRCPDATE,1,5)_"00" F S DATE=$O(^PRCP(445.2,"AX",PRCP("I"),DATE)) Q:'DATE!($E(DATE,1,5)'=$E(PRCPDATE,1,5)) D
|
|---|
| 25 | . S DA=0 F S DA=$O(^PRCP(445.2,"AX",PRCP("I"),DATE,"A",DA)) Q:'DA D
|
|---|
| 26 | . . S DATA=$G(^PRCP(445.2,DA,0)),ITEMDA=+$P(DATA,"^",5) I 'ITEMDA Q
|
|---|
| 27 | . . S NSN=$$NSN^PRCPUX1(ITEMDA),ACCT=$$ACCT1^PRCPUX1($E(NSN,1,4)) S:NSN="" NSN=" "
|
|---|
| 28 | . . S %=$P(DATA,"^",19),REASON="O",FCP=$P(%,"-",4) I FCP'="" S REASON="I"
|
|---|
| 29 | . . I %'="",FCP="" S REASON="R"
|
|---|
| 30 | . . S ^TMP($J,"PRCPRADJ",ACCT,NSN,ITEMDA,DATE,DA)=$P(DATA,"^",15)_"^"_$P(DATA,"^",2)_"^"_$P(DATA,"^",6)_"^"_$P(DATA,"^",7)_"^"_$P(DATA,"^",22)_"^"_$P(DATA,"^",23)_"^"_FCP_"^"_REASON_"^"_$P(DATA,"^",16)
|
|---|
| 31 | ; print report
|
|---|
| 32 | S Y=PRCPDATE D DD^%DT S DATEREPT=Y
|
|---|
| 33 | D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|---|
| 34 | K TOTAL
|
|---|
| 35 | S ACCT=0 F S ACCT=$O(^TMP($J,"PRCPRADJ",ACCT)) Q:'ACCT!($G(PRCPFLAG)) D
|
|---|
| 36 | . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
|
|---|
| 37 | . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 38 | . W:'PRCPSUMM !!?5,"ACCOUNT NUMBER: ",ACCT
|
|---|
| 39 | . S NSN="" F S NSN=$O(^TMP($J,"PRCPRADJ",ACCT,NSN)) Q:NSN=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRADJ",ACCT,NSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
|
|---|
| 40 | . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 41 | . . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
|
|---|
| 42 | . . W:'PRCPSUMM !!,$TR(NSN,"-"),?15,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,23),?39,"[",ITEMDA,"]",?48,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8)
|
|---|
| 43 | . . S DATE=0 F S DATE=$O(^TMP($J,"PRCPRADJ",ACCT,NSN,ITEMDA,DATE)) Q:'DATE!($G(PRCPFLAG)) S DA=0 F S DA=$O(^TMP($J,"PRCPRADJ",ACCT,NSN,ITEMDA,DATE,DA)) Q:'DA!($G(PRCPFLAG)) S DATA=^(DA) D
|
|---|
| 44 | . . . W:'PRCPSUMM !?5,$P(DATA,"^"),?12,$P(DATA,"^",2),?22,$J($E(DATE,6,7),2),$J($P(DATA,"^",3),8),$J($P(DATA,"^",4),10),$J($P(DATA,"^",5),12,2),$J($P(DATA,"^",6),12,2),$J($P(DATA,"^",7),6),$J($P(DATA,"^",8),3)
|
|---|
| 45 | . . . W:'PRCPSUMM $J($E($$INITIALS^PRCPUREP($P(DATA,"^",9)),1,5),5)
|
|---|
| 46 | . . . I $P(DATA,"^",5)>0 S TOTAL(ACCT,"+")=$G(TOTAL(ACCT,"+"))+$P(DATA,"^",5)
|
|---|
| 47 | . . . I $P(DATA,"^",5)<0 S TOTAL(ACCT,"-")=$G(TOTAL(ACCT,"-"))+$P(DATA,"^",5)
|
|---|
| 48 | . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 49 | I $G(PRCPFLAG) D Q Q
|
|---|
| 50 | I $Y>(IOSL-10) D:SCREEN P^PRCPUREP G:$G(PRCPFLAG) Q D H
|
|---|
| 51 | W !!?5,"ACCT SUMMARY",?20,$J("PLUS ADJUSTMENTS",20),$J("MINUS ADJUSTMENTS",20),$J("DIFFERENCE",20)
|
|---|
| 52 | S (ACCT,TOTALM,TOTALP)=0 F S ACCT=$O(TOTAL(ACCT)) Q:'ACCT!($G(PRCPFLAG)) D
|
|---|
| 53 | . W !?5,"ACCT: ",ACCT,?20,$J($G(TOTAL(ACCT,"+")),20,2),$J($G(TOTAL(ACCT,"-")),20,2),$J($G(TOTAL(ACCT,"+"))+$G(TOTAL(ACCT,"-")),20,2)
|
|---|
| 54 | . S TOTALM=TOTALM+$G(TOTAL(ACCT,"-")),TOTALP=TOTALP+$G(TOTAL(ACCT,"+"))
|
|---|
| 55 | . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 56 | I $G(PRCPFLAG) D Q Q
|
|---|
| 57 | W !?5,"TOTAL",?20,$J(TOTALP,20,2),$J(TOTALM,20,2),$J(TOTALP+TOTALM,20,2)
|
|---|
| 58 | W:'PRCPSUMM !!?26,"REASON CODE (I:ISSUES, O:OTHER, R:RECEIPTS) == RC"
|
|---|
| 59 | D END^PRCPUREP
|
|---|
| 60 | Q D ^%ZISC K ^TMP($J,"PRCPRADJ")
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|---|
| 64 | W $C(13),"ADJUSTMENT VOUCHER RECAP FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
|
|---|
| 65 | W !?5,"ADJUSTMENTS FOR MONTH-YEAR: ",DATEREPT
|
|---|
| 66 | S %="",$P(%,"-",81)=""
|
|---|
| 67 | I PRCPSUMM W !?1,"*** ONLY SUMMARY OF ADJUSTMENTS PRINTED ***",!,% Q
|
|---|
| 68 | W !,"NSN",?15,"DESCRIPTION",?40,"MI",$J("ISSUE",14)
|
|---|
| 69 | W !?5,"REF#",?12,"TRAN#",?22,"DT",$J("UNITS",8),$J("QUANTITY",10),$J("INV VALUE",12),$J("SELL VALUE",12),$J("FCP",6),$J("RC",3),$J("USER",5)
|
|---|
| 70 | W !,%
|
|---|
| 71 | Q
|
|---|
