source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPWPL0.m@ 1141

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1PRCPWPL0 ;WISC/RFJ-whse post issue book (options) ;13 Jan 94
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7EEITEMS ; called from protocol file to enter/edit invpt items
8 D FULL^VALM1
9 N PRC,PRCP
10 S PRCP("DPTYPE")="WP"
11 D ^PRCPEILM
12 D REBUILD^PRCPWPLB
13 S VALMBCK="R"
14 Q
15 ;
16 ;
17SHOWNSN ; show nsn on list
18 S PRCPFNSN=$S($G(PRCPFNSN):0,1:1)
19 D REBUILD^PRCPWPLB
20 S ^DISV(DUZ,"PRCPWPLM","SHOWNSN")=PRCPFNSN
21 S VALMSG=$S(PRCPFNSN:"SHOW NSN",1:"DO NOT SHOW NSN")
22 S VALMBCK="R"
23 Q
24 ;
25 ;
26REMAIN ; set qty to post to remaining (outstanding) qty
27 D FULL^VALM1
28 S VALMBCK="R"
29 N DATA,ITEMDA,LINEDA,QTY,X
30 K X S X(1)="This option will set the QUANTITY TO POST equal to the QUANTITY REMAINing (same as quantity outstanding). The QUANTITY REMAINing is equal to the QUANTITY ORDERED minus the QUANTITY POSTED previously."
31 D DISPLAY^PRCPUX2(5,75,.X)
32 S XP="Do you want to set the QUANTITY TO POST equal to QUANTITY REMAINing",XH="Enter YES to set the QUANTITY TO POST equal to the QUANTITY REMAINing,",XH(1)=" NO or ^ to return to the posting list."
33 I $$YN^PRCPUYN(1)'=1 Q
34 S LINEDA=0 F S LINEDA=$O(^TMP($J,"PRCPWPLMLIST",LINEDA)) Q:'LINEDA S DATA=^(LINEDA) D
35 . S ITEMDA=+$P(DATA,"^"),QTY=+$P(DATA,"^",2)
36 . I QTY<0 S QTY=0
37 . I '$D(^PRCP(445,PRCPINPT,1,ITEMDA,0)) S QTY=0
38 . S ^TMP($J,"PRCPWPLMPOST",LINEDA)=QTY
39 D REBUILD^PRCPWPLB
40 S VALMSG="QTY TO POST now set to QTY REMAINing"
41 Q
42 ;
43 ;
44ONHAND ; set qty to post to onhand qty
45 D FULL^VALM1
46 S VALMBCK="R"
47 N DATA,ITEMDA,LINEDA,ONHAND,QTY,X
48 K X S X(1)="This option will set the QUANTITY TO POST equal to the QUANTITY ON-HAND in the warehouse inventory point. A note of caution: Since the warehouse inventory point is not locked, the quantity on-hand could be changing"
49 S X(2)="and will be a snapshot of the database. By the time you actually post this issue book, the quantity on-hand may be different and you may even post into the negative."
50 D DISPLAY^PRCPUX2(5,75,.X)
51 S XP="Do you want to set the QUANTITY TO POST equal to QUANTITY ONHAND",XH="Enter YES to set the QUANTITY TO POST equal to the QUANTITY ONHAND,",XH(1)=" NO or ^ to return to the posting list."
52 I $$YN^PRCPUYN(1)'=1 Q
53 S LINEDA=0 F S LINEDA=$O(^TMP($J,"PRCPWPLMLIST",LINEDA)) Q:'LINEDA S DATA=^(LINEDA) D
54 . S ITEMDA=+$P(DATA,"^"),QTY=+$P(DATA,"^",2)
55 . S ONHAND=$P($G(^PRCP(445,PRCPINPT,1,ITEMDA,0)),"^",7) I QTY>ONHAND S QTY=ONHAND
56 . S ^TMP($J,"PRCPWPLMPOST",LINEDA)=QTY
57 D REBUILD^PRCPWPLB
58 S VALMSG="QTY TO POST now set to QTY ONHAND"
59 Q
60 ;
61 ;
62ENTER ; enter quantity to post
63 D FULL^VALM1
64 S VALMBCK="R"
65 N DATA,DIR,ITEMDA,INVDATA,LINEDA,ONHAND,QTYOUT,STATUS,X,Y
66 F W ! S LINEDA=$$LINEITEM Q:LINEDA<1 D
67 . S DATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,0)) I DATA="" W !,"CANNOT FIND LINE ITEM." Q
68 . S ITEMDA=+$P(DATA,"^",5),STATUS=$P(DATA,"^",14),INVDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0))
69 . I INVDATA="" W !,"ITEM (#",ITEMDA,") NOT STORED IN THE INVENTORY POINT." Q
70 . I STATUS'="" W !,"ITEM IS CANCELLED",$S(STATUS["S":" AND SUBSTITUTED WITH LINE #(S): "_$P(STATUS,",",2,99),1:"") Q
71 . S ONHAND=+$P(INVDATA,"^",7),QTYOUT=+$P($G(^TMP($J,"PRCPWPLMLIST",LINEDA)),"^",2) I QTYOUT<0 S QTYOUT=0
72 . W !!,ITEMDA,?5,$E($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),1,30)," ",$$NSN^PRCPUX1(ITEMDA)," U/I: ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/")
73 . W !?5,"AVERAGE COST : ",$J(+$P(INVDATA,"^",22),0,2)
74 . W !?5,"LAST COST : ",$J(+$P(INVDATA,"^",15),0,2)
75 . W !
76 . W !?5,"QTY ON-HAND : ",ONHAND
77 . W !?5,"QTY ORDERED : ",+$P(DATA,"^",2)
78 . W !?5,"QTY POSTED : ",+$P(DATA,"^",12)
79 . W !?5,"QTY OUTSTANDING: ",QTYOUT
80 . W !?5,"QTY TO POST : ",+$G(^TMP($J,"PRCPWPLMPOST",LINEDA))
81 . S DIR(0)="NA^0:"_ONHAND_":0",DIR("A")=" QUANTITY TO POST: ",DIR("B")=$S(QTYOUT<ONHAND:QTYOUT,1:ONHAND)
82 . S DIR("A",1)="Enter the quantity of this item to post from 0 to "_ONHAND_"."
83 . W ! D ^DIR K DIR
84 . I Y S ^TMP($J,"PRCPWPLMPOST",LINEDA)=+Y I Y>ONHAND K X S X(1)="WARNING: YOU WILL BE POSTING INTO THE NEGATIVE" D DISPLAY^PRCPUX2(5,75,.X)
85 . K X S X(1)="QUANTITY TO POST: "_+$G(^TMP($J,"PRCPWPLMPOST",LINEDA)) D DISPLAY^PRCPUX2(3,32,.X)
86 D REBUILD^PRCPWPLB
87 Q
88 ;
89 ;
90LINEITEM() ; select line item for issue book
91 N DA,DIC,X,Y
92 S DIC="^PRCS(410,"_PRCPDA_",""IT"",",DA(1)=PRCPDA,DIC(0)="QEAMZ",DIC("A")="Select LINE ITEM Number: "
93 S DIC("W")="S PRCPNODE=12 D DICW^PRCPWPL0 K PRCPNODE"
94 D ^DIC
95 Q +Y
96 ;
97 ;
98DICW ; write identifier for item
99 N %,A,B
100 ; reference global ^prcs(410,da,0) from fileman
101 S %=^(0),B=$G(^PRC(441,+$P(%,"^",5),0))
102 W ?7," ",$P(B,"^",5)," (#",+$P(%,"^",5),")",?35," QTY.ORD: ",+$P(%,"^",2),?50," QTY.DIS: ",+$P(%,"^",PRCPNODE),?65
103 I $P(%,"^",14)="" S A=$P(%,"^",2)-$P(%,"^",PRCPNODE) S:A<0 A=0 W " QTY.OUT: ",A
104 E S %=$P(%,"^",14) S A=$S(%["C":" CANCEL",1:"")_$S(%["S":" SUBST",1:"") W A
105 I $D(DZ),DZ["??" W !?7," ",$P(B,"^",2)
106 Q
Note: See TracBrowser for help on using the repository browser.