- 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 Dec 13, 2024@02:00:51 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