| 1 | PRCPUMAN ;WISC/RFJ/DGL-lookup for mand source field .4 file 445 ; 7/22/99 1:49pm
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | HELP(INVPT,ITEMDA,SCREEN) ; called from help (node 4 for dd(445.01,.4, )
|
|---|
| 8 | ; to display mandatory source.
|
|---|
| 9 | ; screen=1 to lookup in screen for procurement source in 445.07
|
|---|
| 10 | ; optional prc("cp"),prc("site")
|
|---|
| 11 | I 'INVPT!('ITEMDA) Q
|
|---|
| 12 | N %,CP,MANSRCE,SITE,TYPE
|
|---|
| 13 | S MANSRCE=$$MANDSRCE^PRCPU441(ITEMDA),TYPE=$P($G(^PRCP(445,INVPT,0)),"^",3)
|
|---|
| 14 | S SITE=+$G(PRC("SITE")) I 'SITE S SITE=+$G(^PRCP(445,INVPT,0))
|
|---|
| 15 | S CP=$G(PRC("CP")) I CP="" S CP=+$O(^PRC(420,"AE",SITE,INVPT,0)),CP=$P($G(^PRC(420,SITE,1,CP,0))," ") ; Multiple FCP not supported
|
|---|
| 16 | W ! I TYPE="W" D W !! Q
|
|---|
| 17 | . I MANSRCE'=$O(^PRC(440,"AC","S",0)) W !,"ITEM IS NOT SET UP AS POSTED STOCK. THE MANDATORY SOURCE IN THE ITEM MASTER",!,"FILE DOES NOT EQUAL THE WAREHOUSE VENDOR." Q
|
|---|
| 18 | . S %=$P($G(^PRC(440,+$P($G(^PRC(441,ITEMDA,0)),"^",4),0)),"^") I %'="" W !,"LAST VENDOR ORDERED: ",%
|
|---|
| 19 | . S %=$P($G(^PRC(440,+$P($G(^PRC(441,ITEMDA,4,SITE_CP,0)),"^",3),0)),"^") I %'="" W !,"PREFERRED VENDOR (FOR CP: ",CP,"): ",%
|
|---|
| 20 | . W !,"YOU MAY SELECT ANY VENDOR WHICH IS SET UP AS A VENDOR FOR THIS ITEM IN THE ITEM",!,"MASTER FILE"
|
|---|
| 21 | . W $S(SCREEN:", AND IS A PROCUREMENT SOURCE FOR THIS ITEM IN THE INVENTORY POINT.",1:". ") W:SCREEN ! W "THE VENDOR ALSO MUST NOT BE INACTIVATED."
|
|---|
| 22 | I TYPE="P" D W !! Q
|
|---|
| 23 | . I MANSRCE W !,"ITEM HAS A MANDATORY SOURCE: ",$P($G(^PRC(440,+MANSRCE,0)),"^"),".",!,"YOU CAN ONLY SELECT THIS VENDOR." Q
|
|---|
| 24 | . S %=$P($G(^PRC(440,+$P($G(^PRC(441,ITEMDA,0)),"^",4),0)),"^") I %'="" W !,"LAST VENDOR ORDERED: ",%
|
|---|
| 25 | . S %=$P($G(^PRC(440,+$P($G(^PRC(441,ITEMDA,4,SITE_CP,0)),"^",3),0)),"^") I %'="" W !,"PREFERRED VENDOR (FOR CP: ",CP,"): ",%
|
|---|
| 26 | . W !,"YOU MAY SELECT ANY VENDOR WHICH IS SET UP AS A VENDOR FOR THIS ITEM IN THE ITEM",!,"MASTER FILE, AND IS A PROCUREMENT SOURCE FOR THIS ITEM IN THE INVENTORY POINT.",!,"THE VENDOR ALSO MUST NOT BE INACTIVATED."
|
|---|
| 27 | I TYPE="S" D W !! Q
|
|---|
| 28 | . W !,"YOU CAN ONLY SELECT A PRIMARY DISTRIBUTION POINT WHICH DISTRIBUTES THIS ITEM."
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ;
|
|---|
| 32 | SCREEN(INVPT,ITEMDA,SCREEN1) ; called from input transform for dd(445.01,.4,
|
|---|
| 33 | ; x=vendor name, y=vendor number,
|
|---|
| 34 | ; dic=file 440 or 445 it should lookup on
|
|---|
| 35 | ; screen1=1 to lookup in screen for procurement source in 445.07
|
|---|
| 36 | ; if vendor y fails -->> flag=0 and $t=0
|
|---|
| 37 | N %,FLAG,LOOKUP,MANSRCE,SCREEN,TYPE
|
|---|
| 38 | S FLAG=1
|
|---|
| 39 | I 'INVPT!('ITEMDA) S FLAG=0 G END
|
|---|
| 40 | S MANSRCE=$$MANDSRCE^PRCPU441(ITEMDA),TYPE=$P($G(^PRCP(445,INVPT,0)),"^",3),LOOKUP=$S($G(DIC)["^PRCP(445":";PRCP(445,",1:";PRC(440,")
|
|---|
| 41 | S SCREEN="I LOOKUP[440,$D(^PRC(441,ITEMDA,2,+Y)),'$P($G(^PRC(440,+Y,10)),""^"",5)"_$S(SCREEN1:",$O(^PRCP(445,INVPT,1,ITEMDA,5,""B"",(+Y)_"";PRC(440,"",0))",1:"")
|
|---|
| 42 | I TYPE="W" D G END
|
|---|
| 43 | . I MANSRCE'=$O(^PRC(440,"AC","S",0)) S FLAG=0 Q
|
|---|
| 44 | . I MANSRCE=Y S FLAG=0 Q
|
|---|
| 45 | . X SCREEN I '$T S FLAG=0
|
|---|
| 46 | I TYPE="P" D G END
|
|---|
| 47 | . I MANSRCE,Y=MANSRCE Q
|
|---|
| 48 | . I MANSRCE S FLAG=0 Q
|
|---|
| 49 | . X SCREEN I '$T S FLAG=0
|
|---|
| 50 | I TYPE="S" D
|
|---|
| 51 | . I LOOKUP[445,$D(^PRCP(445,Y,1,ITEMDA,0)),$D(^PRCP(445,Y,2,INVPT,0)) Q
|
|---|
| 52 | . S FLAG=0
|
|---|
| 53 | END I FLAG Q
|
|---|
| 54 | I 0
|
|---|
| 55 | Q
|
|---|
