| 1 | PRCB1B ;WISC/PLT-Rollover fund control point balance ; 7/6/98 1000
|
|---|
| 2 | V ;;5.1;IFCAP;**64,72**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ;invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | EN ;rollover fcp balance
|
|---|
| 7 | N PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,A,B,PRCDES
|
|---|
| 8 | S PRCQCD=1
|
|---|
| 9 | S PRCA=$$DATE^PRC0C("T","E")
|
|---|
| 10 | S PRCA=$$QTRDATE^PRC0D(PRCA-($P(PRCA,"^",2)=1),$E(4123,$P(PRCA,"^",2)))
|
|---|
| 11 | Q1 S PRC("FY")=$E(PRCA,3,4),PRC("QTR")=$P(PRCA,"^",2)
|
|---|
| 12 | S PRCF("X")="ABSFQ" D ^PRCFSITE G:'% EXIT
|
|---|
| 13 | ;check station rollover
|
|---|
| 14 | I $$NP^PRC0B("^PRC(420,"_+PRC("SITE")_",",0,8)=2 D G EXIT
|
|---|
| 15 | . D EN^DDIOL("The rollover 'Transfer Funds to Another FCP' is not allowed for this station.")
|
|---|
| 16 | . QUIT
|
|---|
| 17 | S PRCC=$$QTRDATE^PRC0D(PRC("FY"),PRC("QTR"))
|
|---|
| 18 | S C=$P(PRCC,"^",8),C=$$DATE^PRC0C(C+100,"H"),C=$$QTRDATE^PRC0D(+C,$P(C,"^",2))
|
|---|
| 19 | S B="" F A=$P(C,"^",8):1 S:A-3#7'=6&(A-3#7) B=B+1 Q:B=PRCQCD
|
|---|
| 20 | S PRCB=$$DATE^PRC0C(A-1,"H") ;qtr closed date
|
|---|
| 21 | I $H'>$P(PRCB,"^",8) D EN^DDIOL("Please run this entered year/quarter after "_$P(PRCB,"^",4)_"/"_$P(PRCB,"^",5)_"/"_$P(PRCB,"^",3)) G Q1
|
|---|
| 22 | Q2 S B="O^1:Single Year Appropriation Fund Control Points;2:Multiple Year Appropriation Fund Control Points"
|
|---|
| 23 | K X,Y S Y(1)="^W ""Enter an option number 1 to 2."""
|
|---|
| 24 | D SC^PRC0A(.X,.Y,"Select Number",B,"")
|
|---|
| 25 | S A=Y K X,Y
|
|---|
| 26 | G Q1:A=""!(A["^")
|
|---|
| 27 | S PRCOPT=+A
|
|---|
| 28 | Q3 D FT^PRC0A(.X,.Y,"Description","O^1:60","")
|
|---|
| 29 | G:X["^"!(X="") Q2
|
|---|
| 30 | S PRCDES=X
|
|---|
| 31 | I PRCOPT=1 D SYFCP G Q1
|
|---|
| 32 | Q4 F D EN^DDIOL(" ") D Q:PRCQT=1
|
|---|
| 33 | . S PRCDD=420.01,PRCQT=""
|
|---|
| 34 | . S X("S")="I $P(^(0),""^"",20)=1,'$P(^(0),""^"",19),$P(^(0),""^"",21),$$APP^PRC0C(PRC(""SITE""),PRC(""FY""),+Y)[""_/_"",Y-9999"
|
|---|
| 35 | . S PRCRI(420)=+PRC("SITE")
|
|---|
| 36 | . D LKUP^PRCB1B QUIT:PRCQT
|
|---|
| 37 | . I '$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRCRI(420.01)) D EN^DDIOL(" Beginning budget year required") QUIT
|
|---|
| 38 | . D MYFCP
|
|---|
| 39 | . QUIT
|
|---|
| 40 | EXIT QUIT
|
|---|
| 41 | ;
|
|---|
| 42 | LKUP ;lookup fcp
|
|---|
| 43 | N DA
|
|---|
| 44 | S DA=""
|
|---|
| 45 | S PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,"
|
|---|
| 46 | D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEMOQS","Select Multiple Year Fund Control Point: ")
|
|---|
| 47 | I Y<0!(X="") S PRCQT=1 K X QUIT
|
|---|
| 48 | K X S PRCRI(PRCDD)=+Y
|
|---|
| 49 | S PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,;$"_PRCRI(420.01)
|
|---|
| 50 | QUIT
|
|---|
| 51 | ;
|
|---|
| 52 | SYFCP ;single year fund control point
|
|---|
| 53 | S ZTDES="ROLLOVER FOR SINGLE YEAR FUND CONTROL POINT"
|
|---|
| 54 | S ZTRTN="TMEN^PRCB1B1" F A="PRC*","PRCC","DUZ*" S ZTSAVE(A)=""
|
|---|
| 55 | D ^PRCFQ
|
|---|
| 56 | QUIT
|
|---|
| 57 | ;
|
|---|
| 58 | ;
|
|---|
| 59 | MYFCP ;
|
|---|
| 60 | S PRC("CP")=PRCRI(420.01)
|
|---|
| 61 | S PRCD=$G(^PRC(420,+PRC("SITE"),1,+PRC("CP"),0)) I PRCD]"",$P($G(^(5)),"^",7)<$P(PRCC,"^",7) D
|
|---|
| 62 | . D FCPTRF^PRCB1B1
|
|---|
| 63 | . QUIT
|
|---|
| 64 | QUIT
|
|---|
| 65 | ;
|
|---|
