PRCBBUL ;WISC@ALTOONA/CTB-BULLETIN FOR FUND DISTRIBUTION ; 07/07/93 2:26 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;CREATES A BULLETIN FOR TRANSACTION NUMBER (PRCB("TRDA") AND FORWARDS IT TO ALL USERS WHO ARE IDENTIFIED AS CONTROL POINT OFFICIALS OR CONTROL POINT CLERKS
N CP,DA,DIC,DIWF,DIWL,DIWR,I,N,TRDA,UTIL,X,X2,XMDUZ,XMSUB,XMTEXT,XMY,Y
S TRDA(0)=^PRCF(421,PRCB("TRDA"),0),TRDA(4)=$S($D(^(4)):^(4),1:""),CP=+$P(TRDA(0),"^",2) Q:CP=9999
K UTIL,^UTILITY($J,"W")
S UTIL(3,0)="",UTIL(4,0)="The following funding transaction has been released:",UTIL(5,0)=" "
S UTIL(5.5,0)="Control Point: "_$P(TRDA(0),"^",2)
I $P(TRDA(0),"^",4)]"" S Y=$P(TRDA(0),"^",5) D DD^%DT S UTIL(5.6,0)="TDA #: "_$P(TRDA(0),"^",4),$P(UTIL(5.6,0)," ",40)="TDA DATE: "_Y,UTIL(5.7,0)=" "
S Y=$P(TRDA(0),"^",6) D DD^%DT S UTIL(6,0)="Transaction #: "_$P(TRDA(0),"^")_" Transaction Date: "_Y
S UTIL(8,0)=" ",$P(FILL," ",40)=""
S X=$P(TRDA(0),"^",7) D COMMA^%DTC S UTIL(9,0)="1st Qtr Amt: $"_X,UTIL(9,0)=UTIL(9,0)_$P(FILL," ",$L(UTIL(9,0)),40)_"Type: "_$S($P(TRDA(4),"^",6)="R":"Recurring",1:"Non-Recurring")
S X=$P(TRDA(0),"^",8) D COMMA^%DTC S UTIL(10,0)="2nd Qtr Amt: $"_X
S X=$P(TRDA(0),"^",9) D COMMA^%DTC S UTIL(11,0)="3rd Qtr Amt: $"_X S X=$P(TRDA(4),"^",5) I X'=0 D COMMA^%DTC S UTIL(11,0)=UTIL(11,0)_$P(FILL," ",$L(UTIL(11,0)),40)_"Annualization: $"_X
S X=$P(TRDA(0),"^",10) D COMMA^%DTC S UTIL(12,0)="4th Qtr Amt: $"_X
S X=0 F I=7:1:10 S X=X+$P(TRDA(0),"^",I)
S UTIL(13,0)=" ___________ "
D COMMA^%DTC S UTIL(14,0)=" Total Amt: $"_X
S UTIL(15,0)=" "
S X="DESCRIPTION: ",N=0,DIWL=1,DIWF="I5",DIWR=70 D DIWP^PRCUTL($G(DA)) F I=1:1 S N=$O(^PRCF(421,PRCB("TRDA"),1,N)) Q:N="" S X=^(N,0) D DIWP^PRCUTL($G(DA))
F I=0:0 S I=$O(^UTILITY($J,"W",1,I)) Q:I="" S:$D(^(I,0)) UTIL(I+16,0)=^(0)
S PRC("CP")=CP D NAMES
S:$D(XMY)<10 XMY(DUZ)="" S XMSUB="Funding Transaction #: "_$P(TRDA(0),"^"),XMDUZ=DUZ,XMTEXT="UTIL(" D ^XMD
K DIW,DIWI,DIWT,DIWTC,DIWX,DN,ER,XMKK,XMLOCK,XMQF,XMR,XMT,XMZ,Z Q
NAMES ;GENERATES XMY ARRAY FOR MESSAGES TO CONTROL POINT OFFICIALS AND CLERKS. REQUIRES VARIABLES PRC("SITE") AND PRC("CP")
N I,TMP,X
K XMY F I=0:0 S I=$O(^PRC(420,+PRC("SITE"),1,+PRC("CP"),1,I)) Q:'I I $D(^(I,0)) S X=^(0) D
.I $P(X,"^",3)["Y" S TMP(+X)=""
.I '$D(TMP),12[$P(X,"^",2),$P(X,"^")]"" S XMY(+X)=""
I $D(TMP) K XMY S %X="TMP(",%Y="XMY(" D %XY^%RCR
Q
COMMIT ;report of committed transactions for 1-n control points
;this report was created for the Coatesville IFCAP testers
W !!,"This report will generate a display of committed ",!,"transactions for one or more control points which you select",!!
START ;
D EN1^PRCSUT Q:Y<0 I '$D(PRC("SITE")) W !,"This site is not entered in IFCAP." Q
K ^TMP($J)
Q:'$D(PRC("CP"))
S PRC("CPP")=PRC("CP") W !!,"Enter control point at end of range.",!,"(For a range of 1-n, enter n. For one control point, enter that control point.)",!!
D CP^PRCSUT
K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS
Q:POP I $D(IO("Q")) S ZTRTN="PROCESS^PRCBBUL",ZTDESC="COMMITTED TRANSACTION LISTING",ZTSAVE("PRC*")="" D ^%ZTLOAD D ^%ZISC G START
D PROCESS D ^%ZISC G START
PROCESS ;
S PRCSZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_"0000"
S RANGE=$P(PRC("CPP")," ")-1
S N=0,STOP=0,P1=0,QTR=PRC("QTR"),RANGE1=PRC("CP")+1 D NOW^%DTC S Y=% D DD^%DT S RDATE=Y
S TYPE(0)="",TYPE("O")="OBLIGATION",TYPE("A")="ADJUSTMENT",TYPE("C")="CEILING",TYPE("CA")="CANCELLED"
W @IOF
F S PRCSZ=$O(^PRCS(410,"B",PRCSZ)) Q:$P(PRCSZ,"-",3)'=QTR I $P(PRCSZ,"-",4)>RANGE,$P(PRCSZ,"-",4)<RANGE1 D
.S PRCDA=$O(^PRCS(410,"B",PRCSZ,0)) Q:+PRCDA=0
.S STR=$G(^PRCS(410,PRCDA,0)),STR4=$G(^PRCS(410,PRCDA,4)),STRING=$P($G(STR),"^")_"^"_$P($G(STR),"^",2)_"^"_$P($G(STR4),"^")_"^"_PRCDA
.S N=N+1 S ^TMP($J,+$P($G(STR4),"^",2),N)=STRING
S N=0 F S N=$O(^TMP($J,N)) Q:N="" D
.Q:STOP=U D:IOSL-$Y<8 HOLD1 Q:STOP=U
.D:P1=0 HDR1 S Y=N D DD^%DT U IO W !,"DATE COMMITTED: ",?20,Y
.S N1=0 F S N1=$O(^TMP($J,N,N1)) Q:N1="" D
..Q:STOP=U D:IOSL-$Y<8 HOLD1 Q:STOP=U
..S STRING=^TMP($J,N,N1),TRANS=$P(STRING,"^"),TYP=$P(STRING,"^",2),COMM=$P(STRING,"^",3),D0=$P(STRING,"^",4)
..D STATUS^PRCSES S STATUS=$E(X,1,30)
..U IO W !,TRANS,?21,TYPE(TYP),?34,$J(COMM,8,2),?50,STATUS
I P1=0 U IO W !!,"No transactions were found for this quarter.",!!
U IO(0) W !!,"End of report" K X,RDATE,Y,%,L,P1,STOP,TYPE,PRCDA,STRING,COMM,STATUS,D0,PRCSZ,PRC("CPP"),RANGE,RANGE1,QTR,STR,STR4,N,N1,TRANS,TYP
K ^TMP($J) Q
HOLD1 ;
G HDR1:$D(ZTQUEUED),HDR1:IO'=IO(0)
W !,"Press return to continue, uparrow (^) to exit: " R STOP:DTIME S:'$T STOP=U D:STOP'=U HDR1
Q
HDR1 ;
S P1=P1+1
U IO W @IOF W "COMMITTED TRANSACTIONS LISTING",?45,RDATE,?70,"PAGE ",P1
W !,?34,"COMMITTED",!,?21,"TRANSACTION",?34,"(ESTIMATED)",!,"TRANSACTION NUMBER",?21,"TYPE",?39,"COST",?50,"STATUS"
S STOP1=STOP
S L="",$P(L,"-",IOM)="-" W !,L S L="" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCBBUL 4960 printed Sep 23, 2025@19:36:38 Page 2
PRCBBUL ;WISC@ALTOONA/CTB-BULLETIN FOR FUND DISTRIBUTION ; 07/07/93 2:26 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;CREATES A BULLETIN FOR TRANSACTION NUMBER (PRCB("TRDA") AND FORWARDS IT TO ALL USERS WHO ARE IDENTIFIED AS CONTROL POINT OFFICIALS OR CONTROL POINT CLERKS
+3 NEW CP,DA,DIC,DIWF,DIWL,DIWR,I,N,TRDA,UTIL,X,X2,XMDUZ,XMSUB,XMTEXT,XMY,Y
+4 SET TRDA(0)=^PRCF(421,PRCB("TRDA"),0)
SET TRDA(4)=$SELECT($DATA(^(4)):^(4),1:"")
SET CP=+$PIECE(TRDA(0),"^",2)
if CP=9999
QUIT
+5 KILL UTIL,^UTILITY($JOB,"W")
+6 SET UTIL(3,0)=""
SET UTIL(4,0)="The following funding transaction has been released:"
SET UTIL(5,0)=" "
+7 SET UTIL(5.5,0)="Control Point: "_$PIECE(TRDA(0),"^",2)
+8 IF $PIECE(TRDA(0),"^",4)]""
SET Y=$PIECE(TRDA(0),"^",5)
DO DD^%DT
SET UTIL(5.6,0)="TDA #: "_$PIECE(TRDA(0),"^",4)
SET $PIECE(UTIL(5.6,0)," ",40)="TDA DATE: "_Y
SET UTIL(5.7,0)=" "
+9 SET Y=$PIECE(TRDA(0),"^",6)
DO DD^%DT
SET UTIL(6,0)="Transaction #: "_$PIECE(TRDA(0),"^")_" Transaction Date: "_Y
+10 SET UTIL(8,0)=" "
SET $PIECE(FILL," ",40)=""
+11 SET X=$PIECE(TRDA(0),"^",7)
DO COMMA^%DTC
SET UTIL(9,0)="1st Qtr Amt: $"_X
SET UTIL(9,0)=UTIL(9,0)_$PIECE(FILL," ",$LENGTH(UTIL(9,0)),40)_"Type: "_$SELECT($PIECE(TRDA(4),"^",6)="R":"Recurring",1:"Non-Recurring")
+12 SET X=$PIECE(TRDA(0),"^",8)
DO COMMA^%DTC
SET UTIL(10,0)="2nd Qtr Amt: $"_X
+13 SET X=$PIECE(TRDA(0),"^",9)
DO COMMA^%DTC
SET UTIL(11,0)="3rd Qtr Amt: $"_X
SET X=$PIECE(TRDA(4),"^",5)
IF X'=0
DO COMMA^%DTC
SET UTIL(11,0)=UTIL(11,0)_$PIECE(FILL," ",$LENGTH(UTIL(11,0)),40)_"Annualization: $"_X
+14 SET X=$PIECE(TRDA(0),"^",10)
DO COMMA^%DTC
SET UTIL(12,0)="4th Qtr Amt: $"_X
+15 SET X=0
FOR I=7:1:10
SET X=X+$PIECE(TRDA(0),"^",I)
+16 SET UTIL(13,0)=" ___________ "
+17 DO COMMA^%DTC
SET UTIL(14,0)=" Total Amt: $"_X
+18 SET UTIL(15,0)=" "
+19 SET X="DESCRIPTION: "
SET N=0
SET DIWL=1
SET DIWF="I5"
SET DIWR=70
DO DIWP^PRCUTL($GET(DA))
FOR I=1:1
SET N=$ORDER(^PRCF(421,PRCB("TRDA"),1,N))
if N=""
QUIT
SET X=^(N,0)
DO DIWP^PRCUTL($GET(DA))
+20 FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,"W",1,I))
if I=""
QUIT
if $DATA(^(I,0))
SET UTIL(I+16,0)=^(0)
+21 SET PRC("CP")=CP
DO NAMES
+22 if $DATA(XMY)<10
SET XMY(DUZ)=""
SET XMSUB="Funding Transaction #: "_$PIECE(TRDA(0),"^")
SET XMDUZ=DUZ
SET XMTEXT="UTIL("
DO ^XMD
+23 KILL DIW,DIWI,DIWT,DIWTC,DIWX,DN,ER,XMKK,XMLOCK,XMQF,XMR,XMT,XMZ,Z
QUIT
NAMES ;GENERATES XMY ARRAY FOR MESSAGES TO CONTROL POINT OFFICIALS AND CLERKS. REQUIRES VARIABLES PRC("SITE") AND PRC("CP")
+1 NEW I,TMP,X
+2 KILL XMY
FOR I=0:0
SET I=$ORDER(^PRC(420,+PRC("SITE"),1,+PRC("CP"),1,I))
if 'I
QUIT
IF $DATA(^(I,0))
SET X=^(0)
Begin DoDot:1
+3 IF $PIECE(X,"^",3)["Y"
SET TMP(+X)=""
+4 IF '$DATA(TMP)
IF 12[$PIECE(X,"^",2)
IF $PIECE(X,"^")]""
SET XMY(+X)=""
End DoDot:1
+5 IF $DATA(TMP)
KILL XMY
SET %X="TMP("
SET %Y="XMY("
DO %XY^%RCR
+6 QUIT
COMMIT ;report of committed transactions for 1-n control points
+1 ;this report was created for the Coatesville IFCAP testers
+2 WRITE !!,"This report will generate a display of committed ",!,"transactions for one or more control points which you select",!!
START ;
+1 DO EN1^PRCSUT
if Y<0
QUIT
IF '$DATA(PRC("SITE"))
WRITE !,"This site is not entered in IFCAP."
QUIT
+2 KILL ^TMP($JOB)
+3 if '$DATA(PRC("CP"))
QUIT
+4 SET PRC("CPP")=PRC("CP")
WRITE !!,"Enter control point at end of range.",!,"(For a range of 1-n, enter n. For one control point, enter that control point.)",!!
+5 DO CP^PRCSUT
+6 KILL IO("Q")
SET %ZIS("B")="HOME"
SET %ZIS="MQ"
DO ^%ZIS
+7 if POP
QUIT
IF $DATA(IO("Q"))
SET ZTRTN="PROCESS^PRCBBUL"
SET ZTDESC="COMMITTED TRANSACTION LISTING"
SET ZTSAVE("PRC*")=""
DO ^%ZTLOAD
DO ^%ZISC
GOTO START
+8 DO PROCESS
DO ^%ZISC
GOTO START
PROCESS ;
+1 SET PRCSZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_"0000"
+2 SET RANGE=$PIECE(PRC("CPP")," ")-1
+3 SET N=0
SET STOP=0
SET P1=0
SET QTR=PRC("QTR")
SET RANGE1=PRC("CP")+1
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET RDATE=Y
+4 SET TYPE(0)=""
SET TYPE("O")="OBLIGATION"
SET TYPE("A")="ADJUSTMENT"
SET TYPE("C")="CEILING"
SET TYPE("CA")="CANCELLED"
+5 WRITE @IOF
+6 FOR
SET PRCSZ=$ORDER(^PRCS(410,"B",PRCSZ))
if $PIECE(PRCSZ,"-",3)'=QTR
QUIT
IF $PIECE(PRCSZ,"-",4)>RANGE
IF $PIECE(PRCSZ,"-",4)<RANGE1
Begin DoDot:1
+7 SET PRCDA=$ORDER(^PRCS(410,"B",PRCSZ,0))
if +PRCDA=0
QUIT
+8 SET STR=$GET(^PRCS(410,PRCDA,0))
SET STR4=$GET(^PRCS(410,PRCDA,4))
SET STRING=$PIECE($GET(STR),"^")_"^"_$PIECE($GET(STR),"^",2)_"^"_$PIECE($GET(STR4),"^")_"^"_PRCDA
+9 SET N=N+1
SET ^TMP($JOB,+$PIECE($GET(STR4),"^",2),N)=STRING
End DoDot:1
+10 SET N=0
FOR
SET N=$ORDER(^TMP($JOB,N))
if N=""
QUIT
Begin DoDot:1
+11 if STOP=U
QUIT
if IOSL-$Y<8
DO HOLD1
if STOP=U
QUIT
+12 if P1=0
DO HDR1
SET Y=N
DO DD^%DT
USE IO
WRITE !,"DATE COMMITTED: ",?20,Y
+13 SET N1=0
FOR
SET N1=$ORDER(^TMP($JOB,N,N1))
if N1=""
QUIT
Begin DoDot:2
+14 if STOP=U
QUIT
if IOSL-$Y<8
DO HOLD1
if STOP=U
QUIT
+15 SET STRING=^TMP($JOB,N,N1)
SET TRANS=$PIECE(STRING,"^")
SET TYP=$PIECE(STRING,"^",2)
SET COMM=$PIECE(STRING,"^",3)
SET D0=$PIECE(STRING,"^",4)
+16 DO STATUS^PRCSES
SET STATUS=$EXTRACT(X,1,30)
+17 USE IO
WRITE !,TRANS,?21,TYPE(TYP),?34,$JUSTIFY(COMM,8,2),?50,STATUS
End DoDot:2
End DoDot:1
+18 IF P1=0
USE IO
WRITE !!,"No transactions were found for this quarter.",!!
+19 USE IO(0)
WRITE !!,"End of report"
KILL X,RDATE,Y,%,L,P1,STOP,TYPE,PRCDA,STRING,COMM,STATUS,D0,PRCSZ,PRC("CPP"),RANGE,RANGE1,QTR,STR,STR4,N,N1,TRANS,TYP
+20 KILL ^TMP($JOB)
QUIT
HOLD1 ;
+1 if $DATA(ZTQUEUED)
GOTO HDR1
if IO'=IO(0)
GOTO HDR1
+2 WRITE !,"Press return to continue, uparrow (^) to exit: "
READ STOP:DTIME
if '$TEST
SET STOP=U
if STOP'=U
DO HDR1
+3 QUIT
HDR1 ;
+1 SET P1=P1+1
+2 USE IO
WRITE @IOF
WRITE "COMMITTED TRANSACTIONS LISTING",?45,RDATE,?70,"PAGE ",P1
+3 WRITE !,?34,"COMMITTED",!,?21,"TRANSACTION",?34,"(ESTIMATED)",!,"TRANSACTION NUMBER",?21,"TYPE",?39,"COST",?50,"STATUS"
+4 SET STOP1=STOP
+5 SET L=""
SET $PIECE(L,"-",IOM)="-"
WRITE !,L
SET L=""
QUIT
