- 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 Feb 18, 2025@23:42:06 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