| [613] | 1 | PRCBSUT ;WISC@ALTOONA/CTB/SAW-GET STATION INFO ;8/25/00 16:18
|
|---|
| 2 | V ;;5.1;IFCAP;**97**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN1 ;STATION,FY,QUARTER,CONTROL POINT
|
|---|
| 5 | D ^PRCFSITE G:'% EX D QT G:PRC("QTR")="^" EX D CP G:Y<0 EX
|
|---|
| 6 | S %=1,Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_C1,X=$P(Z,"-",1,2)_"-"_C1 G EXIT
|
|---|
| 7 | QT ;SELECT QUARTER
|
|---|
| 8 | D:'$D(DT) DT^DICRW I '$D(PRCSQTT) S:$D(PRC("QTR")) PRCSQTT=PRC("QTR") I '$D(PRCSQTT) S PRCSI=$E(DT,4,5),PRCSQTT=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",PRCSI)
|
|---|
| 9 | W !,"Select QUARTER: ",PRCSQTT,"// " R PRC("QTR"):DTIME S:'$T PRC("QTR")=U S:PRC("QTR")=U %=0 S:PRC("QTR")="" PRC("QTR")=PRCSQTT Q:PRC("QTR")="^" I PRC("QTR")<1!(PRC("QTR")>4)!(PRC("QTR")'?1N) W $C(7) G QT
|
|---|
| 10 | Q
|
|---|
| 11 | CP ;SELECT CONTROL POINT
|
|---|
| 12 | S DIC="^PRC(420,"_PRC("SITE")_",1,",DIC(0)="AEMNQZ",DIC("S")="I $D(^(2))",DIC("A")="Select CONTROL POINT: "
|
|---|
| 13 | I $D(PRCSK) S DIC("S")=$P(DIC("S"),",1",1)_"!($P(^PRC(420,PRC(""SITE""),1,+Y,0),""^"",9)=""Y"")"
|
|---|
| 14 | S:$D(PRC("CP")) DIC("B")=PRC("CP") S D="B^C"
|
|---|
| 15 | D MIX^DIC1 K DIC G:Y<0 EXIT I Y>0 S C=$P(Y(0),"^",1),C1=$P(Y(0)," ",1),PRC("CP")=+Y
|
|---|
| 16 | S C=$P(^PRC(420,PRC("SITE"),1,PRC("CP"),0),"^",1),C1=$P(C," ",1)
|
|---|
| 17 | K DIC,N Q
|
|---|
| 18 | EX S Y=-1,%=0 K PRC("QTR"),PRC("FY"),PRCSI I $D(PRC("CP")) K:PRC("CP")="ALL"!(PRC("CP")="^") PRC("CP")
|
|---|
| 19 | EXIT K PRCSFYT,PRCSI,PRCSK,PRCSQTT Q
|
|---|
