| [613] | 1 | PRCPUTIL ;(WIRMFO)/DXH,DGL - GIP utilities ; 10.7.99
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | QTY ; utility to maintain the quantities for selected Inventory Points
|
|---|
| 7 | ; as they are replenished via receipts against a Purchase Order
|
|---|
| 8 | ; line item which they are sharing with other Inventory Points
|
|---|
| 9 | ; PRC*5*197
|
|---|
| 10 | ; da(3)=>p.o.
|
|---|
| 11 | ; da(2)=>item
|
|---|
| 12 | ; da(1)=>date received
|
|---|
| 13 | ; da=>inventory point
|
|---|
| 14 | N QTY,PRCP,PRCPDA
|
|---|
| 15 | S PRCP("IP")=$P(^PRC(442,DA(3),2,DA(2),3,DA(1),1,DA,0),U)
|
|---|
| 16 | S (QTY,PRCPDA)=0 F S PRCPDA=$O(^PRC(442,DA(3),2,DA(2),3,PRCPDA)) Q:'PRCPDA S PRCP("DT")=$O(^(PRCPDA,1,"B",PRCP("IP"),0)) D:PRCP("DT")
|
|---|
| 17 | . S QTY=QTY+$P(^PRC(442,DA(3),2,DA(2),3,PRCPDA,1,PRCP("DT"),0),U,2)
|
|---|
| 18 | S PRCP("LP")=$O(^PRC(442,DA(3),2,DA(2),5,"B",PRCP("IP"),0)) S:PRCP("LP") $P(^PRC(442,DA(3),2,DA(2),5,PRCP("LP"),0),U,4)=QTY
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | DISPIP(FCPDA) ; display inv pts for FCP
|
|---|
| 22 | I '$D(^PRC(420,+$G(PRC("SITE")),1,+FCPDA,7,0)) Q
|
|---|
| 23 | N I
|
|---|
| 24 | S I=0
|
|---|
| 25 | F S I=$O(^PRC(420,"AF",+$G(PRC("SITE")),+FCPDA,I)) Q:'I W !,?10,$P($G(^PRCP(445,I,0)),U,1)
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | DISPFCP(IP) ; display FCP for inv pt
|
|---|
| 29 | Q:'$O(^PRC(420,"AE",+PRC("SITE"),IP,0))
|
|---|
| 30 | N FCP
|
|---|
| 31 | S (FCP,CNT)=0
|
|---|
| 32 | W !!,"To make a change, first select the existing control point and 'unlink' it.",!,"Then select a new one if you want to."
|
|---|
| 33 | W !!,"Current selection:"
|
|---|
| 34 | F S FCP=$O(^PRC(420,"AE",+PRC("SITE"),IP,FCP)) Q:'FCP W:CNT ! W ?20,$P($G(^PRC(420,+PRC("SITE"),1,FCP,0)),U) S CNT=CNT+1
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;PRCPUTIL
|
|---|
