PRCB0C ;WISC/PLT-utility for fiscal user's station, substation, fy, qtr, fcp, bbfy ;1/3/97 16:28
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
QUIT ;invalid entry
;
SITE ;station prompt
N PRCMDIV,PRCRI
N A,B,C,X,Y,Z,%
D DUZ^PRCFSITE G:'% Q
W ! I '$D(^PRC(411,0)) W "SITE PARAMETERS HAVE NOT YET BEEN ESTABLISHED, NO FURTHER PROCESSING CAN OCCUR",$C(7) G Q
S U="^",B=^PRC(411,0) I +$P(B,U,4)<1 W !,"NO ENTRIES FOUND IN SITE PARAMETER FILE",$C(7) G Q
S:$G(^VA(200,+PRC("PER"),400))]"" PRC("SP")=1
I $P(B,U,4)>1 S PRCMDIV=""
K PRC("FU") I '$G(PRC("SP")) D AFU^PRCFSI1 G:$G(PRC("FU")) EXT1
S PRC("SITE")=$S($O(^PRC(411,"AC","Y",0)):$O(^PRC(411,"AC","Y",0)),1:$O(^PRC(411,0)))
I '$D(PRCMDIV) S PRC("SITE")=$O(^PRC(411,0)),Y=+PRC("SITE")
I $D(PRCMDIV) W ! S DIC("A")="Select STATION NUMBER ('^' TO EXIT): ",DIC("B")=PRC("SITE"),DIC=411,DIC(0)="AEQMZ",DIC("S")="I +Y<1000000" D ^DIC K DIC
G:+Y<1 EXT1
S PRC("SITE")=+Y
K DIC,PRC("SP"),PRC("L"),PRC("I")
QUIT
EXT1 K PRC QUIT
;
SUBSITE ;sub station prompt
I $D(^PRC(411,"UP",+PRC("SITE"))) S DIC="^PRC(411,",DIC(0)="AEQZ",DIC("A")="Select SUBSTATION: ",DIC("S")="I $E($G(^PRC(411,+Y,0)),1,3)=PRC(""SITE"")" D ^DIC I Y>0 S PRC("SST")=+Y
QUIT
;
FY ;fiscal year prompt
D FY^PRCSUT
QUIT
;
QTR ;quarter prompt
D QT^PRCSUT
QUIT
;
FCP ;fund control point
N PRCSC
S PRCSC=4
D CP^PRCSUT1
QUIT
;
BBFY ;bbfy prompt
N A
S A=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"))
QUIT
;
Q K PRC,PRCB QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCB0C 1559 printed Sep 23, 2025@19:36:12 Page 2
PRCB0C ;WISC/PLT-utility for fiscal user's station, substation, fy, qtr, fcp, bbfy ;1/3/97 16:28
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 ;
SITE ;station prompt
+1 NEW PRCMDIV,PRCRI
+2 NEW A,B,C,X,Y,Z,%
+3 DO DUZ^PRCFSITE
if '%
GOTO Q
+4 WRITE !
IF '$DATA(^PRC(411,0))
WRITE "SITE PARAMETERS HAVE NOT YET BEEN ESTABLISHED, NO FURTHER PROCESSING CAN OCCUR",$CHAR(7)
GOTO Q
+5 SET U="^"
SET B=^PRC(411,0)
IF +$PIECE(B,U,4)<1
WRITE !,"NO ENTRIES FOUND IN SITE PARAMETER FILE",$CHAR(7)
GOTO Q
+6 if $GET(^VA(200,+PRC("PER"),400))]""
SET PRC("SP")=1
+7 IF $PIECE(B,U,4)>1
SET PRCMDIV=""
+8 KILL PRC("FU")
IF '$GET(PRC("SP"))
DO AFU^PRCFSI1
if $GET(PRC("FU"))
GOTO EXT1
+9 SET PRC("SITE")=$SELECT($ORDER(^PRC(411,"AC","Y",0)):$ORDER(^PRC(411,"AC","Y",0)),1:$ORDER(^PRC(411,0)))
+10 IF '$DATA(PRCMDIV)
SET PRC("SITE")=$ORDER(^PRC(411,0))
SET Y=+PRC("SITE")
+11 IF $DATA(PRCMDIV)
WRITE !
SET DIC("A")="Select STATION NUMBER ('^' TO EXIT): "
SET DIC("B")=PRC("SITE")
SET DIC=411
SET DIC(0)="AEQMZ"
SET DIC("S")="I +Y<1000000"
DO ^DIC
KILL DIC
+12 if +Y<1
GOTO EXT1
+13 SET PRC("SITE")=+Y
+14 KILL DIC,PRC("SP"),PRC("L"),PRC("I")
+15 QUIT
EXT1 KILL PRC
QUIT
+1 ;
SUBSITE ;sub station prompt
+1 IF $DATA(^PRC(411,"UP",+PRC("SITE")))
SET DIC="^PRC(411,"
SET DIC(0)="AEQZ"
SET DIC("A")="Select SUBSTATION: "
SET DIC("S")="I $E($G(^PRC(411,+Y,0)),1,3)=PRC(""SITE"")"
DO ^DIC
IF Y>0
SET PRC("SST")=+Y
+2 QUIT
+3 ;
FY ;fiscal year prompt
+1 DO FY^PRCSUT
+2 QUIT
+3 ;
QTR ;quarter prompt
+1 DO QT^PRCSUT
+2 QUIT
+3 ;
FCP ;fund control point
+1 NEW PRCSC
+2 SET PRCSC=4
+3 DO CP^PRCSUT1
+4 QUIT
+5 ;
BBFY ;bbfy prompt
+1 NEW A
+2 SET A=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"))
+3 QUIT
+4 ;
Q KILL PRC,PRCB
QUIT
