source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSFIU.m@ 1154

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1PRCPSFIU ;WISC/RFJ/DGL-fms utility (lookup fcp data) ; 7/22/99 1:50pm
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7IVDATA(TRANDA,INVPT) ; get fund control point data for iv doc
8 ; tranda=issue book ien; invpt=whse inventory point
9 N PRC,TRANNO
10 S TRANNO=$P($G(^PRCS(410,TRANDA,0)),"^")
11 ; seller=whse data
12 S PRCPWSTA=$P($P($G(^PRCP(445,INVPT,0)),"^"),"-")
13 S PRCPWFCP=+$O(^PRC(420,"AE",PRCPWSTA,INVPT,0)) ; Multiple FCP not supported
14 S PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,$P(TRANNO,"-",2),PRCPWFCP)
15 ; buyer data
16 S PRCPPSTA=$P(TRANNO,"-")
17 S PRCPPFCP=+$P($G(^PRCS(410,TRANDA,3)),"^") I 'PRCPPFCP S PRCPPFCP=+$P(TRANNO,"-",4)
18 S PRCPPBFY=$P($G(^PRCS(410,TRANDA,3)),"^",11) I PRCPPBFY'="" S PRCPPBFY=(17+$E(PRCPPBFY))_$E(PRCPPBFY,2,3)
19 I PRCPPBFY="" S PRCPPBFY=$$BBFY^PRCSUT(PRCPPSTA,$P(TRANNO,"-",2),PRCPPFCP)
20 Q
21 ;
22 ;
23SVDATA(INVPT) ; get fund control point data for sv doc
24 ; invpt=whse inventory point
25 N PRC
26 S PRCPWSTA=$P($P($G(^PRCP(445,INVPT,0)),"^"),"-")
27 S PRCPWFCP=+$O(^PRC(420,"AE",PRCPWSTA,INVPT,0)) ; Multiple FCP not supported
28 S PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,$E(DT,2,3),PRCPWFCP)
29 Q
Note: See TracBrowser for help on using the repository browser.