| 1 | PRCPRTR1 ;WISC/RFJ-transaction register report (print) ;07 Sep 91
|
|---|
| 2 | ;;5.1;IFCAP;**24**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | PRINT ;print report from tmp global
|
|---|
| 8 | N DATA,ITEMDA,MONTH,NOW,NOWDT,NSN,PAGE,PRCPFLAG,SALEUNIT,SCREEN
|
|---|
| 9 | S Y=PRCPDATE D DD^%DT S MONTH=Y
|
|---|
| 10 | D NOW^%DTC S (Y,NOWDT)=% D DD^%DT
|
|---|
| 11 | S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|---|
| 12 | S NSN=""
|
|---|
| 13 | F S NSN=$O(^TMP($J,"PRCPRTRA",NSN)) Q:NSN=""!($D(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRTRA",NSN,ITEMDA)) Q:'ITEMDA!($D(PRCPFLAG)) D
|
|---|
| 14 | . S DATA=^TMP($J,"PRCPRTRA",NSN,ITEMDA)
|
|---|
| 15 | . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 16 | . W !!,$S(NSN=" ":"** NO NSN **",1:NSN)
|
|---|
| 17 | . W ?19,$P(DATA,"^")
|
|---|
| 18 | . W ?49,"[#",ITEMDA,"]"
|
|---|
| 19 | . W ?59,"U/I: ",$P(DATA,"^",2)
|
|---|
| 20 | . W ! W:PRCP("DPTYPE")="W" ?9,"QTY NON-ISS: ",+$P(DATA,"^",5)
|
|---|
| 21 | . W ?28,"DUE-IN: ",+$P(DATA,"^",3)
|
|---|
| 22 | . W ?44,"DUE-OUT: ",+$P(DATA,"^",4)
|
|---|
| 23 | . W !?23,"ISSUABLE + NONISSUABLE OPEN BALANCE:",$J($P(DATA,"^",6),9),$J($P(DATA,"^",7),12,2)
|
|---|
| 24 | . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 25 | . S DATE=0
|
|---|
| 26 | . F S DATE=$O(^TMP($J,"PRCPRTRA",NSN,ITEMDA,DATE)) Q:'DATE!($G(PRCPFLAG)) D
|
|---|
| 27 | . . S TRX=0
|
|---|
| 28 | . . F S TRX=$O(^TMP($J,"PRCPRTRA",NSN,ITEMDA,DATE,TRX)) Q:'TRX!($G(PRCPFLAG)) D
|
|---|
| 29 | . . . S D=^TMP($J,"PRCPRTRA",NSN,ITEMDA,DATE,TRX)
|
|---|
| 30 | . . . S SALEUNIT="" I $P(D,"^",6) S SALEUNIT=$J($P(D,"^",5)/$P(D,"^",6),0,3)
|
|---|
| 31 | . . . W !,$P(D,"^"),?9,$E(DATE,6,7),?13,$P(D,"^",2),?33,$J($P(D,"^",3),8),$J(SALEUNIT,10),$J($P(D,"^",5),10),$J($P(D,"^",6),7),$J($P(D,"^",4),12)
|
|---|
| 32 | . . . W:$G(^PRCP(445.2,TRX,1))'="" !,$P(^(1),"^")
|
|---|
| 33 | . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 34 | . I $D(PRCPFLAG) Q
|
|---|
| 35 | . I $Y>(IOSL-5) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 36 | . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
|
|---|
| 37 | . W !?43,"CLOSING BALANCE:",$J($P(DATA,"^",8),9),$J($P(DATA,"^",9),12,2)
|
|---|
| 38 | . S %=$G(^TMP($J,"PRCPRTRA",NSN,ITEMDA,"BAL"))
|
|---|
| 39 | . I %'="" W !?28,"*** CURRENT INVENTORY BALANCES:",$J($P(%,"^"),9),$J($P(%,"^",2),12,2)
|
|---|
| 40 | . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
|
|---|
| 41 | I $G(PRCPFLAG) D Q Q
|
|---|
| 42 | I $Y>(IOSL-7),'$D(PRCPFLAG) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 43 | I '$D(PRCPFLAG) W ! F %=1:1:5 W !,$P($T(ABBREV+%),";",3)
|
|---|
| 44 | I '$D(PRCPFLAG) D END^PRCPUREP
|
|---|
| 45 | Q D ^%ZISC K ^TMP($J,"PRCPITEMS"),^TMP($J,"PRCPRTRA")
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|---|
| 49 | W $C(13),"TRANSACTION REGISTER REPORT FOR ",PRCP("IN"),?(80-$L(%)),%
|
|---|
| 50 | W !," FOR THE MONTH OF ",MONTH
|
|---|
| 51 | I $G(PRCPSUMM) W ?47,"ONLY ITEMS OUT OF BALANCE PRINTED"
|
|---|
| 52 | W !,"NSN",?19,"DESCRIPTION",?49,"[#MI]"
|
|---|
| 53 | S %="",$P(%,"-",81)=""
|
|---|
| 54 | W !,"TRANSID",?9,"DT",?13,"TRANS./P.O."
|
|---|
| 55 | W:PRCP("DPTYPE")="P" "/to:INV.PT."
|
|---|
| 56 | W ?38,"U/I",?43,"SELLUNIT",?55,"SELL $",?65,"QTY",?75,"INV $",!,%
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | ABBREV ;;display abbreviations
|
|---|
| 60 | ;;TRANSACTION TYPE (TT) ABBREVIATIONS: U = USAGE
|
|---|
| 61 | ;; R = RECEIVING A = MANUAL ADJUSTMENT
|
|---|
| 62 | ;; D = DISTRIBUTION (REGULAR ISSUES) S = ASSEMBLE SETS
|
|---|
| 63 | ;; C = DISTRIBUTION (CALL-IN) P = PHYSICAL COUNT
|
|---|
| 64 | ;; E = DISTRIBUTION (EMERGENCY) Q = QTY ADJ TO SUPPLY STATION
|
|---|
