source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBBUL.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1PRCBBUL ;WISC@ALTOONA/CTB-BULLETIN FOR FUND DISTRIBUTION ; 07/07/93 2:26 PM
2V ;;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
26NAMES ;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
33COMMIT ;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",!!
36START ;
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
45PROCESS ;
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
66HOLD1 ;
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
70HDR1 ;
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
Note: See TracBrowser for help on using the repository browser.