PRCVFMS2 ;WOIFO/LKG-GENERATE SV FROM COTS INV TRANS ;4/12/05 14:11
;;5.1;IFCAP;**81**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
; Assuming handoff via ^TMP globals of structure
; ^TMP(PRCNODE,$J,1)=Station#^BatchID^Trancode^DocAction^Transdate^Userid
; ^TMP(PRCNODE,$J,2)=SellerFCP^BuyerFCP^BuyerCostCenter^BuyerSubCostCenter
; ^TMP(PRCNODE,$J,3,0)=NumberOfItems
; ^TMP(PRCNODE,$J,3,counter,0)=FMSLineID^AccntCode^BOC^InventoryValue^SalesValue^ReasonCode
; PRCNODE = First subscript of ^TMP global containing the data
; assumed Transdate is date stored in VA FileMan format
;
ENT(PRCNODE) ;Entrance point for generating SV from COTS inventory transaction
N ACCT,BFY,DATA,EFY,FUND,GECSFMS,INVCOST,INVPT,LINE,LINEDOC,PRCPFMS,PRCPSEC1,REASON,SIGN,STACKDA,TABLE,TOTAL,TRANDA,TRANID,TRANDATE,XPROG
N PRCPWBFY,PRCPWSTA,PRCPWFCP,PRCTMP1,PRCFY,PRC,GECSDATA,D,DIC
S PRCTMP1=$G(^TMP(PRCNODE,$J,1))
I $P(PRCTMP1,"^",3)'="SV" Q
S TRANDATE=$P(PRCTMP1,"^",5),PRCFY=$S($E(TRANDATE,4,5)<10:$E(TRANDATE,2,3),1:$E(101+$E(TRANDATE,2,3),2,3))
S PRCPWSTA=$P(PRCTMP1,"^"),PRCPWFCP=$P($G(^TMP(PRCNODE,$J,2)),"^")
S PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,PRCFY,PRCPWFCP,1)
S TRANDA=0,INVPT=""
F S TRANDA=$O(^PRCP(445,"AC","W",TRANDA)) Q:+TRANDA'=TRANDA I $P($P($G(^PRCP(445,TRANDA,0)),"^"),"-")=PRCPWSTA S INVPT=TRANDA Q
Q:INVPT'>0
S TRANID="A"_$$ORDERNO^PRCPUTRX(INVPT)
S TRANDA=0,TOTAL=0
F S TRANDA=$O(^TMP(PRCNODE,$J,3,TRANDA)) Q:+TRANDA'=TRANDA D
. N X S X=$G(^TMP(PRCNODE,$J,3,TRANDA,0)) Q:X=""
. S INVCOST=$P(X,"^",4) Q:+INVCOST=0
. S ACCT=$P(X,"^",2),REASON=$P(X,"^",6) Q:ACCT="" Q:REASON=""
. S TOTAL=TOTAL+INVCOST,PRCPFMS(ACCT,REASON)=INVCOST
D SVCOTS^PRCPSFSV
Q $S($G(GECSFMS("DA"))>0:1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVFMS2 1779 printed Oct 16, 2024@18:20:44 Page 2
PRCVFMS2 ;WOIFO/LKG-GENERATE SV FROM COTS INV TRANS ;4/12/05 14:11
+1 ;;5.1;IFCAP;**81**;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ; Assuming handoff via ^TMP globals of structure
+5 ; ^TMP(PRCNODE,$J,1)=Station#^BatchID^Trancode^DocAction^Transdate^Userid
+6 ; ^TMP(PRCNODE,$J,2)=SellerFCP^BuyerFCP^BuyerCostCenter^BuyerSubCostCenter
+7 ; ^TMP(PRCNODE,$J,3,0)=NumberOfItems
+8 ; ^TMP(PRCNODE,$J,3,counter,0)=FMSLineID^AccntCode^BOC^InventoryValue^SalesValue^ReasonCode
+9 ; PRCNODE = First subscript of ^TMP global containing the data
+10 ; assumed Transdate is date stored in VA FileMan format
+11 ;
ENT(PRCNODE) ;Entrance point for generating SV from COTS inventory transaction
+1 NEW ACCT,BFY,DATA,EFY,FUND,GECSFMS,INVCOST,INVPT,LINE,LINEDOC,PRCPFMS,PRCPSEC1,REASON,SIGN,STACKDA,TABLE,TOTAL,TRANDA,TRANID,TRANDATE,XPROG
+2 NEW PRCPWBFY,PRCPWSTA,PRCPWFCP,PRCTMP1,PRCFY,PRC,GECSDATA,D,DIC
+3 SET PRCTMP1=$GET(^TMP(PRCNODE,$JOB,1))
+4 IF $PIECE(PRCTMP1,"^",3)'="SV"
QUIT
+5 SET TRANDATE=$PIECE(PRCTMP1,"^",5)
SET PRCFY=$SELECT($EXTRACT(TRANDATE,4,5)<10:$EXTRACT(TRANDATE,2,3),1:$EXTRACT(101+$EXTRACT(TRANDATE,2,3),2,3))
+6 SET PRCPWSTA=$PIECE(PRCTMP1,"^")
SET PRCPWFCP=$PIECE($GET(^TMP(PRCNODE,$JOB,2)),"^")
+7 SET PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,PRCFY,PRCPWFCP,1)
+8 SET TRANDA=0
SET INVPT=""
+9 FOR
SET TRANDA=$ORDER(^PRCP(445,"AC","W",TRANDA))
if +TRANDA'=TRANDA
QUIT
IF $PIECE($PIECE($GET(^PRCP(445,TRANDA,0)),"^"),"-")=PRCPWSTA
SET INVPT=TRANDA
QUIT
+10 if INVPT'>0
QUIT
+11 SET TRANID="A"_$$ORDERNO^PRCPUTRX(INVPT)
+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 X
SET X=$GET(^TMP(PRCNODE,$JOB,3,TRANDA,0))
if X=""
QUIT
+15 SET INVCOST=$PIECE(X,"^",4)
if +INVCOST=0
QUIT
+16 SET ACCT=$PIECE(X,"^",2)
SET REASON=$PIECE(X,"^",6)
if ACCT=""
QUIT
if REASON=""
QUIT
+17 SET TOTAL=TOTAL+INVCOST
SET PRCPFMS(ACCT,REASON)=INVCOST
End DoDot:1
+18 DO SVCOTS^PRCPSFSV
+19 QUIT $SELECT($GET(GECSFMS("DA"))>0:1,1:0)
