PRCPSFIU.m

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 ---PRCPSFIU   1192     printed  Sep 02, 2024@19:01:02                                                                                                                                                                                                    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