source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUTIL.m@ 1582

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1PRCPUTIL ;(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 ;
6QTY ; 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 ;
21DISPIP(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 ;
28DISPFCP(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
Note: See TracBrowser for help on using the repository browser.