- PRCB2B ;WISC/PLT-ENTERED, NOT APPROVED REQUESTS RPT ; 03/01/96 1:27 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUIT ;invalid entry
- ;
- EN0 ;control point entry
- N PRCFCP
- S PRCFCP=1
- EN ;fiscal official entry point
- N PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRC,PRCSST,PRCSTC
- N A,B,C,SI
- Q1 ;station
- S PRCSST=1 D STA^PRCSUT S PRCSTC=SI G:$G(PRC("SITE"))=""!(Y<0)!(PRCSTC<1) EXIT
- S PRCRI(420)=+PRC("SITE")
- G:$G(PRCFCP) Q3
- Q2 S B="O^1:All control points;2:Single control point"
- 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 EXIT:A=""!(A["^")
- S PRCOPT=+A
- I PRCOPT=1 G Q4
- I "1"[PRCOPT G Q4
- Q3 ;select control point
- S PRCDI="420;^PRC(420,;"_PRC("SITE")
- S $P(PRCDI,"~",2)="420.01;"_$P($P(PRCDI,"~"),";",2)_PRCRI(420)_",1,;"
- S X("S")="I ^(0)-9999" S:$G(PRCFCP) X("S")=X("S")_",$P(^(0),""^"",9)=""Y""!($D(^PRC(420,""A"",DUZ,PRC(""SITE""),+Y)))"
- D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQS","Select Fund Control Point: ")
- I Y<0!(X="") S PRCQT="^" G Q2:'$G(PRCFCP),Q1:PRCSTC>1,EXIT
- K X S PRCRI(420.01)=+Y,PRC("CP")=$P($P(Y,"^")," ")
- Q4 ;fiscal year - quarter
- S A=$P($G(^PRC(420,PRC("SITE"),0)),"^",9),A=$$DATE^PRC0C(A,"I")
- S PRCA=$P(A,"^")_"-"_$P(A,"^",2)_"^"_$P(A,"^",7)_"^"_$P(A,"^",8)
- D EN^DDIOL(" "),EN^DDIOL("The oldest OPEN quarter in file is "_$P(PRCA,"^",1)_".")
- S E="O^4:6^K:X'?2N.1""-"".1N&(X'?4N.1""-"".1N)!($P(X,""-"",2)<1)!($P(X,""-"",2)>4) X",Y(1)="Enter a 2 or 4 digit year followed by a '-' and quarter #, like 88-3 or 1988-3"
- D FT^PRC0A(.X,.Y,"For Budget Fiscal Year - Quarter (YY-Q)",E,"")
- I X["^"!(X="")!(Y'?2.4N.1"-".1N) G Q2:'$G(PRCFCP),Q1
- S $P(Y,"-")=+$$YEAR^PRC0C($P(Y,"-"))
- I "1995-1"]Y D EN^DDIOL("Report is not available for any quarters before '95-1'.") G Q4
- S $P(PRCOPT,"^",2)=Y,$P(PRCOPT,"^",3)=PRCRI(420),$P(PRCOPT,"^",4)=$G(PRCRI(420.01))
- Q5 D YN^PRC0A(.X,.Y,"Ready to Print","O","YES")
- I X["^"!(X="")!'Y S PRCOPT=$P(PRCOPT,"^") G Q4
- S A=$P(PRCOPT,"^",2),A=$$QTRDATE^PRC0D(+A,$P(A,"-",2))
- S $P(PRCOPT,"^",5)=$P(A,"^",7)
- S PRC("SITE")=$P(PRCOPT,"^",3),PRCRI(420)=+PRC("SITE"),PRCRI(420.01)=$P(PRCOPT,"^",4),PRC("CP")=""
- I $P(PRCOPT,"^",4) S PRC("CP")=$P($G(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^"),PRCD=$P(PRCOPT,"^",5)_"-"_PRC("SITE")_"-"_$P(PRC("CP")," ")_"-",PRCE=PRCD_"~"
- E S PRCD=$P(PRCOPT,"^",5)_"-"_PRC("SITE")_"-",PRCE=PRCD_"~"
- S L=0,DIC="^PRCS(410,",FLDS=".01,449;""RB QTR DATE"",20;""COMMIT COST""",DHD="IFCAP ENTERED, NOT APPROVED REQUESTS"
- S DIS(0)="I $P(^PRCS(410,D0,0),""^"",12)=""E"""
- S BY(0)="^PRCS(410,""RB"",",L(0)=2,FR(0,1)=PRCD,TO(0,1)=PRCE
- D EN1^DIP
- EXIT QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCB2B 2703 printed Mar 13, 2025@21:05:16 Page 2
- PRCB2B ;WISC/PLT-ENTERED, NOT APPROVED REQUESTS RPT ; 03/01/96 1:27 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;invalid entry
- QUIT
- +3 ;
- EN0 ;control point entry
- +1 NEW PRCFCP
- +2 SET PRCFCP=1
- EN ;fiscal official entry point
- +1 NEW PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRC,PRCSST,PRCSTC
- +2 NEW A,B,C,SI
- Q1 ;station
- +1 SET PRCSST=1
- DO STA^PRCSUT
- SET PRCSTC=SI
- if $GET(PRC("SITE"))=""!(Y<0)!(PRCSTC<1)
- GOTO EXIT
- +2 SET PRCRI(420)=+PRC("SITE")
- +3 if $GET(PRCFCP)
- GOTO Q3
- Q2 SET B="O^1:All control points;2:Single control point"
- +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 EXIT
- +5 SET PRCOPT=+A
- +6 IF PRCOPT=1
- GOTO Q4
- +7 IF "1"[PRCOPT
- GOTO Q4
- Q3 ;select control point
- +1 SET PRCDI="420;^PRC(420,;"_PRC("SITE")
- +2 SET $PIECE(PRCDI,"~",2)="420.01;"_$PIECE($PIECE(PRCDI,"~"),";",2)_PRCRI(420)_",1,;"
- +3 SET X("S")="I ^(0)-9999"
- if $GET(PRCFCP)
- SET X("S")=X("S")_",$P(^(0),""^"",9)=""Y""!($D(^PRC(420,""A"",DUZ,PRC(""SITE""),+Y)))"
- +4 DO LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQS","Select Fund Control Point: ")
- +5 IF Y<0!(X="")
- SET PRCQT="^"
- if '$GET(PRCFCP)
- GOTO Q2
- if PRCSTC>1
- GOTO Q1
- GOTO EXIT
- +6 KILL X
- SET PRCRI(420.01)=+Y
- SET PRC("CP")=$PIECE($PIECE(Y,"^")," ")
- Q4 ;fiscal year - quarter
- +1 SET A=$PIECE($GET(^PRC(420,PRC("SITE"),0)),"^",9)
- SET A=$$DATE^PRC0C(A,"I")
- +2 SET PRCA=$PIECE(A,"^")_"-"_$PIECE(A,"^",2)_"^"_$PIECE(A,"^",7)_"^"_$PIECE(A,"^",8)
- +3 DO EN^DDIOL(" ")
- DO EN^DDIOL("The oldest OPEN quarter in file is "_$PIECE(PRCA,"^",1)_".")
- +4 SET E="O^4:6^K:X'?2N.1""-"".1N&(X'?4N.1""-"".1N)!($P(X,""-"",2)<1)!($P(X,""-"",2)>4) X"
- SET Y(1)="Enter a 2 or 4 digit year followed by a '-' and quarter #, like 88-3 or 1988-3"
- +5 DO FT^PRC0A(.X,.Y,"For Budget Fiscal Year - Quarter (YY-Q)",E,"")
- +6 IF X["^"!(X="")!(Y'?2.4N.1"-".1N)
- if '$GET(PRCFCP)
- GOTO Q2
- GOTO Q1
- +7 SET $PIECE(Y,"-")=+$$YEAR^PRC0C($PIECE(Y,"-"))
- +8 IF "1995-1"]Y
- DO EN^DDIOL("Report is not available for any quarters before '95-1'.")
- GOTO Q4
- +9 SET $PIECE(PRCOPT,"^",2)=Y
- SET $PIECE(PRCOPT,"^",3)=PRCRI(420)
- SET $PIECE(PRCOPT,"^",4)=$GET(PRCRI(420.01))
- Q5 DO YN^PRC0A(.X,.Y,"Ready to Print","O","YES")
- +1 IF X["^"!(X="")!'Y
- SET PRCOPT=$PIECE(PRCOPT,"^")
- GOTO Q4
- +2 SET A=$PIECE(PRCOPT,"^",2)
- SET A=$$QTRDATE^PRC0D(+A,$PIECE(A,"-",2))
- +3 SET $PIECE(PRCOPT,"^",5)=$PIECE(A,"^",7)
- +4 SET PRC("SITE")=$PIECE(PRCOPT,"^",3)
- SET PRCRI(420)=+PRC("SITE")
- SET PRCRI(420.01)=$PIECE(PRCOPT,"^",4)
- SET PRC("CP")=""
- +5 IF $PIECE(PRCOPT,"^",4)
- SET PRC("CP")=$PIECE($GET(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^")
- SET PRCD=$PIECE(PRCOPT,"^",5)_"-"_PRC("SITE")_"-"_$PIECE(PRC("CP")," ")_"-"
- SET PRCE=PRCD_"~"
- +6 IF '$TEST
- SET PRCD=$PIECE(PRCOPT,"^",5)_"-"_PRC("SITE")_"-"
- SET PRCE=PRCD_"~"
- +7 SET L=0
- SET DIC="^PRCS(410,"
- SET FLDS=".01,449;""RB QTR DATE"",20;""COMMIT COST"""
- SET DHD="IFCAP ENTERED, NOT APPROVED REQUESTS"
- +8 SET DIS(0)="I $P(^PRCS(410,D0,0),""^"",12)=""E"""
- +9 SET BY(0)="^PRCS(410,""RB"","
- SET L(0)=2
- SET FR(0,1)=PRCD
- SET TO(0,1)=PRCE
- +10 DO EN1^DIP
- EXIT QUIT
