source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSFSV.m@ 1078

Last change on this file since 1078 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRCPSFSV ;WOIFO/RFJ,LKG-create fms sv adjustment code sheet ;7/8/05 10:11
2 ;;5.1;IFCAP;**81,85**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7SV(INVPT,TRANID,TRANDATE,STACKDA) ; create fms sv document for adjustment
8 ; tranid=transaction register id number
9 ; pass trandate for optional FMS acctg period, otherwise it uses the
10 ; transaction date
11 ; pass stackda for regeneration of document
12 ; loop transaction register for adjusted items
13 ; variables required:
14 ; prcpwbfy = whse beg fy ; prcpwfcp = whse fcp
15 ; prcpwsta = whse station #
16 N ACCT,BFY,DATA,EFY,FUND,GECSFMS,INVCOST,LINE,LINEDOC,PRCPFMS,PRCPSEC1,REASON,SIGN,TABLE,TOTAL,TRANDA,XPROG
17 K PRCPFMS
18 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
19 . I '$P(DATA,"^",5) Q
20 . S INVCOST=$P(DATA,"^",22) I 'INVCOST Q
21 . I 'TRANDATE S TRANDATE=$P(DATA,"^",3)
22 . S ACCT=$$ACCT1^PRCPUX1($P($$NSN^PRCPUX1($P(DATA,"^",5)),"-"))
23 . S REASON=+$P(DATA,"^",10) I 'REASON S REASON=+$G(^PRCP(445.2,TRANDA,1))
24 . S TOTAL=TOTAL+INVCOST
25 . S PRCPFMS(ACCT,REASON)=$G(PRCPFMS(ACCT,REASON))+INVCOST
26 . I PRCPFMS(ACCT,REASON)=0 K PRCPFMS(ACCT,REASON)
27 I '$D(PRCPFMS) Q
28 ;
29SVCOTS ;Entry point for SV from COTS inventory transaction
30 ; set up document variables
31 ; table=^^xprogram(fcp/prj)^^linefund^beginfy^endfy^^^job
32 S TABLE=$$ACC^PRC0C(PRCPWSTA,PRCPWFCP_"^"_$E(DT,2,3)_"^"_PRCPWBFY)
33 S XPROG=$P(TABLE,"^",3),FUND=$P(TABLE,"^",5),BFY=$E($P(TABLE,"^",6),3,4),EFY=$E($P(TABLE,"^",7),3,4)
34 I EFY=BFY S EFY=""
35 ;
36 ; build control segments in gcs
37 S PRCPSEC1=$$SEC1^PRC0C(PRCPWSTA) S:PRCPSEC1="" PRCPSEC1=10
38 I '$G(STACKDA) D CONTROL^GECSUFMS("I",PRCPWSTA,PRCPWSTA_TRANID,"SV",PRCPSEC1,0,"","Other adjustment tranid: "_TRANID)
39 I $G(STACKDA) D REBUILD^GECSUFM1(STACKDA,"I",PRCPSEC1,"","Rebuild of Other adjustment tranid: "_TRANID) S GECSFMS("DA")=STACKDA
40 D SETPARAM^GECSSDCT(GECSFMS("DA"),TRANID)
41 ;
42 ; build iv2 segment
43 S LINEDOC="SV2^"_$E(TRANDATE,2,3)_"^"_$E(TRANDATE,4,5)_"^"_$E(TRANDATE,6,7)
44 S $P(LINEDOC,"^",7)="E"
45 S $P(LINEDOC,"^",16)=$J($S(TOTAL<0:-TOTAL,1:TOTAL),0,2)
46 D SETCS^GECSSTAA(GECSFMS("DA"),LINEDOC_"^~")
47 ;
48 ; build line documents
49 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
50 . S SIGN="I" I INVCOST<0 S INVCOST=-INVCOST,SIGN="D"
51 . S LINE=LINE+1
52 . S LINEDOC="LIN^~SVA^"_$E("000",$L(LINE)+1,3)_LINE_"^S"_$$TRANTYPE(REASON,ACCT)_"^"_BFY_"^"_EFY_"^"_FUND_"^^"_PRCPWSTA_"^^^^"_XPROG
53 . S $P(LINEDOC,"^",24)="220"
54 . S LINEDOC=LINEDOC_"^~SVB^"_$J(INVCOST,0,2)_"^"_SIGN_"^^G^~"
55 . D SETCS^GECSSTAA(GECSFMS("DA"),LINEDOC)
56 ;
57 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
58 D EN^DDIOL("FMS SV "_PRCPWSTA_TRANID_" document automatically "_$S($G(STACKDA):"RE-",1:"")_"transmitted.","","!?4")
59 Q
60 ;
61 ;
62TRANTYPE(TYPE,ACCT) ; return transaction type based on type (1-7) and acct
63 ; type=1:transfer stock to VAMC whse
64 ; type=2:sale of stock to OGA
65 ; type=3:transfer excess stock to GSA
66 ; type=4:adjustment to stock valuation
67 ; type=5:writeoff damaged stock
68 ; type=6:transfer transportation to stock
69 ; type=7:inventory refund adjustment
70 I TYPE=1 Q $S(ACCT=1:"A",ACCT=2:"B",ACCT=3:"C",ACCT=8:"D",ACCT=6:"N",1:0)
71 I TYPE=2 Q $S(ACCT=1:"E",ACCT=2:"F",ACCT=3:"G",ACCT=8:"H",ACCT=6:"N",1:0)
72 I TYPE=3 Q $S(ACCT=1:"J",ACCT=2:"J",ACCT=3:"J",ACCT=8:"J",ACCT=6:"N",1:0)
73 I TYPE=4 Q $S(ACCT=1:"M",ACCT=2:"N",ACCT=3:"N",ACCT=8:"N",ACCT=6:"N",1:0)
74 I TYPE=5 Q $S(ACCT=1:"M",ACCT=2:"N",ACCT=3:"N",ACCT=8:"N",ACCT=6:"N",1:0)
75 I TYPE=6 Q $S(ACCT=1:"Q",ACCT=2:"Q",ACCT=3:"Q",ACCT=8:"Q",ACCT=6:"N",1:0)
76 I TYPE=7 Q $S(ACCT=1:"U",ACCT=2:"U",ACCT=3:"U",ACCT=8:"U",ACCT=6:"N",1:0)
77 Q 0
Note: See TracBrowser for help on using the repository browser.