source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUDPT.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRCPUDPT ;WISC/RFJ-distribution point selection ;10 Sep 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7TO(INVPT) ; select the distr pt which invpt distributes stock TO
8 ; return da; 0 no item selected; ^ for ^ entered or timeout
9 I '$D(^PRCP(445,+INVPT,0)) Q ""
10 N %,C,DA,DIC,DISYS,DTOUT,DUOUT,I,PRCPPRIV,X,Y
11 S:'$D(^PRCP(445,INVPT,2,0)) ^(0)="^445.03PA^^"
12 S DIC="^PRCP(445,"_INVPT_",2,",DIC(0)="QEAM",DIC("W")="I $P($G(^PRCP(445,Y,0)),U,2)=""Y"" W ?60,""KEEP PERPETUAL INV""",DA=INVPT,PRCPPRIV=1
13 W ! D ^DIC
14 Q $S($G(DUOUT):"^",$G(DTOUT):"^",Y<1:0,1:+Y)
15 ;
16 ;
17FROM(DISTRPT) ; select the inventory pt which distrpt receives stock FROM
18 ; return da; 0 no item selected; ^ for ^ entered or timeout
19 I '$D(^PRCP(445,+DISTRPT,0)) Q 0
20 N %,DIC,DTOUT,DUOUT,PRCPPRIV,TYPE,X,Y
21 S TYPE=$P(^PRCP(445,DISTRPT,0),"^",3)
22 S DIC="^PRCP(445,",DIC(0)="QEAM",DIC("S")="I $D(^PRCP(445,+Y,2,DISTRPT)),$P(^PRCP(445,+Y,0),U,3)="_$S(TYPE="P":"""W""",TYPE="S":"""P""",1:"""""")
23 S DIC("A")="Select "_$S(TYPE="P":"WAREHOUSE",TYPE="S":"PRIMARY",1:"")_" Inventory Distribution Point: ",PRCPPRIV=1
24 W ! D ^DIC
25 Q $S($G(DUOUT):"^",$G(DTOUT):"^",Y<1:0,1:+Y)
26 ;
27 ;
28FROMCHEK(DISTRPT,SELECT) ; check to see if distrpt is stocked by none
29 ; or one inventory points
30 ; pass select=1 to ask for selection if stocked by more than one
31 ; return da if stocked by one, 0 otherwise
32 ; set variable prcpfone=1 if only stocked by one inventory pt
33 ; set variable prcpfnon=1 if not stocked by any inventory pts
34 K PRCPFONE,PRCPFNON
35 N %,DA,X
36 S X=0 F %=0:1 S X=$O(^PRCP(445,"AB",+DISTRPT,X)) Q:'X S DA=X
37 I '% S PRCPFNON=1 Q 0
38 I %=1 S PRCPFONE=1 Q DA
39 I 'SELECT Q 0
40 Q $$FROM(DISTRPT)
41 ;
42 ;
43SPD(DISTRPT,SELECT) ; lookup and return only spd inventory point
44 ; distrpt=secondary invpt stocked by spd
45 ; select =ask for selection if set to 1
46 N SPD
47 S SPD=+$O(^PRCP(445,"ASPEC","S",0))
48 I '$D(^PRCP(445,SPD,2,+DISTRPT,0)) S SPD=""
49 I SPD="",SELECT Q $$FROMCHEK(DISTRPT,1)
50 I SPD="" Q 0
51 Q SPD
Note: See TracBrowser for help on using the repository browser.