source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRTR1.m@ 1574

Last change on this file since 1574 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1PRCPRTR1 ;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 ;
7PRINT ;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
45Q D ^%ZISC K ^TMP($J,"PRCPITEMS"),^TMP($J,"PRCPRTRA")
46 Q
47 ;
48H 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 ;
59ABBREV ;;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
Note: See TracBrowser for help on using the repository browser.