PRCBRCP ;WISC@ALTOONA/CTB/DL-RECALCULATE ALL CONTROL POINT BALANCES FOR FISCAL ; 1/29/98 1245
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
N PRCDUZ
S PRCDUZ=DUZ
I $D(ZTQUEUED) D ALLCP,KILL^%ZTLOAD QUIT
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
D FY^PRCSUT QUIT:PRC("FY")["^"
D EN^DDIOL("Recalculate all stations/control points balances for fiscal year: "_PRC("FY"))
D QT^PRCSUT G V:PRC("QTR")["^"
D YN^PRC0A(.X,.Y,"Submit RECALCULATE ALL CONTROL POINT BALANCES to the TASK MANAGER","O","YES")
QUIT:X["^"!(X="")!(Y<0)
I Y=0 D ALLCP^PRCBRCP QUIT
S A=$$TASK^PRC0B2("ALLCP^PRCBRCP~RECALCULATE ALL CONTROL POINT BALANCES","PRCDUZ~PRC*",1)
I A D EN^DDIOL("RECALCULATE ALL CONTROL POINT BALANCES HAS TASK NUMBER "_$P(A,"^"))
QUIT
;
MM(PRCA) ;prca free text in the message
N X,Y
S X(1)="IFCAP RECALCULATE "_PRCA_" CONTROL POINT BALANCES DONE!"
S Y(.5)="",Y(PRCDUZ)=""
D MM^PRC0B2("IFCAP RECAL "_PRCA_" FCP BALANCES DONE^Task Manager","X(",.Y)
QUIT
;
ALLCP ;RECALCULATE ALL CONTROL POINTS FOR CURRENT FISCAL YEAR
W:'$D(ZTQUEUED) @IOF,"RECALCULATING CONTROL POINT BALANCES",!
I $G(PRC("FY"))=""!($G(PRC("QTR"))="") S A=$$DATE^PRC0C(+$H,"H"),PRC("FY")=$E(A,3,4),PRC("QTR")=$P(A,"^",2)
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
S X="< Recalculation Completed>*" D:'$D(ZTQUEUED) MSG^PRCFQ
D:$D(ZTQUEUED) MM("FY: "_PRC("FY")_" QTR: "_PRC("QTR")_" ALL")
K PRC
QUIT
;
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
Q
QTR S N0=PRC("SITE")_"-"_PRC("FY") D CPOBAL^PRCSP1D
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCBRCP 1870 printed Oct 16, 2024@18:01:37 Page 2
PRCBRCP ;WISC@ALTOONA/CTB/DL-RECALCULATE ALL CONTROL POINT BALANCES FOR FISCAL ; 1/29/98 1245
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 NEW PRCDUZ
+3 SET PRCDUZ=DUZ
+4 IF $DATA(ZTQUEUED)
DO ALLCP
DO KILL^%ZTLOAD
QUIT
+5 DO NOW^%DTC
SET A=$EXTRACT(X,2,3)
SET B=$EXTRACT(X,4,5)
SET PRC("FY")=$EXTRACT(100+$SELECT(+B>9:A+1,1:A),2,3)
KILL A,B,%,%I,X
+6 DO FY^PRCSUT
if PRC("FY")["^"
QUIT
+7 DO EN^DDIOL("Recalculate all stations/control points balances for fiscal year: "_PRC("FY"))
+8 DO QT^PRCSUT
if PRC("QTR")["^"
GOTO V
+9 DO YN^PRC0A(.X,.Y,"Submit RECALCULATE ALL CONTROL POINT BALANCES to the TASK MANAGER","O","YES")
+10 if X["^"!(X="")!(Y<0)
QUIT
+11 IF Y=0
DO ALLCP^PRCBRCP
QUIT
+12 SET A=$$TASK^PRC0B2("ALLCP^PRCBRCP~RECALCULATE ALL CONTROL POINT BALANCES","PRCDUZ~PRC*",1)
+13 IF A
DO EN^DDIOL("RECALCULATE ALL CONTROL POINT BALANCES HAS TASK NUMBER "_$PIECE(A,"^"))
+14 QUIT
+15 ;
MM(PRCA) ;prca free text in the message
+1 NEW X,Y
+2 SET X(1)="IFCAP RECALCULATE "_PRCA_" CONTROL POINT BALANCES DONE!"
+3 SET Y(.5)=""
SET Y(PRCDUZ)=""
+4 DO MM^PRC0B2("IFCAP RECAL "_PRCA_" FCP BALANCES DONE^Task Manager","X(",.Y)
+5 QUIT
+6 ;
ALLCP ;RECALCULATE ALL CONTROL POINTS FOR CURRENT FISCAL YEAR
+1 if '$DATA(ZTQUEUED)
WRITE @IOF,"RECALCULATING CONTROL POINT BALANCES",!
+2 IF $GET(PRC("FY"))=""!($GET(PRC("QTR"))="")
SET A=$$DATE^PRC0C(+$HOROLOG,"H")
SET PRC("FY")=$EXTRACT(A,3,4)
SET PRC("QTR")=$PIECE(A,"^",2)
STA FOR PRC("SITE")=0:0
SET PRC("SITE")=$ORDER(^PRC(420,PRC("SITE")))
if +PRC("SITE")=0
QUIT
if '$DATA(ZTQUEUED)
WRITE !,PRC("SITE")
DO CP
+1 SET X="< Recalculation Completed>*"
if '$DATA(ZTQUEUED)
DO MSG^PRCFQ
+2 if $DATA(ZTQUEUED)
DO MM("FY: "_PRC("FY")_" QTR: "_PRC("QTR")_" ALL")
+3 KILL PRC
+4 QUIT
+5 ;
CP FOR PRC("CPN")=0:0
SET PRC("CPN")=$ORDER(^PRC(420,PRC("SITE"),1,PRC("CPN")))
SET PRC("CP")=""
if +PRC("CPN")=0!(PRC("CPN")=9999)
QUIT
IF $DATA(^(PRC("CPN"),0))
SET PRC("CP")=$PIECE(^(0)," ")
if PRC("CP")=""
QUIT
if '$DATA(ZTQUEUED)
WRITE " ",+PRC("CP")
DO QTR
+1 QUIT
QTR SET N0=PRC("SITE")_"-"_PRC("FY")
DO CPOBAL^PRCSP1D
+1 QUIT
