source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEITD.m@ 1154

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

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1PRCPEITD ;WISC/RFJ-enter,edit items for distribution point ;01 Dec 93
2V ;;5.1;IFCAP;**1**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 I "PW"'[PRCP("DPTYPE") W !,"This option can only be used by primary or warehouse inventory points." Q
6 N %,D,D0,D1,DA,DATA,DI,DIC,DIE,DQ,DR,DISTRPT,GROUP,ITEMDA,ITEMDATA,MANDATA,MANSRCE,PRCPFLAG,PRCPINPT,PRCPSTOP,X,Y
7 F D I $G(PRCPFLAG) QUIT
8 . W !!?7,"You can only edit items in distribution points"
9 . W !?7,"NOT keeping a perpetual inventory."
10 . S DISTRPT=+$$TO^PRCPUDPT(PRCP("I")) I 'DISTRPT S PRCPFLAG=1 Q
11 . I $P($G(^PRCP(445,DISTRPT,0)),"^",2)="Y" Q
12 . L +^PRCP(445,DISTRPT,1):5 I '$T D SHOWWHO^PRCPULOC(445,DISTRPT_"-1",0) Q
13 . D ADD^PRCPULOC(445,DISTRPT_"-1",0,"Enter/Edit Items On Distribution Point")
14 . K PRCPSTOP F D Q:$G(PRCPSTOP)
15 . . W !!
16 . . S ITEMDA=$$ITEM^PRCPUITM(DISTRPT,1,",$D(^PRCP(445,"_PRCP("I")_",1,+Y,0))","")
17 . . I ITEMDA["^" S (PRCPFLAG,PRCPSTOP)=1 Q
18 . . I 'ITEMDA S PRCPSTOP=1 Q
19 . . S GROUP=$$GROUPDA^PRCPEGRP(DISTRPT,ITEMDA)
20 . . I 'GROUP S GROUP=$$GROUPDA^PRCPEGRP(PRCP("I"),ITEMDA) I GROUP S DATA=$G(^PRCP(445.6,GROUP,0)) I DATA'="" D
21 . . . ; lookup group category
22 . . . S Y=+$$GROUP^PRCPEGRP(DISTRPT,$P(DATA,"^"))
23 . . . I Y>0 D SETGRP^PRCPEGRP(DISTRPT,ITEMDA,Y) Q
24 . . . ; add group category to group category file
25 . . . S Y=$$ADDGRP^PRCPEGRP(DISTRPT,$P(DATA,"^"),$P(DATA,"^",3))
26 . . . I Y D SETGRP^PRCPEGRP(DISTRPT,ITEMDA,Y)
27 . . ;
28 . . S %=$P($G(^PRCP(445,PRCP("I"),1,ITEMDA,6)),"^")
29 . . I %'="" S $P(^PRCP(445,DISTRPT,1,ITEMDA,6),"^")=%
30 . . ;
31 . . S DATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
32 . . S MANSRCE=PRCP("I")_";PRCP(445,"
33 . . I PRCP("DPTYPE")="W" S MANSRCE=$O(^PRC(440,"AC","S",0))_";PRC(440,"
34 . . I +MANSRCE D
35 . . . S $P(^PRCP(445,DISTRPT,1,ITEMDA,0),"^",12)=MANSRCE
36 . . . S ^PRCP(445,DISTRPT,1,"AC",$E(MANSRCE,1,30),ITEMDA)=""
37 . . . W !?5,"MANDATORY SOURCE : ",$$VENNAME^PRCPUX1(MANSRCE)
38 . . . I '$$GETVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,1) D ADDVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,$P(DATA,"^",5),$P(DATA,"^",14),1)
39 . . S MANDATA=$$GETVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,1)
40 . . S ITEMDATA=^PRCP(445,DISTRPT,1,ITEMDA,0)
41 . . S:$P(ITEMDATA,"^",5)="" $P(ITEMDATA,"^",5)=$P(DATA,"^",5)
42 . . S:$P(ITEMDATA,"^",14)="" $P(ITEMDATA,"^",14)=$P(DATA,"^",14)
43 . . S ^PRCP(445,DISTRPT,1,ITEMDA,0)=ITEMDATA
44 . . W !?5,"UNIT per ISSUE : "
45 . . W $$UNITVAL^PRCPUX1($P(ITEMDATA,"^",14),$P(ITEMDATA,"^",5)," per ")
46 . . I MANDATA D
47 . . . W !?5,"UNIT per RECEIPT : "
48 . . . W $$UNITVAL^PRCPUX1($P(MANDATA,"^",3),$P(MANDATA,"^",2)," per ")
49 . . . W !?5,"CONVERSION FACTOR: ",$P(MANDATA,"^",4)
50 . . S DR=".01;4;4.5;.6;4.7;9;5;"_$S(PRCP("DPTYPE")="W":"14.3;14.4;",1:"")
51 . . S DR(2,445.07)="3;"
52 . . I $P(^PRCP(445,DISTRPT,0),"^",3)="S",$P($G(^PRCP(445,DISTRPT,5)),"^",1)]"" D
53 . . . D EDNORM^PRCPEITE(DISTRPT,ITEMDA,"NORMAL STOCK LEVEL")
54 . . . I $D(DUOUT)!$D(DTOUT) S PRCPSTOP=1 Q
55 . . . S DR=".01;4;4.5;.6;4.7;5;"_$S(PRCP("DPTYPE")="W":"14.3;14.4;",1:"")
56 . . I $G(PRCPSTOP) S PRCPFLAG=1 Q ; allow user to exit item editing
57 . . S DIE="^PRCP(445,"_DISTRPT_",1,"
58 . . S (DA(1),PRCPINPT)=DISTRPT
59 . . S (DA,D1)=ITEMDA
60 . . D ^DIE K DIC,DIE,DR I $D(Y) Q
61 . . D BLDSEG^PRCPHLFM(3,ITEMDA,DISTRPT) ; send supply station an update of any changes to the item
62 . L -^PRCP(445,DISTRPT,1,ITEMDA) ; do this even if user enters '^'
63 . D CLEAR^PRCPULOC(445,DISTRPT_"-1",0)
64 Q
Note: See TracBrowser for help on using the repository browser.