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