| 1 | PRCB0C ;WISC/PLT-utility for fiscal user's station, substation, fy, qtr, fcp, bbfy ;1/3/97  16:28 | 
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000 | 
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | QUIT  ;invalid entry | 
|---|
| 5 | ; | 
|---|
| 6 | SITE ;station prompt | 
|---|
| 7 | N PRCMDIV,PRCRI | 
|---|
| 8 | N A,B,C,X,Y,Z,% | 
|---|
| 9 | D DUZ^PRCFSITE G:'% Q | 
|---|
| 10 | W ! I '$D(^PRC(411,0)) W "SITE PARAMETERS HAVE NOT YET BEEN ESTABLISHED, NO FURTHER PROCESSING CAN OCCUR",$C(7) G Q | 
|---|
| 11 | S U="^",B=^PRC(411,0) I +$P(B,U,4)<1 W !,"NO ENTRIES FOUND IN SITE PARAMETER FILE",$C(7) G Q | 
|---|
| 12 | S:$G(^VA(200,+PRC("PER"),400))]"" PRC("SP")=1 | 
|---|
| 13 | I $P(B,U,4)>1 S PRCMDIV="" | 
|---|
| 14 | K PRC("FU") I '$G(PRC("SP")) D AFU^PRCFSI1 G:$G(PRC("FU")) EXT1 | 
|---|
| 15 | S PRC("SITE")=$S($O(^PRC(411,"AC","Y",0)):$O(^PRC(411,"AC","Y",0)),1:$O(^PRC(411,0))) | 
|---|
| 16 | I '$D(PRCMDIV) S PRC("SITE")=$O(^PRC(411,0)),Y=+PRC("SITE") | 
|---|
| 17 | 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 | 
|---|
| 18 | G:+Y<1 EXT1 | 
|---|
| 19 | S PRC("SITE")=+Y | 
|---|
| 20 | K DIC,PRC("SP"),PRC("L"),PRC("I") | 
|---|
| 21 | QUIT | 
|---|
| 22 | EXT1 K PRC QUIT | 
|---|
| 23 | ; | 
|---|
| 24 | SUBSITE ;sub station prompt | 
|---|
| 25 | 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 | 
|---|
| 26 | QUIT | 
|---|
| 27 | ; | 
|---|
| 28 | FY ;fiscal year prompt | 
|---|
| 29 | D FY^PRCSUT | 
|---|
| 30 | QUIT | 
|---|
| 31 | ; | 
|---|
| 32 | QTR ;quarter prompt | 
|---|
| 33 | D QT^PRCSUT | 
|---|
| 34 | QUIT | 
|---|
| 35 | ; | 
|---|
| 36 | FCP ;fund control point | 
|---|
| 37 | N PRCSC | 
|---|
| 38 | S PRCSC=4 | 
|---|
| 39 | D CP^PRCSUT1 | 
|---|
| 40 | QUIT | 
|---|
| 41 | ; | 
|---|
| 42 | BBFY ;bbfy prompt | 
|---|
| 43 | N A | 
|---|
| 44 | S A=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP")) | 
|---|
| 45 | QUIT | 
|---|
| 46 | ; | 
|---|
| 47 | Q K PRC,PRCB QUIT | 
|---|