source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUMAN.m@ 724

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PRCPUMAN ;WISC/RFJ/DGL-lookup for mand source field .4 file 445 ; 7/22/99 1:49pm
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7HELP(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 ;
32SCREEN(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
53END I FLAG Q
54 I 0
55 Q
Note: See TracBrowser for help on using the repository browser.