| 1 | PRCB1B1 ;WISC/PLT-PRCB1B continue ; 05/01/94 4:09 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ;invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | ;PRCC required data = quarter date
|
|---|
| 7 | ;PRC array
|
|---|
| 8 | TMEN ;rollover for all single year fcp
|
|---|
| 9 | N PRCB,PRCD,PRCE,PRCDI,PRCRICB,PRCLOCK
|
|---|
| 10 | N A,B,C
|
|---|
| 11 | S A=$$DATE^PRC0C("T","E"),A=$P(A,"^",4)_"/"_$P(A,"^",5)_"/"_$P(A,"^",3)
|
|---|
| 12 | I $D(ZTQUEUED) D KILL^%ZTLOAD
|
|---|
| 13 | D EN^DDIOL("IFCAP Rollover Fund Control Point Balance List Printed on "_A)
|
|---|
| 14 | D EN^DDIOL(" For Budget Fiscal Year: "_$P(PRCC,"^")_" Quarter: "_$P(PRCC,"^",2))
|
|---|
| 15 | S B=3 D ICLOCK^PRC0B("^PRC(420,"_(+PRC("SITE"))_",",.B)
|
|---|
| 16 | I 'B D EN^DDIOL(" Fund Control Point file in use, try later!") QUIT
|
|---|
| 17 | S PRC("BBFY")=+PRCC
|
|---|
| 18 | S PRC("CP")=0,PRCOPT=1
|
|---|
| 19 | F S PRC("CP")=$O(^PRC(420,+PRC("SITE"),1,PRC("CP"))) Q:PRC("CP")>9998!'PRC("CP") I $P($G(^(PRC("CP"),5)),"^",7)<$P(PRCC,"^",7) S PRCD=$G(^(0)) D:PRCD]""
|
|---|
| 20 | . D FCPTRF
|
|---|
| 21 | . QUIT
|
|---|
| 22 | D DCLOCK^PRC0B("^PRC(420,"_(+PRC("SITE"))_",")
|
|---|
| 23 | QUIT
|
|---|
| 24 | ;
|
|---|
| 25 | FCPTRF ; start rollup
|
|---|
| 26 | S PRCAPP=$$APP^PRC0C(PRC("SITE"),PRC("FY"),PRC("CP"))
|
|---|
| 27 | I PRCOPT=1,$P(PRCAPP,"^",1)["_/_" QUIT
|
|---|
| 28 | I PRCOPT=2,$P(PRCAPP,"^",1)'["_/_" QUIT
|
|---|
| 29 | Q:$P(PRCD,"^",20)'=1!$P(PRCD,"^",19)!'$P(PRCD,"^",21)
|
|---|
| 30 | S PRCB("AMOUNT")=$P($$FCPBAL^PRC0D(PRC("SITE"),PRC("CP"),PRC("FY"),1),"^",PRC("QTR"))
|
|---|
| 31 | Q:PRCB("AMOUNT")'>0
|
|---|
| 32 | S PRCE=$G(^PRC(420,+PRC("SITE"),1,+$P(PRCD,"^",21),0))
|
|---|
| 33 | Q:+PRCD=+PRCE!'PRCE
|
|---|
| 34 | S PRCAPP=$$APP^PRC0C(PRC("SITE"),PRC("FY"),+PRCE)
|
|---|
| 35 | I PRCOPT=1,$P(PRCAPP,"^",1)["_/_" QUIT
|
|---|
| 36 | I PRCOPT=2,$P(PRCAPP,"^",1)'["_/_" QUIT
|
|---|
| 37 | S PRCB("FRCP")=$P(PRCD,"^"),PRCB("TOCP")=$P(PRCE,"^")
|
|---|
| 38 | D EN^DDIOL("Roll "_$E(PRCB("FRCP"),1,30)_" to "_$E(PRCB("TOCP"),1,30)_" $"_$FN(PRCB("AMOUNT"),"",2))
|
|---|
| 39 | S PRCACF=$$ACC^PRC0C(PRC("SITE"),PRCB("FRCP")_"^"_PRC("FY")_"^"_PRC("BBFY"))
|
|---|
| 40 | S PRCACT=$$ACC^PRC0C(PRC("SITE"),PRCB("TOCP")_"^"_PRC("FY")_"^"_PRC("BBFY"))
|
|---|
| 41 | I $P(PRCACF,"^")-$P(PRCACT,"^") D EN^DDIOL(" Error: must be in the same A/O!") QUIT
|
|---|
| 42 | I $P(PRCACF,"^",9)-$P(PRCACT,"^",9) D EN^DDIOL(" Error: must be in the same fund!") QUIT
|
|---|
| 43 | I $P(PRCACF,"^",2)'=$P(PRCACT,"^",2),$P(PRCACF,"^",8)="N" D EN^DDIOL(" Error: fund transfer not allowed") QUIT
|
|---|
| 44 | S PRCQT="" D A421
|
|---|
| 45 | I PRCQT D EN^DDIOL(" Error: Txn number can not be assigned") QUIT
|
|---|
| 46 | S PRCDI="420;^PRC(420,;"_(+PRC("SITE"))_"~420.01;^PRC(420,"_(+PRC("SITE"))_",1,;"_PRC("CP")
|
|---|
| 47 | D EDIT^PRC0B(.X,PRCDI,"30///^S X="_$P(PRCC,"^",7),"LS")
|
|---|
| 48 | QUIT
|
|---|
| 49 | ;
|
|---|
| 50 | A421 ;add record in file 421
|
|---|
| 51 | S PRCF("SIFY")=PRC("SITE")_"-"_PRC("FY"),PRCB("QTR")=PRC("QTR")
|
|---|
| 52 | S PRCB("TDT")=$P($$DATE^PRC0C("T","E"),"^",7),PRCB("RNR")="NR"
|
|---|
| 53 | S PRCB("ANAMT")=""
|
|---|
| 54 | D POST^PRCBSTF Q:PRCQT
|
|---|
| 55 | QUIT
|
|---|
