PRCPSFIU ;WISC/RFJ/DGL-fms utility (lookup fcp data) ; 7/22/99 1:50pm
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
IVDATA(TRANDA,INVPT) ; get fund control point data for iv doc
; tranda=issue book ien; invpt=whse inventory point
N PRC,TRANNO
S TRANNO=$P($G(^PRCS(410,TRANDA,0)),"^")
; seller=whse data
S PRCPWSTA=$P($P($G(^PRCP(445,INVPT,0)),"^"),"-")
S PRCPWFCP=+$O(^PRC(420,"AE",PRCPWSTA,INVPT,0)) ; Multiple FCP not supported
S PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,$P(TRANNO,"-",2),PRCPWFCP)
; buyer data
S PRCPPSTA=$P(TRANNO,"-")
S PRCPPFCP=+$P($G(^PRCS(410,TRANDA,3)),"^") I 'PRCPPFCP S PRCPPFCP=+$P(TRANNO,"-",4)
S PRCPPBFY=$P($G(^PRCS(410,TRANDA,3)),"^",11) I PRCPPBFY'="" S PRCPPBFY=(17+$E(PRCPPBFY))_$E(PRCPPBFY,2,3)
I PRCPPBFY="" S PRCPPBFY=$$BBFY^PRCSUT(PRCPPSTA,$P(TRANNO,"-",2),PRCPPFCP)
Q
;
;
SVDATA(INVPT) ; get fund control point data for sv doc
; invpt=whse inventory point
N PRC
S PRCPWSTA=$P($P($G(^PRCP(445,INVPT,0)),"^"),"-")
S PRCPWFCP=+$O(^PRC(420,"AE",PRCPWSTA,INVPT,0)) ; Multiple FCP not supported
S PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,$E(DT,2,3),PRCPWFCP)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPSFIU 1192 printed Oct 16, 2024@18:16:28 Page 2
PRCPSFIU ;WISC/RFJ/DGL-fms utility (lookup fcp data) ; 7/22/99 1:50pm
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
+3 ;
+4 ;
IVDATA(TRANDA,INVPT) ; get fund control point data for iv doc
+1 ; tranda=issue book ien; invpt=whse inventory point
+2 NEW PRC,TRANNO
+3 SET TRANNO=$PIECE($GET(^PRCS(410,TRANDA,0)),"^")
+4 ; seller=whse data
+5 SET PRCPWSTA=$PIECE($PIECE($GET(^PRCP(445,INVPT,0)),"^"),"-")
+6 ; Multiple FCP not supported
SET PRCPWFCP=+$ORDER(^PRC(420,"AE",PRCPWSTA,INVPT,0))
+7 SET PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,$PIECE(TRANNO,"-",2),PRCPWFCP)
+8 ; buyer data
+9 SET PRCPPSTA=$PIECE(TRANNO,"-")
+10 SET PRCPPFCP=+$PIECE($GET(^PRCS(410,TRANDA,3)),"^")
IF 'PRCPPFCP
SET PRCPPFCP=+$PIECE(TRANNO,"-",4)
+11 SET PRCPPBFY=$PIECE($GET(^PRCS(410,TRANDA,3)),"^",11)
IF PRCPPBFY'=""
SET PRCPPBFY=(17+$EXTRACT(PRCPPBFY))_$EXTRACT(PRCPPBFY,2,3)
+12 IF PRCPPBFY=""
SET PRCPPBFY=$$BBFY^PRCSUT(PRCPPSTA,$PIECE(TRANNO,"-",2),PRCPPFCP)
+13 QUIT
+14 ;
+15 ;
SVDATA(INVPT) ; get fund control point data for sv doc
+1 ; invpt=whse inventory point
+2 NEW PRC
+3 SET PRCPWSTA=$PIECE($PIECE($GET(^PRCP(445,INVPT,0)),"^"),"-")
+4 ; Multiple FCP not supported
SET PRCPWFCP=+$ORDER(^PRC(420,"AE",PRCPWSTA,INVPT,0))
+5 SET PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,$EXTRACT(DT,2,3),PRCPWFCP)
+6 QUIT
