PRCSP1C ;WISC/SAW-CONTROL POINT ACTIVITY PRINT OPTIONS CON'T ;3-25-91/13:05
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
CCT ;COST CENTER TOTALS
D EN4^PRCSUT G W1:'$D(PRC("SITE")),EXIT:Y<0 W ! S %ZIS="MQ" D ^%ZIS G EXIT:POP I $D(IO("Q")) S ZTRTN="CCT1^PRCSP1C",ZTSAVE("DUZ")="",ZTSAVE("PRC*")="" D ^%ZTLOAD,HOME^%ZIS,EXIT,W2 G CCT
CCT1 K T S (N,Z1)="",(T("T",1),T("T",2),T("T",3),P)=0 F I=1:1 S N=$O(^PRC(420,"A",DUZ,PRC("SITE"),N)) Q:N="" I $O(^(N,0))<3 S (T(N,1),T(N,2),T(N,3))=0 D CCT2
U IO D CCHD S N="" F I=0:1 S N=$O(T(N)) Q:N'>0 S PRC("CP")=$S($D(^PRC(420,PRC("SITE"),1,N,0)):$P(^(0),"^"),1:""),T("T",1)=T("T",1)+T(N,1),T("T",2)=T("T",2)+T(N,2),T("T",3)=T("T",3)+T(N,3) D CCPR I IOSL-$Y<6 D HOLD Q:Z1[U D CCHD
G CCT:Z1[U I 'I W !!,"There are no transactions for this cost center for the station and time frame",!,"you selected."
I IOSL-($Y#IOSL)<6 D HOLD G CCT:Z1[U D CCHD
I I W !!,"TOTALS FOR ALL CONTROL POINTS" S X="",$P(X,"-",29)="" W !,X D CCPR1
I $D(ZTSK) D KILL^%ZTLOAD K ZTSK G EXIT
D W,W2 G CCT
CCT2 S N(1)=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$S($L(N)=1:"00"_N,$L(N)=2:0_N,1:N)
S N(2)="" F J=0:1 S N(2)=$O(^PRCS(410,"AE",N(1),N(2))) Q:N(2)="" I $D(^PRCS(410,N(2),3)),$P($P(^(3),U,3)," ")=$P(PRCS("CC")," "),$D(^PRCS(410,N(2),4)) S X=^(4),T(N,1)=T(N,1)+$P(X,"^"),T(N,2)=T(N,2)+$P(X,"^",3),T(N,3)=T(N,3)+$P(X,"^",8)
K:T(N,1)+T(N,2)+T(N,3)=0 T(N) Q
CCPR W !!,"CONTROL POINT: ",PRC("CP"),! S X="",$P(X,"-",$L(PRC("CP"))+15)="" W X Q
CCPR1 W !,"TOTAL COMMITTED (ESTIMATED) COST: ",$J(T(N,1),9,2),!,"TOTAL OBLIGATED (ACTUAL) COST: ",$J(T(N,2),9,2),!,"TOTAL (BEST ESTIMATE) COST: ",$J(T(N,3),9,2),! Q
CCHD S P=P+1 W @IOF,!!,"COST CENTER TOTALS REPORT",?50 D NOW^%DTC S Y=% D DD^%DT W Y,?73,"PAGE ",P
W !,"STATION ",PRC("SITE"),", ",PRC("QTR")_$S(PRC("QTR")=1:"ST",PRC("QTR")=2:"ND",PRC("QTR")=3:"RD",1:"TH")," QUARTER, FY",PRC("FY")
S L="",$P(L,"-",IOM)="-" W !,L S L=""
W !!,"COST CENTER: ",PRCS("CC") Q
HOLD Q:$D(ZTQUEUED) Q:IO'=IO(0) W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U Q
W1 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
W2 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q
W I '$D(ZTQUEUED),IO'=IO(0) U IO(0) W !!,"Press return to continue: " R X:DTIME
I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC
I (IO=IO(0))!($D(ZTQUEUED)) D ^%ZISC
EXIT K %,%DT,%ZIS,I,J,L,N,P,PRCS,T,X,Y,Z1,ZTRTN,ZTSAVE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSP1C 2553 printed Oct 16, 2024@18:18:52 Page 2
PRCSP1C ;WISC/SAW-CONTROL POINT ACTIVITY PRINT OPTIONS CON'T ;3-25-91/13:05
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
CCT ;COST CENTER TOTALS
+1 DO EN4^PRCSUT
if '$DATA(PRC("SITE"))
GOTO W1
if Y<0
GOTO EXIT
WRITE !
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
SET ZTRTN="CCT1^PRCSP1C"
SET ZTSAVE("DUZ")=""
SET ZTSAVE("PRC*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
DO EXIT
DO W2
GOTO CCT
CCT1 KILL T
SET (N,Z1)=""
SET (T("T",1),T("T",2),T("T",3),P)=0
FOR I=1:1
SET N=$ORDER(^PRC(420,"A",DUZ,PRC("SITE"),N))
if N=""
QUIT
IF $ORDER(^(N,0))<3
SET (T(N,1),T(N,2),T(N,3))=0
DO CCT2
+1 USE IO
DO CCHD
SET N=""
FOR I=0:1
SET N=$ORDER(T(N))
if N'>0
QUIT
SET PRC("CP")=$SELECT($DATA(^PRC(420,PRC("SITE"),1,N,0)):$PIECE(^(0),"^"),1:"")
SET T("T",1)=T("T",1)+T(N,1)
SET T("T",2)=T("T",2)+T(N,2)
SET T("T",3)=T("T",3)+T(N,3)
DO CCPR
IF IOSL-$Y<6
DO HOLD
if Z1[U
QUIT
DO CCHD
+2 if Z1[U
GOTO CCT
IF 'I
WRITE !!,"There are no transactions for this cost center for the station and time frame",!,"you selected."
+3 IF IOSL-($Y#IOSL)<6
DO HOLD
if Z1[U
GOTO CCT
DO CCHD
+4 IF I
WRITE !!,"TOTALS FOR ALL CONTROL POINTS"
SET X=""
SET $PIECE(X,"-",29)=""
WRITE !,X
DO CCPR1
+5 IF $DATA(ZTSK)
DO KILL^%ZTLOAD
KILL ZTSK
GOTO EXIT
+6 DO W
DO W2
GOTO CCT
CCT2 SET N(1)=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$SELECT($LENGTH(N)=1:"00"_N,$LENGTH(N)=2:0_N,1:N)
+1 SET N(2)=""
FOR J=0:1
SET N(2)=$ORDER(^PRCS(410,"AE",N(1),N(2)))
if N(2)=""
QUIT
IF $DATA(^PRCS(410,N(2),3))
IF $PIECE($PIECE(^(3),U,3)," ")=$PIECE(PRCS("CC")," ")
IF $DATA(^PRCS(410,N(2),4))
SET X=^(4)
SET T(N,1)=T(N,1)+$PIECE(X,"^")
SET T(N,2)=T(N,2)+$PIECE(X,"^",3)
SET T(N,3)=T(N,3)+$PIECE(X,"^",8)
+2 if T(N,1)+T(N,2)+T(N,3)=0
KILL T(N)
QUIT
CCPR WRITE !!,"CONTROL POINT: ",PRC("CP"),!
SET X=""
SET $PIECE(X,"-",$LENGTH(PRC("CP"))+15)=""
WRITE X
QUIT
CCPR1 WRITE !,"TOTAL COMMITTED (ESTIMATED) COST: ",$JUSTIFY(T(N,1),9,2),!,"TOTAL OBLIGATED (ACTUAL) COST: ",$JUSTIFY(T(N,2),9,2),!,"TOTAL (BEST ESTIMATE) COST: ",$JUSTIFY(T(N,3),9,2),!
QUIT
CCHD SET P=P+1
WRITE @IOF,!!,"COST CENTER TOTALS REPORT",?50
DO NOW^%DTC
SET Y=%
DO DD^%DT
WRITE Y,?73,"PAGE ",P
+1 WRITE !,"STATION ",PRC("SITE"),", ",PRC("QTR")_$SELECT(PRC("QTR")=1:"ST",PRC("QTR")=2:"ND",PRC("QTR")=3:"RD",1:"TH")," QUARTER, FY",PRC("FY")
+2 SET L=""
SET $PIECE(L,"-",IOM)="-"
WRITE !,L
SET L=""
+3 WRITE !!,"COST CENTER: ",PRCS("CC")
QUIT
HOLD if $DATA(ZTQUEUED)
QUIT
if IO'=IO(0)
QUIT
WRITE !,"Press return to continue, uparrow (^) to exit: "
READ Z1:DTIME
if '$TEST
SET Z1=U
QUIT
W1 WRITE !!,"You are not an authorized control point user.",!,"Contact your control point official."
READ X:5
GOTO EXIT
W2 WRITE !!,"Enter information for another report or an uparrow to return to the menu.",!
QUIT
W IF '$DATA(ZTQUEUED)
IF IO'=IO(0)
USE IO(0)
WRITE !!,"Press return to continue: "
READ X:DTIME
+1 IF (IO'=IO(0))!($DATA(ZTQUEUED))
DO ^%ZISC
+2 IF (IO=IO(0))!($DATA(ZTQUEUED))
DO ^%ZISC
EXIT KILL %,%DT,%ZIS,I,J,L,N,P,PRCS,T,X,Y,Z1,ZTRTN,ZTSAVE
QUIT
