76 lines
4.8 KiB
Mathematica
76 lines
4.8 KiB
Mathematica
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
|