| [613] | 1 | PRCPRTRA ;WISC/RFJ-transaction register report ;07 Sep 91
|
|---|
| 2 | V ;;5.1;IFCAP;**1**;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 %,%H,%I,ALLITEMS,ITEMDA,PRCPDATE,PRCPSUMM,X,Y
|
|---|
| 6 | ;
|
|---|
| 7 | K X S X(1)="The Transaction Register Report prints all activity for specified items, including the opening and closing balances."
|
|---|
| 8 | S X(2)="The current month-year balance on file appears under the calculated closing balance if the two values differ."
|
|---|
| 9 | D DISPLAY^PRCPUX2(40,79,.X)
|
|---|
| 10 | ;
|
|---|
| 11 | K X S X(1)="Enter the month-year for printing the transaction register"
|
|---|
| 12 | D DISPLAY^PRCPUX2(2,40,.X)
|
|---|
| 13 | S Y=$E(DT,1,5)_"00" S %DT(0)=-Y
|
|---|
| 14 | D DD^%DT
|
|---|
| 15 | S %DT="AEP",%DT("B")=Y
|
|---|
| 16 | S %DT("A")="Print Transaction Register for MONTH and YEAR: "
|
|---|
| 17 | D ^%DT K %DT I Y<1 Q
|
|---|
| 18 | S (Y,PRCPDATE)=$E(Y,1,5)
|
|---|
| 19 | ;
|
|---|
| 20 | I PRCPDATE=$E(DT,1,5) D I '% Q
|
|---|
| 21 | . K X S X(1)="You may now select to print only items whose calculated closing balance differs from the current on-hand inventory."
|
|---|
| 22 | . D DISPLAY^PRCPUX2(2,40,.X)
|
|---|
| 23 | . S XP="Display only items out of balance"
|
|---|
| 24 | . S XH="Enter 'YES' to only show those items out of balance, 'NO' to select items."
|
|---|
| 25 | . S %=$$YN^PRCPUYN(2) I '% Q
|
|---|
| 26 | . I %=1 S PRCPSUMM=1
|
|---|
| 27 | ;
|
|---|
| 28 | I $G(PRCPSUMM) S ALLITEMS=1 G DEVICE
|
|---|
| 29 | ;
|
|---|
| 30 | ITEMS ;return here after printing report
|
|---|
| 31 | ; get selected item list
|
|---|
| 32 | D ITEMMAST^PRCPURS4(PRCPDATE)
|
|---|
| 33 | I '$O(^TMP($J,"PRCPITEMS",0)),'$D(ALLITEMS) Q
|
|---|
| 34 | ;
|
|---|
| 35 | DEVICE ; ask device
|
|---|
| 36 | S %ZIS="Q" D ^%ZIS Q:POP
|
|---|
| 37 | I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK,^TMP($J,"PRCPITEMS") Q
|
|---|
| 38 | . S ZTDESC="Transaction Register Report",ZTRTN="DQ^PRCPRTRA"
|
|---|
| 39 | . S ZTSAVE("PRCP*")="",ZTSAVE("ALLITEMS")="",ZTSAVE("^TMP($J,""PRCPITEMS"",")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 40 | W !!,"<*> please wait <*>"
|
|---|
| 41 | ;
|
|---|
| 42 | DQ ;queue comes here
|
|---|
| 43 | N %,CURRQTY,CURRVAL,D,DATE,DESCR,ITEMDA,ITEMDATA,NSN,OPENQTY,OPENVAL,TOTALQTY,TOTALVAL,TRX,TT,UNIT,X,Y
|
|---|
| 44 | K ^TMP($J,"PRCPRTRA")
|
|---|
| 45 | S ITEMDA=0
|
|---|
| 46 | F S ITEMDA=$O(^PRCP(445.1,PRCP("I"),1,ITEMDA)) Q:'ITEMDA I $D(^(ITEMDA,1,PRCPDATE,0))&($D(ALLITEMS)!($D(^TMP($J,"PRCPITEMS",ITEMDA)))) D
|
|---|
| 47 | . S %=$$GETOPEN^PRCPUBAL(PRCP("I"),ITEMDA,PRCPDATE)
|
|---|
| 48 | . S OPENQTY=$P(%,"^",2)+$P(%,"^",3)
|
|---|
| 49 | . S OPENVAL=+$P(%,"^",8)
|
|---|
| 50 | . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
|
|---|
| 51 | . S TOTALQTY=OPENQTY,TOTALVAL=OPENVAL
|
|---|
| 52 | . S TRX=0
|
|---|
| 53 | . F S TRX=$O(^PRCP(445.2,"AD",PRCP("I"),ITEMDA,TRX)) Q:'TRX D
|
|---|
| 54 | . . S D=$G(^PRCP(445.2,TRX,0)),DATE=$P($P(D,"^",17),".")
|
|---|
| 55 | . . I $E(DATE,1,5)=PRCPDATE D
|
|---|
| 56 | . . . S TT=$P(D,"^",4)
|
|---|
| 57 | . . . S TT=$S($E(TT,1,2)="RC":"R",$E(TT)="R":"D",1:TT)
|
|---|
| 58 | . . . S %=$E($P(D,"^",2),2,10) S:$E(%)?1A %=$E(%,2,10)
|
|---|
| 59 | . . . I PRCP("DPTYPE")="P"&(TT="D"!(TT="C")!(TT="E")) D
|
|---|
| 60 | . . . . S X=$P($P($G(^PRCP(445,+$P(D,"^",18),0)),"^"),"-",2,99)
|
|---|
| 61 | . . . . S:X'="" X=$E("to: "_X,1,18)
|
|---|
| 62 | . . . . S:$P(D,"^",19)="" $P(D,"^",19)=X
|
|---|
| 63 | . . . I PRCP("DPTYPE")="S",TT="U" D
|
|---|
| 64 | . . . . S X=$P($G(^PRCP(445.2,TRX,2)),"^",2)
|
|---|
| 65 | . . . . S:X'="" X=$E("to: "_X,1,18)
|
|---|
| 66 | . . . . S $P(D,"^",19)=X
|
|---|
| 67 | . . . I $P(D,"^",22)="",$P(D,"^",23)="" D
|
|---|
| 68 | . . . . S $P(D,"^",22)=$J($P(D,"^",7)*$S($E(TT,1,2)="R":$P(D,"^",9),1:$P(D,"^",8)),0,2)
|
|---|
| 69 | . . . . S $P(D,"^",23)=$J($P(D,"^",7)*$P(D,"^",9),0,2)
|
|---|
| 70 | . . . S $P(D,"^",22)=$J($P(D,"^",22),0,2)
|
|---|
| 71 | . . . S $P(D,"^",23)=$J($P(D,"^",23),0,2)
|
|---|
| 72 | . . . ; nonissuable
|
|---|
| 73 | . . . I $P(D,"^",11)'="" D
|
|---|
| 74 | . . . . S $P(D,"^",19)=$S($P(D,"^",7)<0:" TO",1:"FROM")
|
|---|
| 75 | . . . . S $P(D,"^",19)=$P(D,"^",19)_" noniss qty: "
|
|---|
| 76 | . . . . S $P(D,"^",19)=$P(D,"^",19)_$S($P(D,"^",7)<0:-$P(D,"^",7),1:$P(D,"^",7))
|
|---|
| 77 | . . . . S $P(D,"^",7)=""
|
|---|
| 78 | . . . . S $P(D,"^",22,23)="^"
|
|---|
| 79 | . . . S TOTALQTY=TOTALQTY+$P(D,"^",7),TOTALVAL=TOTALVAL+$P(D,"^",22)
|
|---|
| 80 | . . . S ^TMP($J,"PRCPRTRA",NSN,ITEMDA,DATE,TRX)=TT_%_"^"_$P(D,"^",19)_"^"_$P(D,"^",6)_"^"_$P(D,"^",22)_"^"_$P(D,"^",23)_"^"_$P(D,"^",7)
|
|---|
| 81 | . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
|
|---|
| 82 | . S CURRQTY=$P(ITEMDATA,"^",7)+$P(ITEMDATA,"^",19)
|
|---|
| 83 | . S CURRVAL=$P(ITEMDATA,"^",27)
|
|---|
| 84 | . I CURRVAL="" S CURRVAL=+$J(CURRQTY*$P(ITEMDATA,"^",22),0,2)
|
|---|
| 85 | . I $G(PRCPSUMM),CURRQTY=TOTALQTY,CURRVAL=TOTALVAL K ^TMP($J,"PRCPRTRA",NSN,ITEMDA) Q
|
|---|
| 86 | . S DESCR=$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,30)
|
|---|
| 87 | . S UNIT=$$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/")
|
|---|
| 88 | . S ^TMP($J,"PRCPRTRA",NSN,ITEMDA)=DESCR_"^"_UNIT_"^"_$$GETIN^PRCPUDUE(PRCP("I"),ITEMDA)_"^"_$$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA)_"^"_$P(ITEMDATA,"^",19)_"^"_OPENQTY_"^"_OPENVAL_"^"_TOTALQTY_"^"_TOTALVAL
|
|---|
| 89 | . I CURRQTY=TOTALQTY,CURRVAL=TOTALVAL Q
|
|---|
| 90 | . S ^TMP($J,"PRCPRTRA",NSN,ITEMDA,"BAL")=CURRQTY_"^"_CURRVAL
|
|---|
| 91 | D PRINT^PRCPRTR1
|
|---|
| 92 | I '$D(ZTQUEUED) W !!!! K PRCPSUMM G ITEMS
|
|---|
| 93 | Q
|
|---|
