- 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 ---[H[J[2J[HPRCVFMS1 1978 printed Mar 13, 2025@21:24:47 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)
