- PRCB1B ;WISC/PLT-Rollover fund control point balance ; 7/6/98 1000
- V ;;5.1;IFCAP;**64,72**;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUIT ;invalid entry
- ;
- EN ;rollover fcp balance
- N PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,A,B,PRCDES
- S PRCQCD=1
- S PRCA=$$DATE^PRC0C("T","E")
- S PRCA=$$QTRDATE^PRC0D(PRCA-($P(PRCA,"^",2)=1),$E(4123,$P(PRCA,"^",2)))
- Q1 S PRC("FY")=$E(PRCA,3,4),PRC("QTR")=$P(PRCA,"^",2)
- S PRCF("X")="ABSFQ" D ^PRCFSITE G:'% EXIT
- ;check station rollover
- I $$NP^PRC0B("^PRC(420,"_+PRC("SITE")_",",0,8)=2 D G EXIT
- . D EN^DDIOL("The rollover 'Transfer Funds to Another FCP' is not allowed for this station.")
- . QUIT
- S PRCC=$$QTRDATE^PRC0D(PRC("FY"),PRC("QTR"))
- S C=$P(PRCC,"^",8),C=$$DATE^PRC0C(C+100,"H"),C=$$QTRDATE^PRC0D(+C,$P(C,"^",2))
- S B="" F A=$P(C,"^",8):1 S:A-3#7'=6&(A-3#7) B=B+1 Q:B=PRCQCD
- S PRCB=$$DATE^PRC0C(A-1,"H") ;qtr closed date
- 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
- Q2 S B="O^1:Single Year Appropriation Fund Control Points;2:Multiple Year Appropriation Fund Control Points"
- K X,Y S Y(1)="^W ""Enter an option number 1 to 2."""
- D SC^PRC0A(.X,.Y,"Select Number",B,"")
- S A=Y K X,Y
- G Q1:A=""!(A["^")
- S PRCOPT=+A
- Q3 D FT^PRC0A(.X,.Y,"Description","O^1:60","")
- G:X["^"!(X="") Q2
- S PRCDES=X
- I PRCOPT=1 D SYFCP G Q1
- Q4 F D EN^DDIOL(" ") D Q:PRCQT=1
- . S PRCDD=420.01,PRCQT=""
- . S X("S")="I $P(^(0),""^"",20)=1,'$P(^(0),""^"",19),$P(^(0),""^"",21),$$APP^PRC0C(PRC(""SITE""),PRC(""FY""),+Y)[""_/_"",Y-9999"
- . S PRCRI(420)=+PRC("SITE")
- . D LKUP^PRCB1B QUIT:PRCQT
- . I '$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRCRI(420.01)) D EN^DDIOL(" Beginning budget year required") QUIT
- . D MYFCP
- . QUIT
- EXIT QUIT
- ;
- LKUP ;lookup fcp
- N DA
- S DA=""
- S PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,"
- D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEMOQS","Select Multiple Year Fund Control Point: ")
- I Y<0!(X="") S PRCQT=1 K X QUIT
- K X S PRCRI(PRCDD)=+Y
- S PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,;$"_PRCRI(420.01)
- QUIT
- ;
- SYFCP ;single year fund control point
- S ZTDES="ROLLOVER FOR SINGLE YEAR FUND CONTROL POINT"
- S ZTRTN="TMEN^PRCB1B1" F A="PRC*","PRCC","DUZ*" S ZTSAVE(A)=""
- D ^PRCFQ
- QUIT
- ;
- ;
- MYFCP ;
- S PRC("CP")=PRCRI(420.01)
- S PRCD=$G(^PRC(420,+PRC("SITE"),1,+PRC("CP"),0)) I PRCD]"",$P($G(^(5)),"^",7)<$P(PRCC,"^",7) D
- . D FCPTRF^PRCB1B1
- . QUIT
- QUIT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCB1B 2542 printed Mar 13, 2025@21:05:03 Page 2
- PRCB1B ;WISC/PLT-Rollover fund control point balance ; 7/6/98 1000
- V ;;5.1;IFCAP;**64,72**;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;invalid entry
- QUIT
- +3 ;
- EN ;rollover fcp balance
- +1 NEW PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,A,B,PRCDES
- +2 SET PRCQCD=1
- +3 SET PRCA=$$DATE^PRC0C("T","E")
- +4 SET PRCA=$$QTRDATE^PRC0D(PRCA-($PIECE(PRCA,"^",2)=1),$EXTRACT(4123,$PIECE(PRCA,"^",2)))
- Q1 SET PRC("FY")=$EXTRACT(PRCA,3,4)
- SET PRC("QTR")=$PIECE(PRCA,"^",2)
- +1 SET PRCF("X")="ABSFQ"
- DO ^PRCFSITE
- if '%
- GOTO EXIT
- +2 ;check station rollover
- +3 IF $$NP^PRC0B("^PRC(420,"_+PRC("SITE")_",",0,8)=2
- Begin DoDot:1
- +4 DO EN^DDIOL("The rollover 'Transfer Funds to Another FCP' is not allowed for this station.")
- +5 QUIT
- End DoDot:1
- GOTO EXIT
- +6 SET PRCC=$$QTRDATE^PRC0D(PRC("FY"),PRC("QTR"))
- +7 SET C=$PIECE(PRCC,"^",8)
- SET C=$$DATE^PRC0C(C+100,"H")
- SET C=$$QTRDATE^PRC0D(+C,$PIECE(C,"^",2))
- +8 SET B=""
- FOR A=$PIECE(C,"^",8):1
- if A-3#7'=6&(A-3#7)
- SET B=B+1
- if B=PRCQCD
- QUIT
- +9 ;qtr closed date
- SET PRCB=$$DATE^PRC0C(A-1,"H")
- +10 IF $HOROLOG'>$PIECE(PRCB,"^",8)
- DO EN^DDIOL("Please run this entered year/quarter after "_$PIECE(PRCB,"^",4)_"/"_$PIECE(PRCB,"^",5)_"/"_$PIECE(PRCB,"^",3))
- GOTO Q1
- Q2 SET B="O^1:Single Year Appropriation Fund Control Points;2:Multiple Year Appropriation Fund Control Points"
- +1 KILL X,Y
- SET Y(1)="^W ""Enter an option number 1 to 2."""
- +2 DO SC^PRC0A(.X,.Y,"Select Number",B,"")
- +3 SET A=Y
- KILL X,Y
- +4 if A=""!(A["^")
- GOTO Q1
- +5 SET PRCOPT=+A
- Q3 DO FT^PRC0A(.X,.Y,"Description","O^1:60","")
- +1 if X["^"!(X="")
- GOTO Q2
- +2 SET PRCDES=X
- +3 IF PRCOPT=1
- DO SYFCP
- GOTO Q1
- Q4 FOR
- DO EN^DDIOL(" ")
- Begin DoDot:1
- +1 SET PRCDD=420.01
- SET PRCQT=""
- +2 SET X("S")="I $P(^(0),""^"",20)=1,'$P(^(0),""^"",19),$P(^(0),""^"",21),$$APP^PRC0C(PRC(""SITE""),PRC(""FY""),+Y)[""_/_"",Y-9999"
- +3 SET PRCRI(420)=+PRC("SITE")
- +4 DO LKUP^PRCB1B
- if PRCQT
- QUIT
- +5 IF '$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRCRI(420.01))
- DO EN^DDIOL(" Beginning budget year required")
- QUIT
- +6 DO MYFCP
- +7 QUIT
- End DoDot:1
- if PRCQT=1
- QUIT
- EXIT QUIT
- +1 ;
- LKUP ;lookup fcp
- +1 NEW DA
- +2 SET DA=""
- +3 SET PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,"
- +4 DO LOOKUP^PRC0B(.X,.Y,PRCDI,"AEMOQS","Select Multiple Year Fund Control Point: ")
- +5 IF Y<0!(X="")
- SET PRCQT=1
- KILL X
- QUIT
- +6 KILL X
- SET PRCRI(PRCDD)=+Y
- +7 SET PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,;$"_PRCRI(420.01)
- +8 QUIT
- +9 ;
- SYFCP ;single year fund control point
- +1 SET ZTDES="ROLLOVER FOR SINGLE YEAR FUND CONTROL POINT"
- +2 SET ZTRTN="TMEN^PRCB1B1"
- FOR A="PRC*","PRCC","DUZ*"
- SET ZTSAVE(A)=""
- +3 DO ^PRCFQ
- +4 QUIT
- +5 ;
- +6 ;
- MYFCP ;
- +1 SET PRC("CP")=PRCRI(420.01)
- +2 SET PRCD=$GET(^PRC(420,+PRC("SITE"),1,+PRC("CP"),0))
- IF PRCD]""
- IF $PIECE($GET(^(5)),"^",7)<$PIECE(PRCC,"^",7)
- Begin DoDot:1
- +3 DO FCPTRF^PRCB1B1
- +4 QUIT
- End DoDot:1
- +5 QUIT
- +6 ;
