source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRDI2.m@ 1700

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

initial load of FOIAVistA 6/30/08 version
File size: 3.6 KB
Line 
1PRCPRDI2 ;WISC/RFJ-print calculated due-ins ;30 Aug 91
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7PRINT ; called from prcprdi1 to print calculated due-ins
8 N %,%H,%I,D,DATA,DATE,DUEIN,ITEMDA,NSN,PAGE,PRCPFLAG,QTY,SCREEN,TRANDA,TRANNO,X,Y
9 D NOW^%DTC S Y=% D DD^%DT S DATE=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP,ITEMDA=0 U IO D H
10 ; sort by nsn
11 K ^TMP($J,"PRCPRDI2")
12 F S ITEMDA=$O(^TMP($J,"PRCPRDI1-DI",ITEMDA)) Q:'ITEMDA S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" " S ^TMP($J,"PRCPRDI2",NSN,ITEMDA)=""
13 ;
14 S NSN="" F S NSN=$O(^TMP($J,"PRCPRDI2",NSN)) Q:NSN=""!($D(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRDI2",NSN,ITEMDA)) Q:'ITEMDA!($D(PRCPFLAG)) D
15 . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
16 . S D=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
17 . W !!,NSN,?20,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,20),?42,"[#",ITEMDA,"]",?49,$J($$UNITVAL^PRCPUX1($P(D,"^",14),$P(D,"^",5)," per "),13),?70,$J($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),10)
18 . D H1
19 . S (TRANDA,DUEIN)=0 F S TRANDA=$O(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)) Q:'TRANDA!($D(PRCPFLAG)) S DATA=^(TRANDA) D
20 . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H,H1
21 . . S TRANNO=$P($G(^PRCS(410,TRANDA,0)),"^"),DUEIN=DUEIN+$P(DATA,"^",2)
22 . . W !?10,TRANNO,?30,$P($P($G(^PRC(442,+$P(DATA,"^",6),0)),"^"),"-",2),?37,$J($$UNITVAL^PRCPUX1($P(DATA,"^",4),$P(DATA,"^",3)," per "),13),?56,$J($P(DATA,"^",5),6),$J($P(DATA,"^",2),10)
23 . . I '$D(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)) W ?77,"ADD" Q
24 . . I $P(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0),"^",2)'=$P(DATA,"^",2) W ?77,"UPD"
25 . ;
26 . W !?33,"CALCULATED TOTAL DUE-IN QTY: ",$J(DUEIN,10) I $$GETIN^PRCPUDUE(PRCP("I"),ITEMDA)'=DUEIN W " <-----*"
27 ;
28 I $D(PRCPFLAG),$G(PRCPFUPD) U IO(0) W !,"DUE-INS AND OUTSTANDING TRANSACTIONS WILL NOT BE UPDATED UNTIL ENTIRE REPORT",!,"IS PRINTED."
29 I '$D(PRCPFLAG),$G(PRCPFUPD) D UPDATE W !!,"DUE-INS AND OUTSTANDING TRANSACTIONS HAVE BEEN UPDATED."
30 I '$D(PRCPFLAG) D END^PRCPUREP
31 D ^%ZISC K ^TMP($J,"PRCPRDI2")
32 Q
33 ;
34 ;
35H S %=DATE_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
36 W $C(13),"CALCULATED DUE-INS REPORT FOR: ",PRCP("IN"),?(80-$L(%)),%,!,"NSN",?20,"DESCRIPTION",?42,"[#MI]",?51,"UNIT per ISS",?70,"DUE-IN QTY",! S %="",$P(%,"-",81)="" W %
37 Q
38 ;
39 ;
40H1 W !?10,"TRANSACTION",?30,"PO #",?39,"UNIT per REC",?53,"CONV FACT",?66,"DUE-IN"
41 Q
42 ;
43 ;
44UPDATE ; update due-ins and outstanding transactions
45 N %,DATA,ITEMDA,TRANDA
46 S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
47 . L +^PRCP(445,PRCP("I"),1,ITEMDA)
48 . ; get rid of old transactions
49 . S TRANDA=0 F S TRANDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA)) Q:'TRANDA I $D(^TMP($J,"PRCPRDI1-CK",TRANDA)),'$D(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)) D KILLTRAN^PRCPUTRA(PRCP("I"),ITEMDA,TRANDA)
50 . ; add new transactions
51 . S TRANDA=0 F S TRANDA=$O(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)) Q:'TRANDA S DATA=^(TRANDA) D
52 . . I '$D(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)) D ADDTRAN^PRCPUTRA(PRCP("I"),ITEMDA,TRANDA,$P(DATA,"^",2,5))
53 . . S %=^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0),$P(%,"^",2)=$P(DATA,"^",2)
54 . . I $P(DATA,"^",3) S $P(%,"^",3)=$P(DATA,"^",3)
55 . . I $P(DATA,"^",4) S $P(%,"^",4)=$P(DATA,"^",4)
56 . . I $P(DATA,"^",5) S $P(%,"^",5)=$P(DATA,"^",5)
57 . . S ^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA,0)=%
58 . ; recalc total quantity due-in
59 . S QTY=0
60 . S TRANDA=0 F S TRANDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA,7,TRANDA)) Q:'TRANDA S QTY=QTY+$P($G(^(TRANDA,0)),"^",2)
61 . I QTY<0 S QTY=0
62 . D SETIN^PRCPUDUE(PRCP("I"),ITEMDA,QTY-$$GETIN^PRCPUDUE(PRCP("I"),ITEMDA))
63 . L -^PRCP(445,PRCP("I"),1,ITEMDA)
64 Q
Note: See TracBrowser for help on using the repository browser.