| 1 | PRCBBUL ;WISC@ALTOONA/CTB-BULLETIN FOR FUND DISTRIBUTION ; 07/07/93 2:26 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;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
|
|---|
| 5 | N CP,DA,DIC,DIWF,DIWL,DIWR,I,N,TRDA,UTIL,X,X2,XMDUZ,XMSUB,XMTEXT,XMY,Y
|
|---|
| 6 | S TRDA(0)=^PRCF(421,PRCB("TRDA"),0),TRDA(4)=$S($D(^(4)):^(4),1:""),CP=+$P(TRDA(0),"^",2) Q:CP=9999
|
|---|
| 7 | K UTIL,^UTILITY($J,"W")
|
|---|
| 8 | S UTIL(3,0)="",UTIL(4,0)="The following funding transaction has been released:",UTIL(5,0)=" "
|
|---|
| 9 | S UTIL(5.5,0)="Control Point: "_$P(TRDA(0),"^",2)
|
|---|
| 10 | 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)=" "
|
|---|
| 11 | S Y=$P(TRDA(0),"^",6) D DD^%DT S UTIL(6,0)="Transaction #: "_$P(TRDA(0),"^")_" Transaction Date: "_Y
|
|---|
| 12 | S UTIL(8,0)=" ",$P(FILL," ",40)=""
|
|---|
| 13 | 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")
|
|---|
| 14 | S X=$P(TRDA(0),"^",8) D COMMA^%DTC S UTIL(10,0)="2nd Qtr Amt: $"_X
|
|---|
| 15 | 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
|
|---|
| 16 | S X=$P(TRDA(0),"^",10) D COMMA^%DTC S UTIL(12,0)="4th Qtr Amt: $"_X
|
|---|
| 17 | S X=0 F I=7:1:10 S X=X+$P(TRDA(0),"^",I)
|
|---|
| 18 | S UTIL(13,0)=" ___________ "
|
|---|
| 19 | D COMMA^%DTC S UTIL(14,0)=" Total Amt: $"_X
|
|---|
| 20 | S UTIL(15,0)=" "
|
|---|
| 21 | 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))
|
|---|
| 22 | F I=0:0 S I=$O(^UTILITY($J,"W",1,I)) Q:I="" S:$D(^(I,0)) UTIL(I+16,0)=^(0)
|
|---|
| 23 | S PRC("CP")=CP D NAMES
|
|---|
| 24 | S:$D(XMY)<10 XMY(DUZ)="" S XMSUB="Funding Transaction #: "_$P(TRDA(0),"^"),XMDUZ=DUZ,XMTEXT="UTIL(" D ^XMD
|
|---|
| 25 | K DIW,DIWI,DIWT,DIWTC,DIWX,DN,ER,XMKK,XMLOCK,XMQF,XMR,XMT,XMZ,Z Q
|
|---|
| 26 | NAMES ;GENERATES XMY ARRAY FOR MESSAGES TO CONTROL POINT OFFICIALS AND CLERKS. REQUIRES VARIABLES PRC("SITE") AND PRC("CP")
|
|---|
| 27 | N I,TMP,X
|
|---|
| 28 | 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
|
|---|
| 29 | .I $P(X,"^",3)["Y" S TMP(+X)=""
|
|---|
| 30 | .I '$D(TMP),12[$P(X,"^",2),$P(X,"^")]"" S XMY(+X)=""
|
|---|
| 31 | I $D(TMP) K XMY S %X="TMP(",%Y="XMY(" D %XY^%RCR
|
|---|
| 32 | Q
|
|---|
| 33 | COMMIT ;report of committed transactions for 1-n control points
|
|---|
| 34 | ;this report was created for the Coatesville IFCAP testers
|
|---|
| 35 | W !!,"This report will generate a display of committed ",!,"transactions for one or more control points which you select",!!
|
|---|
| 36 | START ;
|
|---|
| 37 | D EN1^PRCSUT Q:Y<0 I '$D(PRC("SITE")) W !,"This site is not entered in IFCAP." Q
|
|---|
| 38 | K ^TMP($J)
|
|---|
| 39 | Q:'$D(PRC("CP"))
|
|---|
| 40 | 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.)",!!
|
|---|
| 41 | D CP^PRCSUT
|
|---|
| 42 | K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS
|
|---|
| 43 | Q:POP I $D(IO("Q")) S ZTRTN="PROCESS^PRCBBUL",ZTDESC="COMMITTED TRANSACTION LISTING",ZTSAVE("PRC*")="" D ^%ZTLOAD D ^%ZISC G START
|
|---|
| 44 | D PROCESS D ^%ZISC G START
|
|---|
| 45 | PROCESS ;
|
|---|
| 46 | S PRCSZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_"0000"
|
|---|
| 47 | S RANGE=$P(PRC("CPP")," ")-1
|
|---|
| 48 | 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
|
|---|
| 49 | S TYPE(0)="",TYPE("O")="OBLIGATION",TYPE("A")="ADJUSTMENT",TYPE("C")="CEILING",TYPE("CA")="CANCELLED"
|
|---|
| 50 | W @IOF
|
|---|
| 51 | F S PRCSZ=$O(^PRCS(410,"B",PRCSZ)) Q:$P(PRCSZ,"-",3)'=QTR I $P(PRCSZ,"-",4)>RANGE,$P(PRCSZ,"-",4)<RANGE1 D
|
|---|
| 52 | .S PRCDA=$O(^PRCS(410,"B",PRCSZ,0)) Q:+PRCDA=0
|
|---|
| 53 | .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
|
|---|
| 54 | .S N=N+1 S ^TMP($J,+$P($G(STR4),"^",2),N)=STRING
|
|---|
| 55 | S N=0 F S N=$O(^TMP($J,N)) Q:N="" D
|
|---|
| 56 | .Q:STOP=U D:IOSL-$Y<8 HOLD1 Q:STOP=U
|
|---|
| 57 | .D:P1=0 HDR1 S Y=N D DD^%DT U IO W !,"DATE COMMITTED: ",?20,Y
|
|---|
| 58 | .S N1=0 F S N1=$O(^TMP($J,N,N1)) Q:N1="" D
|
|---|
| 59 | ..Q:STOP=U D:IOSL-$Y<8 HOLD1 Q:STOP=U
|
|---|
| 60 | ..S STRING=^TMP($J,N,N1),TRANS=$P(STRING,"^"),TYP=$P(STRING,"^",2),COMM=$P(STRING,"^",3),D0=$P(STRING,"^",4)
|
|---|
| 61 | ..D STATUS^PRCSES S STATUS=$E(X,1,30)
|
|---|
| 62 | ..U IO W !,TRANS,?21,TYPE(TYP),?34,$J(COMM,8,2),?50,STATUS
|
|---|
| 63 | I P1=0 U IO W !!,"No transactions were found for this quarter.",!!
|
|---|
| 64 | 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
|
|---|
| 65 | K ^TMP($J) Q
|
|---|
| 66 | HOLD1 ;
|
|---|
| 67 | G HDR1:$D(ZTQUEUED),HDR1:IO'=IO(0)
|
|---|
| 68 | W !,"Press return to continue, uparrow (^) to exit: " R STOP:DTIME S:'$T STOP=U D:STOP'=U HDR1
|
|---|
| 69 | Q
|
|---|
| 70 | HDR1 ;
|
|---|
| 71 | S P1=P1+1
|
|---|
| 72 | U IO W @IOF W "COMMITTED TRANSACTIONS LISTING",?45,RDATE,?70,"PAGE ",P1
|
|---|
| 73 | W !,?34,"COMMITTED",!,?21,"TRANSACTION",?34,"(ESTIMATED)",!,"TRANSACTION NUMBER",?21,"TYPE",?39,"COST",?50,"STATUS"
|
|---|
| 74 | S STOP1=STOP
|
|---|
| 75 | S L="",$P(L,"-",IOM)="-" W !,L S L="" Q
|
|---|
