source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHDP3.m@ 846

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1PRCHDP3 ;WISC/RSD/RHD-DISPLAY PARTIALS RECEIVING OF P.O. ;OCT 9, 2001
2V ;;5.1;IFCAP;**38**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 S PRCHD0=$G(^PRC(442,PRCHPO,0)) Q:PRCHD0']""
5ST ;S IOP="HOME",%ZIS="" D ^%ZIS W:$Y>0 @IOF W !,$S($D(PRCHNRQ):"REQUISITION: ",1:"PURCHASE ORDER: "),$P(PRCHD0,U,1),?37,"STATUS: " I $D(^PRC(442,PRCHPO,7)),+^(7)>0 W $S($D(^PRCD(442.3,+^(7),0)):$P(^(0),U,1),1:"")
6 S IOP="HOME",%ZIS="" D ^%ZIS W:$Y>0 @IOF W !,$S($D(PRCHNRQ):"REQUISITION: ",1:"PURCHASE ORDER: "),$P(PRCHD0,U,1),?37,"STATUS: " I $D(^PRC(442,PRCHPO,7)),+^(7)>0 W $P($G(^PRCD(442.3,+^(7),0)),U,1)
7 ;W !,"PROCESSING: ",$S($D(^PRCD(442.5,+$P(PRCHD0,U,2),0)):$P(^(0),U,1),1:""),?37,"PARTIAL: ",PRCHDPT," " S Y=$P(^PRC(442,PRCHPO,11,PRCHDPT,0),U,1) D DT W:'PRCHDTP&($P(^(0),U,9)) " FINAL"
8 W !,"PROCESSING: ",$P($G(^PRCD(442.5,+$P(PRCHD0,U,2),0)),U,1),?37,"PARTIAL: ",PRCHDPT," " S Y=$P(^PRC(442,PRCHPO,11,PRCHDPT,0),U,1) D DT W:'PRCHDTP&($P(^(0),U,9)) " FINAL"
9 W ! F I=1:1:80 W "-"
10 D HDR S (PRCHDQ,PRCHDA,PRCHDTA)=0,PRCHDI=0
11 F S PRCHDI=$O(^PRC(442,PRCHPO,2,"AB",PRCHDRD,PRCHDI)) Q:'PRCHDI D Q:PRCHDQ
12 . S PRCHDN=$O(^PRC(442,PRCHPO,2,PRCHDI,3,"AC",PRCHDPT,"")) Q:PRCHDN=""
13 . I $D(^PRC(442,PRCHPO,2,PRCHDI,3,PRCHDN)) D:$Y+5>IOSL ASK Q:PRCHDQ D ITEM
14 G:PRCHDQ&PRCHDTP Q
15 I 'PRCHDTP,PRCHDQ F S PRCHDI=$O(^PRC(442,PRCHPO,2,"AB",PRCHDRD,PRCHDI)) Q:'PRCHDI D
16 . S PRCHDN=$O(^PRC(442,PRCHPO,2,PRCHDI,3,"AC",PRCHDPT,"")) Q:PRCHDN=""
17 . I $D(^PRC(442,PRCHPO,2,PRCHDI)) D AMT
18 I PRCHDPT=1,$P(^PRC(442,PRCHPO,0),U,13) S PRCHDTA=PRCHDTA+$P(^(0),U,13) W:'PRCHDQ!(PRCHDQ&(PRCHDTP)) !?2,"Estimated Shipping and/or Handling",?68,$J($P(^(0),U,13),8,2)
19 S PRCHDTA=PRCHDTA-PRCHDA W:+PRCHDA'=0 !!?PRCHDA'<0+40,$S(PRCHDA<0:"Discount Reduction: ",1:"Discounted Amount: "),?68,$J($S(PRCHDA<0:-PRCHDA,1:PRCHDA),8,2) W !?46,"Total Amount: ",?66,$J(PRCHDTA,10,2) G:'PRCHDTP Q
20 I $D(^PRC(442,PRCHPO,11,PRCHDPT,0)),$P(^(0),U,8)]"" S X=$P(^(0),U,3)+$P(^(0),U,5) I $P($G(^PRC(442,PRCHPO,3,0)),U,4)]"" W:PRCHDTA-X !?38,"Term Discount Amount: ",?68,$J(PRCHDTA-X,8,2),!?48,"Net Amount: ",?66,$J(X,10,2)
21 W !!?5,"Receiving Report Processed By: /ES/"_$$DECODE^PRCHES1(PRCHPO,PRCHDPT),! ;I $E(IOST)["C" R !!,"ENTER <CR> TO CONTINUE",X:DTIME
22 ;
23ADJESIG ;Check for any Adjustment on PO. If any show the adjuster. PRC*5.1*38
24 G:'$D(^PRC(442,PRCHPO,6,0)) SKIPIT
25 S CHKADJ="",ISADJ=0,ADJUSTER=""
26 S CHKADJ=$P($G(^PRC(442,PRCHPO,11,PRCHDPT,0)),U,21)
27 G:CHKADJ="" SKIPIT G:CHKADJ<1 SKIPIT
28 S ADJDATA=$G(^PRC(442,PRCHPO,6,CHKADJ,0))
29 S ADJNUM=$P(ADJDATA,U,1)
30 S ISADJ=$P(ADJDATA,U,8) G:ISADJ'="Y" SKIPIT
31 S ADJUSTER=$G(^PRC(442,PRCHPO,6,ADJNUM,1))
32 G:ADJUSTER="" SKIPIT
33 S ADJDUZ=$P(ADJUSTER,U,1),ADJESIG=$P(ADJUSTER,U,2)
34 S ADJNAME=$P($G(^VA(200,ADJDUZ,20)),U,2)
35 W !?5,"Adjustment Voucher Processed By: ",ADJNAME,!
36 K CHKADJ,ISADJ,ADJUSTER,ADJDATA,ADJNUM,ADJNAME,ADJESIG,ADJDUZ
37SKIPIT ;
38 I $E(IOST)["C" R !!,"ENTER <CR> TO CONTINUE",X:DTIME
39 ;
40Q K DIWF,DIWL,DIWR,IOP,PRCHD0,PRCHDA,PRCHDCNT,PRCHDI,PRCHDI0,PRCHDI2,PRCHDIW,PRCHDN,PRCHDPT,PRCHDQ,PRCHDRD,PRCHDTA,PRCHDTP,PRCHJ,^TMP($J,"W"),^UTILITY($J,"W") Q
41 Q
42ITEM S PRCHDI0=^PRC(442,PRCHPO,2,PRCHDI,0),PRCHDI2=^(2),DIWL=1,DIWR=33,DIWF="",PRCHDIW=0 K ^UTILITY($J,"W")
43 F PRCHJ=1:1 S PRCHDIW=$O(^PRC(442,PRCHPO,2,PRCHDI,1,PRCHDIW)) Q:PRCHDIW="" S X=$G(^(PRCHDIW,0)) D DIWP^PRCUTL($G(DA))
44 K ^TMP($J,"W") S %X="^UTILITY($J,""W"",",%Y="^TMP($J,""W""," D %XY^%RCR
45 S PRCHDCNT=$G(^TMP($J,"W",1)) W !?2,$J(+$P(PRCHDI0,U,1),3),?7,$G(^(1,1,0))
46 ;W ?40,$J($P(PRCHDI0,U,2),5),?47,$S($D(^PRCD(420.5,+$P(PRCHDI0,U,3),0)):$P(^(0),U,1),1:"")
47 W ?40,$J($P(PRCHDI0,U,2),5),?47,$P($G(^PRCD(420.5,+$P(PRCHDI0,U,3),0)),U,1)
48 S X=$P($P(PRCHDI0,U,9),".",2) W ?52,$S($L(X)>3:$J($P(PRCHDI0,U,9),5,4),$L(X)>2:$J($P(PRCHDI0,U,9),6,3),$P(PRCHDI0,U,9)="N/C":" N/C",1:$J($P(PRCHDI0,U,9),7,2)) D AMT
49 I PRCHDCNT>1 S K=1 F S K=$O(^TMP($J,"W",1,K)) Q:K=""!(K'>0) D:$Y+5>IOSL ASK Q:PRCHDQ W !?8,^(K,0)
50 I $P(PRCHDI0,U,5)]"" W !?8,"IMF #: ",$P(PRCHDI0,U,5)_" " W:$P(PRCHDI2,U,2)]"" "CONTRACT: ",$P(PRCHDI2,U,2)
51 W !
52 Q
53AMT Q:'$D(^PRC(442,PRCHPO,2,PRCHDI,3,PRCHDN,0)) S Y=^(0),PRCHDA=PRCHDA+$P(Y,U,5),PRCHDTA=PRCHDTA+$P(Y,U,3)
54 I 'PRCHDQ W ?61,$J($P(Y,U,2),5),?68,$J($P(Y,U,3),8,2)
55 Q
56ASK I $Y+4>IOSL W !?8,"Press RETURN to CONTINUE or '^' to EXIT: " R X:DTIME S:X["^" PRCHDQ=1 I 'PRCHDQ W @IOF,!! D HDR
57 Q
58HDR W !?55,"UNIT",?63,"QTY",?71,"TOTAL",!,"ITEM",?15,"DESCRIPTION",?42,"QTY",?46,"UNIT",?55,"COST",?63,"REC",?71,"COST",! F I=1:1:80 W "-"
59 Q
60DT I Y W Y\100#100,"/",Y#100\1,"/",Y\10000+1700
61 Q
Note: See TracBrowser for help on using the repository browser.