| 1 | PRCPUDPT ;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 | ;
|
|---|
| 7 | TO(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 | ;
|
|---|
| 17 | FROM(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 | ;
|
|---|
| 28 | FROMCHEK(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 | ;
|
|---|
| 43 | SPD(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
|
|---|
