source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFM1M.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PRCFFM1M ;WISC/SJG-ROUTINE TO PROCESS AMENDMENT OBLIGATIONS CON'T ;4/26/94 16:40
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5NEWVAR ; Refresh variables from 442
6 K DIC
7 S DIC("S")="I +^(0)=PRC(""SITE"")"
8 S DIC=442,DIC(0)="NZ",X=PRCFA("PODA")
9 D ^DIC K DIC G:+Y<0 OUT1
10 S PO(0)=Y(0),PO=Y
11 S PRCFA("REF")=$P(PO(0),U)
12 ; the following line was commented out in PRC*5*179
13 ; S PRCFA("SFC")=$P(PO(0),U,19)
14 S PRCFA("MP")=$P(PO(0),U,2)
15 S PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO)
16 D GENDIQ^PRCFFU7(442,+PO,".1;.07;.03;17","IEN","")
17 ;
18EDIT ; Check fund/year table to determine fields required for FMS
19 D EDIT^PRCFFU ; sets up PRCFMO array for req'd fields
20 ;
21 ; if amendment requires re-establishing the FMS document
22 I $D(PRCFA("CANCEL")),PRCFA("CANCEL")]"" S PRCFA("MOD")="E^0^Original Entry (Amended)"
23 I PRCFA("TT")="AR",$D(PRCFA("CANCEL")),PRCFA("CANCEL")]"",XRBLD'=2 D
24 . S PRCFA("TT")="SO"
25 . D STACK ; set up the SO first
26 . S PRCFA("TT")="AR"
27 . S X1=PRCFA("OBLDATE"),X2=1
28 . D C^%DTC
29 . S PRCFA("OBLDATE")=X ; SO must be on FMS 1st, thus AR needs future date
30 . S %DT="FX",X="T+1"
31 . D ^%DT
32 . I $P(Y,".",1)>PRCFA("OBLDATE") S PRCFA("OBLDATE")=$P(Y,".",1)
33 D STACK ; build the appropriate FMS transaction
34 ;
35 D ;adj fcp committed/obligated balance
36 . ; the next several lines were omitted by patch 172
37 . ; N TRDA,Z,AMT,DEL,X,TIME,DA
38 . ; S TRDA=$P(^PRC(442,PRCFA("PODA"),0),"^",12),AMT=$P(^(0),"^",$P(PRCFMO,"^",12)="N"+15),DEL=$P(^(0),"^",10)
39 . ; D NOW^%DTC S TIME=X
40 . ; I TRDA="" D QUIT
41 . ; . N A
42 . ; . S A=$$DATE^PRC0C($P(PRCOAMT,"^",3),"I"),$P(PRCOAMT,"^",3,4)=$E(A,3,4)_"^"_$P(A,"^",2)
43 . ; . D EBAL^PRCSEZ(PRCOAMT,"C"),EBAL^PRCSEZ(PRCOAMT,"O")
44 . ; . ;S A=$P($G(^PRC(442,PRCFA("PODA"),1)),"^",15) QUIT:A=""
45 . ; . QUIT:PRC("RBDT") S A=$$DATE^PRC0C(PRC("RBDT"),"I")
46 . ; . S A=+PO(0)_"^"_$P(PO(0),"^",3)_"^"_$E(A,3,4)_"^"_$P(A,"^",2)_"^"_AMT
47 . ; . D EBAL^PRCSEZ(A,"C"),EBAL^PRCSEZ(A,"O")
48 . ; . QUIT
49 . N TRDA,DEL,DA,MESSAGE
50 . S TRDA=$P(^PRC(442,PRCFA("PODA"),0),"^",12),DEL=$P(^(0),"^",10)
51 . I TRDA="" Q
52 . I '$D(^PRCS(410,TRDA,4)) Q
53 . S DA=TRDA,$P(^PRCS(410,TRDA,9),"^",2)=DEL
54 . D REMOVE^PRCSC2(DA),ENCODE^PRCSC2(DA,DUZ,.MESSAGE)
55 . QUIT
56 ;
57FISCST ; Post to Fiscal Status of Funds Tracker
58 I $P(PRC("PARAM"),U,17)["Y" D FISC^PRCFFU4
59 ;
60PRINT ; Print out copy of Purchase Order Amendment
61 G:'FLG OUT1
62 S PRCHQ="^PRCHPAM"
63 S PRCHQ("DEST")="S8"
64 S D0=PRCFA("PODA")
65 S D1=PRCFA("AMEND#")
66 D ^PRCHQUE
67 ;
68OUT1 K FLG,%,%Y,DIC,I,J,K,P,PRCFAA,PRCFPODA,X,Y,Z
69 K BBFY,SUB,TAG,PRCFMO,PRCCCC,PRCCSCC
70 K PO,PAT,PARAM1,NEW,LOOPVAL,LOOP,LOOP1,LOOP2,LOOP3,LOOP4,GECSFMS
71 K OLD,OLDVAL,FMSMOD,FMSNO,FMSVENID,PODATE,NUMB,MOD,ERFLAG,STR2
72 W !!
73 Q
74 ;
75STACK ; Create entry in GECS Stack File
76 D STACK^PRCFFU(1) ; pass 1 to force batch generation, set up CTL,BAT,DOC
77 ;
78SEGS ; Create entry into TMP($J for remaining segments
79 K ^TMP($J,"PRCMO")
80 N FMSINT S FMSINT=+PO
81 S FMSMOD=$P(PRCFA("MOD"),U,1)
82 D NEW^PRCFFU1(FMSINT,PRCFA("TT"),FMSMOD)
83 ;
84TRANSF ; Transfer nodes from TMP($J, into GECS Stack File
85 N LOOP S LOOP=0 F S LOOP=$O(^TMP($J,"PRCMO",GECSFMS("DA"),LOOP)) Q:'LOOP D SETCS^GECSSTAA(GECSFMS("DA"),^(LOOP))
86 K ^TMP($J,"PRCMO")
87 ;
88TRANSM ; Mark the document as queued for transmission
89 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
90 N P2 S P2=+PO_"/"_PRCFA("AMEND#"),$P(P2,"/",5)=$P($G(PRCFA("ACCPD")),U),$P(P2,"/",6)=PRCFA("OBLDATE")
91 D SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
92 ;
93POBAL ; Enter Obligation Data into Purchase Order Record
94 I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
95 N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2)
96 D EN7^PRCFFU41(PRCFA("TT"),FMSMOD,PRCFA("OBLDATE"),FMSDOCT) ; txn log
Note: See TracBrowser for help on using the repository browser.