| 1 | PRCBRCP ;WISC@ALTOONA/CTB/DL-RECALCULATE ALL CONTROL POINT BALANCES FOR FISCAL ; 1/29/98 1245
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | N PRCDUZ
|
|---|
| 5 | S PRCDUZ=DUZ
|
|---|
| 6 | I $D(ZTQUEUED) D ALLCP,KILL^%ZTLOAD QUIT
|
|---|
| 7 | D NOW^%DTC S A=$E(X,2,3),B=$E(X,4,5),PRC("FY")=$E(100+$S(+B>9:A+1,1:A),2,3) K A,B,%,%I,X
|
|---|
| 8 | D FY^PRCSUT QUIT:PRC("FY")["^"
|
|---|
| 9 | D EN^DDIOL("Recalculate all stations/control points balances for fiscal year: "_PRC("FY"))
|
|---|
| 10 | D QT^PRCSUT G V:PRC("QTR")["^"
|
|---|
| 11 | D YN^PRC0A(.X,.Y,"Submit RECALCULATE ALL CONTROL POINT BALANCES to the TASK MANAGER","O","YES")
|
|---|
| 12 | QUIT:X["^"!(X="")!(Y<0)
|
|---|
| 13 | I Y=0 D ALLCP^PRCBRCP QUIT
|
|---|
| 14 | S A=$$TASK^PRC0B2("ALLCP^PRCBRCP~RECALCULATE ALL CONTROL POINT BALANCES","PRCDUZ~PRC*",1)
|
|---|
| 15 | I A D EN^DDIOL("RECALCULATE ALL CONTROL POINT BALANCES HAS TASK NUMBER "_$P(A,"^"))
|
|---|
| 16 | QUIT
|
|---|
| 17 | ;
|
|---|
| 18 | MM(PRCA) ;prca free text in the message
|
|---|
| 19 | N X,Y
|
|---|
| 20 | S X(1)="IFCAP RECALCULATE "_PRCA_" CONTROL POINT BALANCES DONE!"
|
|---|
| 21 | S Y(.5)="",Y(PRCDUZ)=""
|
|---|
| 22 | D MM^PRC0B2("IFCAP RECAL "_PRCA_" FCP BALANCES DONE^Task Manager","X(",.Y)
|
|---|
| 23 | QUIT
|
|---|
| 24 | ;
|
|---|
| 25 | ALLCP ;RECALCULATE ALL CONTROL POINTS FOR CURRENT FISCAL YEAR
|
|---|
| 26 | W:'$D(ZTQUEUED) @IOF,"RECALCULATING CONTROL POINT BALANCES",!
|
|---|
| 27 | I $G(PRC("FY"))=""!($G(PRC("QTR"))="") S A=$$DATE^PRC0C(+$H,"H"),PRC("FY")=$E(A,3,4),PRC("QTR")=$P(A,"^",2)
|
|---|
| 28 | STA F PRC("SITE")=0:0 S PRC("SITE")=$O(^PRC(420,PRC("SITE"))) Q:+PRC("SITE")=0 W:'$D(ZTQUEUED) !,PRC("SITE") D CP
|
|---|
| 29 | S X="< Recalculation Completed>*" D:'$D(ZTQUEUED) MSG^PRCFQ
|
|---|
| 30 | D:$D(ZTQUEUED) MM("FY: "_PRC("FY")_" QTR: "_PRC("QTR")_" ALL")
|
|---|
| 31 | K PRC
|
|---|
| 32 | QUIT
|
|---|
| 33 | ;
|
|---|
| 34 | CP F PRC("CPN")=0:0 S PRC("CPN")=$O(^PRC(420,PRC("SITE"),1,PRC("CPN"))),PRC("CP")="" Q:+PRC("CPN")=0!(PRC("CPN")=9999) I $D(^(PRC("CPN"),0)) S PRC("CP")=$P(^(0)," ") Q:PRC("CP")="" W:'$D(ZTQUEUED) " ",+PRC("CP") D QTR
|
|---|
| 35 | Q
|
|---|
| 36 | QTR S N0=PRC("SITE")_"-"_PRC("FY") D CPOBAL^PRCSP1D
|
|---|
| 37 | Q
|
|---|
