source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCB1B.m@ 724

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1PRCB1B ;WISC/PLT-Rollover fund control point balance ; 7/6/98 1000
2V ;;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 ;
6EN ;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)))
11Q1 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
22Q2 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
28Q3 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
32Q4 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
40EXIT QUIT
41 ;
42LKUP ;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 ;
52SYFCP ;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 ;
59MYFCP ;
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 ;
Note: See TracBrowser for help on using the repository browser.