Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPSFSV

PRCPSFSV.m

Go to the documentation of this file.
  1. PRCPSFSV ;WOIFO/RFJ,LKG-create fms sv adjustment code sheet ;7/8/05 10:11
  1. ;;5.1;IFCAP;**81,85**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. SV(INVPT,TRANID,TRANDATE,STACKDA) ; create fms sv document for adjustment
  1. ; tranid=transaction register id number
  1. ; pass trandate for optional FMS acctg period, otherwise it uses the
  1. ; transaction date
  1. ; pass stackda for regeneration of document
  1. ; loop transaction register for adjusted items
  1. ; variables required:
  1. ; prcpwbfy = whse beg fy ; prcpwfcp = whse fcp
  1. ; prcpwsta = whse station #
  1. N ACCT,BFY,DATA,EFY,FUND,GECSFMS,INVCOST,LINE,LINEDOC,PRCPFMS,PRCPSEC1,REASON,SIGN,TABLE,TOTAL,TRANDA,XPROG
  1. K PRCPFMS
  1. S (TRANDA,TOTAL)=0 F S TRANDA=$O(^PRCP(445.2,"T",INVPT,TRANID,TRANDA)) Q:'TRANDA S DATA=$G(^PRCP(445.2,TRANDA,0)) I DATA'="" D
  1. . I '$P(DATA,"^",5) Q
  1. . S INVCOST=$P(DATA,"^",22) I 'INVCOST Q
  1. . I 'TRANDATE S TRANDATE=$P(DATA,"^",3)
  1. . S ACCT=$$ACCT1^PRCPUX1($P($$NSN^PRCPUX1($P(DATA,"^",5)),"-"))
  1. . S REASON=+$P(DATA,"^",10) I 'REASON S REASON=+$G(^PRCP(445.2,TRANDA,1))
  1. . S TOTAL=TOTAL+INVCOST
  1. . S PRCPFMS(ACCT,REASON)=$G(PRCPFMS(ACCT,REASON))+INVCOST
  1. . I PRCPFMS(ACCT,REASON)=0 K PRCPFMS(ACCT,REASON)
  1. I '$D(PRCPFMS) Q
  1. ;
  1. SVCOTS ;Entry point for SV from COTS inventory transaction
  1. ; set up document variables
  1. ; table=^^xprogram(fcp/prj)^^linefund^beginfy^endfy^^^job
  1. S TABLE=$$ACC^PRC0C(PRCPWSTA,PRCPWFCP_"^"_$E(DT,2,3)_"^"_PRCPWBFY)
  1. S XPROG=$P(TABLE,"^",3),FUND=$P(TABLE,"^",5),BFY=$E($P(TABLE,"^",6),3,4),EFY=$E($P(TABLE,"^",7),3,4)
  1. I EFY=BFY S EFY=""
  1. ;
  1. ; build control segments in gcs
  1. S PRCPSEC1=$$SEC1^PRC0C(PRCPWSTA) S:PRCPSEC1="" PRCPSEC1=10
  1. I '$G(STACKDA) D CONTROL^GECSUFMS("I",PRCPWSTA,PRCPWSTA_TRANID,"SV",PRCPSEC1,0,"","Other adjustment tranid: "_TRANID)
  1. I $G(STACKDA) D REBUILD^GECSUFM1(STACKDA,"I",PRCPSEC1,"","Rebuild of Other adjustment tranid: "_TRANID) S GECSFMS("DA")=STACKDA
  1. D SETPARAM^GECSSDCT(GECSFMS("DA"),TRANID)
  1. ;
  1. ; build iv2 segment
  1. S LINEDOC="SV2^"_$E(TRANDATE,2,3)_"^"_$E(TRANDATE,4,5)_"^"_$E(TRANDATE,6,7)
  1. S $P(LINEDOC,"^",7)="E"
  1. S $P(LINEDOC,"^",16)=$J($S(TOTAL<0:-TOTAL,1:TOTAL),0,2)
  1. D SETCS^GECSSTAA(GECSFMS("DA"),LINEDOC_"^~")
  1. ;
  1. ; build line documents
  1. S (ACCT,LINE)=0 F S ACCT=$O(PRCPFMS(ACCT)) Q:'ACCT S REASON="" F S REASON=$O(PRCPFMS(ACCT,REASON)) Q:REASON="" S INVCOST=PRCPFMS(ACCT,REASON) I INVCOST D
  1. . S SIGN="I" I INVCOST<0 S INVCOST=-INVCOST,SIGN="D"
  1. . S LINE=LINE+1
  1. . S LINEDOC="LIN^~SVA^"_$E("000",$L(LINE)+1,3)_LINE_"^S"_$$TRANTYPE(REASON,ACCT)_"^"_BFY_"^"_EFY_"^"_FUND_"^^"_PRCPWSTA_"^^^^"_XPROG
  1. . S $P(LINEDOC,"^",24)="220"
  1. . S LINEDOC=LINEDOC_"^~SVB^"_$J(INVCOST,0,2)_"^"_SIGN_"^^G^~"
  1. . D SETCS^GECSSTAA(GECSFMS("DA"),LINEDOC)
  1. ;
  1. D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
  1. D EN^DDIOL("FMS SV "_PRCPWSTA_TRANID_" document automatically "_$S($G(STACKDA):"RE-",1:"")_"transmitted.","","!?4")
  1. Q
  1. ;
  1. ;
  1. TRANTYPE(TYPE,ACCT) ; return transaction type based on type (1-7) and acct
  1. ; type=1:transfer stock to VAMC whse
  1. ; type=2:sale of stock to OGA
  1. ; type=3:transfer excess stock to GSA
  1. ; type=4:adjustment to stock valuation
  1. ; type=5:writeoff damaged stock
  1. ; type=6:transfer transportation to stock
  1. ; type=7:inventory refund adjustment
  1. I TYPE=1 Q $S(ACCT=1:"A",ACCT=2:"B",ACCT=3:"C",ACCT=8:"D",ACCT=6:"N",1:0)
  1. I TYPE=2 Q $S(ACCT=1:"E",ACCT=2:"F",ACCT=3:"G",ACCT=8:"H",ACCT=6:"N",1:0)
  1. I TYPE=3 Q $S(ACCT=1:"J",ACCT=2:"J",ACCT=3:"J",ACCT=8:"J",ACCT=6:"N",1:0)
  1. I TYPE=4 Q $S(ACCT=1:"M",ACCT=2:"N",ACCT=3:"N",ACCT=8:"N",ACCT=6:"N",1:0)
  1. I TYPE=5 Q $S(ACCT=1:"M",ACCT=2:"N",ACCT=3:"N",ACCT=8:"N",ACCT=6:"N",1:0)
  1. I TYPE=6 Q $S(ACCT=1:"Q",ACCT=2:"Q",ACCT=3:"Q",ACCT=8:"Q",ACCT=6:"N",1:0)
  1. I TYPE=7 Q $S(ACCT=1:"U",ACCT=2:"U",ACCT=3:"U",ACCT=8:"U",ACCT=6:"N",1:0)
  1. Q 0