PRCVFMS1.m

PRCVFMS1 ;WOIFO/LKG-GENERATE IV FROM COTS INV TRANS ;4/12/05  14:10

 ;;5.1;IFCAP;**81**;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ; PRCNODE = First subscript of the ^TMP global used to exchange data

 ; PRCPDA = IEN of Original Issue Book entry in File #410

 ; PRCPFMOD = Document Action ("E":Original; "M":Modification)

 ; PRCPPSTA = Primary Inventory Point's Station Number

 ; PRCPPFCP = Primary Inventory Point's Fund Control Point

 ; PRCPPBFY = Primary Inventory Point FCP's Beginning Budget Fiscal Year

 ; PRCPWSTA = Warehouse's Station Number

 ; PRCPWFCP = Warehouse's Fund Control Point

 ; PRCPWBFY = Warehouse FCP's Beginning Budget Fiscal Year

ENT(PRCNODE,PRCPDA) ;Entry point

 N PRCPFMOD,PRC1,PRC2,PRCPWSTA,PRCPWFCP,PRCPWBFY,PRCFY,PRCDAA,PRCSX1,PRCRI

 N ACCT,BUYBFY,BUYEFY,BUYFUND,BUYJOB,BUYLINE,BUYTABLE,BUYXPROG,COSTCNTR,DATA,FMSLINE,GECSFMS,INVCOST,LINEDA,LINEDOC,PRCPFMS,PRCPSEC1,PROFIT,PROFLINE

 N TOTAL,TRANDATE,TRANNO,TRANDA,TRANID,PRCPPSTA,PRCPPFCP,PRCPPBFY,PRC,PRCX

 N SELBFY,SELEFY,SELFUND,SELLINE,SELTABLE,SELXPROG,SIGN,STACKDA,SUBACCT,VOUCHER

 N GECSDATA,D,DIC

 S PRC1=$G(^TMP(PRCNODE,$J,1)),PRC2=$G(^TMP(PRCNODE,$J,2))

 S PRCPFMOD=$S($P(PRC1,"^",4)="E":0,1:1),(PRCPPSTA,PRCPWSTA)=$P(PRC1,"^")

 S PRCPWFCP=$P(PRC2,"^"),PRCPPFCP=$P(PRC2,"^",2),TRANDATE=$P(PRC1,"^",5),TRANID=$P(PRC1,"^",2)

 S TRANNO=$P($G(^PRCS(410,PRCPDA,0)),"^")

 S PRCFY=$S($E(TRANDATE,4,5)<10:$E(TRANDATE,2,3),1:$E(101+$E(TRANDATE,2,3),2,3))

 S PRCPPBFY=$$BBFY^PRCSUT(PRCPPSTA,PRCFY,PRCPPFCP,1),PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,PRCFY,PRCPWFCP,1)

 S TRANDA=0,TOTAL=0

 F  S TRANDA=$O(^TMP(PRCNODE,$J,3,TRANDA)) Q:+TRANDA'=TRANDA  D

 . N PRC445 S PRC445=$G(^TMP(PRCNODE,$J,3,TRANDA,0))

 . S FMSLINE=$P(PRC445,"^"),PRCPFMS(FMSLINE)=$P(PRC445,"^",2)_"^"_$P(PRC445,"^",3)_"^"_$P(PRC445,"^",4)_"^"_($P(PRC445,"^",5)-$P(PRC445,"^",4))

 . S TOTAL=TOTAL+$P(PRC445,"^",5)

 D IVCOTS^PRCPSFIV

 Q $S($G(GECSFMS("DA"))>0:1,1:0)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCVFMS1   1978     printed  Apr 09, 2024@21:05:52                                                                                                                                                                                                    Page 2

PRCVFMS1  ;WOIFO/LKG-GENERATE IV FROM COTS INV TRANS ;4/12/05  14:10

 +1       ;;5.1;IFCAP;**81**;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ; PRCNODE = First subscript of the ^TMP global used to exchange data

 +5       ; PRCPDA = IEN of Original Issue Book entry in File #410

 +6       ; PRCPFMOD = Document Action ("E":Original; "M":Modification)

 +7       ; PRCPPSTA = Primary Inventory Point's Station Number

 +8       ; PRCPPFCP = Primary Inventory Point's Fund Control Point

 +9       ; PRCPPBFY = Primary Inventory Point FCP's Beginning Budget Fiscal Year

 +10      ; PRCPWSTA = Warehouse's Station Number

 +11      ; PRCPWFCP = Warehouse's Fund Control Point

 +12      ; PRCPWBFY = Warehouse FCP's Beginning Budget Fiscal Year

ENT(PRCNODE,PRCPDA) ;Entry point

 +1        NEW PRCPFMOD,PRC1,PRC2,PRCPWSTA,PRCPWFCP,PRCPWBFY,PRCFY,PRCDAA,PRCSX1,PRCRI

 +2        NEW ACCT,BUYBFY,BUYEFY,BUYFUND,BUYJOB,BUYLINE,BUYTABLE,BUYXPROG,COSTCNTR,DATA,FMSLINE,GECSFMS,INVCOST,LINEDA,LINEDOC,PRCPFMS,PRCPSEC1,PROFIT,PROFLINE

 +3        NEW TOTAL,TRANDATE,TRANNO,TRANDA,TRANID,PRCPPSTA,PRCPPFCP,PRCPPBFY,PRC,PRCX

 +4        NEW SELBFY,SELEFY,SELFUND,SELLINE,SELTABLE,SELXPROG,SIGN,STACKDA,SUBACCT,VOUCHER

 +5        NEW GECSDATA,D,DIC

 +6        SET PRC1=$GET(^TMP(PRCNODE,$JOB,1))

           SET PRC2=$GET(^TMP(PRCNODE,$JOB,2))

 +7        SET PRCPFMOD=$SELECT($PIECE(PRC1,"^",4)="E":0,1:1)

           SET (PRCPPSTA,PRCPWSTA)=$PIECE(PRC1,"^")

 +8        SET PRCPWFCP=$PIECE(PRC2,"^")

           SET PRCPPFCP=$PIECE(PRC2,"^",2)

           SET TRANDATE=$PIECE(PRC1,"^",5)

           SET TRANID=$PIECE(PRC1,"^",2)

 +9        SET TRANNO=$PIECE($GET(^PRCS(410,PRCPDA,0)),"^")

 +10       SET PRCFY=$SELECT($EXTRACT(TRANDATE,4,5)<10:$EXTRACT(TRANDATE,2,3),1:$EXTRACT(101+$EXTRACT(TRANDATE,2,3),2,3))

 +11       SET PRCPPBFY=$$BBFY^PRCSUT(PRCPPSTA,PRCFY,PRCPPFCP,1)

           SET PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,PRCFY,PRCPWFCP,1)

 +12       SET TRANDA=0

           SET TOTAL=0

 +13       FOR 

               SET TRANDA=$ORDER(^TMP(PRCNODE,$JOB,3,TRANDA))

               if +TRANDA'=TRANDA

                   QUIT 

               Begin DoDot:1

 +14               NEW PRC445

                   SET PRC445=$GET(^TMP(PRCNODE,$JOB,3,TRANDA,0))

 +15               SET FMSLINE=$PIECE(PRC445,"^")

                   SET PRCPFMS(FMSLINE)=$PIECE(PRC445,"^",2)_"^"_$PIECE(PRC445,"^",3)_"^"_$PIECE(PRC445,"^",4)_"^"_($PIECE(PRC445,"^",5)-$PIECE(PRC445,"^",4))

 +16               SET TOTAL=TOTAL+$PIECE(PRC445,"^",5)

               End DoDot:1

 +17       DO IVCOTS^PRCPSFIV

 +18       QUIT $SELECT($GET(GECSFMS("DA"))>0:1,1:0)