source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCF826.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.2 KB
Line 
1PRCF826 ;WISC/CLH/TEN-826 STATUS OF FUNDS RPT ;5/4/93 9:14 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 S PRCF("X")="ABSQ"
6 D ^PRCFSITE
7 G:'% OUT
8 ;
9D S %ZIS="MQ"
10 D ^%ZIS
11 G:POP OUT
12 I '$D(IO("Q")) D G Q1
13 . U IO
14 . D DQ
15 . U IO(0)
16 . Q
17 ;
18 S ZTSAVE("PRCF*")=""
19 S ZTSAVE("PRCB*")=""
20 S ZTSAVE("PRC*")=""
21 S ZTRTN="DQ^PRCF826"
22 S ZTDESC="826 STATUS OF FUNDS REPORT"
23 S ZTIO=ION
24 D ^%ZTLOAD
25 ;
26Q1 D ^%ZISC
27 K POP
28 Q
29 ;
30DQ D:$D(ZTQUEUED) KILL^%ZTLOAD
31 ;
32 N ZX,OB,OB1,OBCP,OBCP1,TOT,CA,CO,FYC,FYO,DA,CP,SI,FY,QTR,CPB,X,CPN,APS,LINE,PG
33 K ^TMP($J)
34 ;
35 S ZX=""
36 S QTR=PRC("QTR")
37 S FY=PRC("FY")
38 S SI=PRC("SITE")
39 ;
40 D CEIL^PRCS826(SI,FY,QTR,.CA,.CO)
41 ;
42 S TOT=0
43 S TOT(1)=0
44 S TOT(2)=0
45 S TOT(3)=0
46 S CP=0
47 ;
48 F S CP=$O(^PRC(420,PRC("SITE"),1,CP)) Q:('CP) D
49 . I CP<9999 D
50 .. S CPB=$G(^PRC(420,SI,1,CP,4,FY,0)) Q:CPB=""
51 .. S APS=$P($$ACC^PRC0C(SI,CP_"^"_FY_"^"_+$$YEAR^PRC0C(FY)),"^",11)
52 .. S APS=" "_APS
53 .. S CPN=+$P($G(^PRC(420,SI,1,CP,0)),U,1)
54 .. I '$D(^TMP($J,QTR,APS,"9999 GRAND TOTAL")) S ^TMP($J,QTR,APS,"9999 GRAND TOTAL")="0^0^0^0^0"
55 .. I '$D(^TMP($J,QTR,APS,CPN)) S ^TMP($J,QTR,APS,CPN)="0^0^0^0^0"
56 .. I '$D(^TMP($J,"GT")) S ^TMP($J,"GT")="0^0^0^0^0"
57 .. S ^TMP($J,QTR,APS,CPN)=$G(CA($P(CPN," ")))_U_+$P(CPB,U,QTR+1)_U_+$P(CPB,U,QTR+5)
58 .. F I=1:1:3 S TOT(I)=+$P(^TMP($J,QTR,APS,"9999 GRAND TOTAL"),U,I)
59 .. S TOT(1)=TOT(1)+$G(CA($P(CPN," ")))
60 .. S TOT(2)=TOT(2)+$P(CPB,U,QTR+1)
61 .. S TOT(3)=TOT(3)+$P(CPB,U,QTR+5)
62 .. S ^TMP($J,QTR,APS,"9999 GRAND TOTAL")=TOT(1)_U_TOT(2)_U_TOT(3)
63 .. S OB=$G(^TMP($J,QTR,APS,"9999 GRAND TOTAL"))
64 .. S OBCP=$G(^TMP($J,QTR,APS,CPN))
65 .. S OB1=$P(OB,U)-$P(OB,U,3)
66 .. S OBCP1=$P(OBCP,U)-$P(OBCP,U,3)
67 .. S $P(^TMP($J,QTR,APS,"9999 GRAND TOTAL"),U,4)=OB1
68 .. S $P(^TMP($J,QTR,APS,CPN),U,4)=OBCP1
69 .. S OB=$G(^TMP($J,QTR,APS,"9999 GRAND TOTAL"))
70 .. S $P(^TMP($J,QTR,APS,CPN),U,5)=$G(CO($P(CPN," ")))
71 .. S X=^TMP($J,"GT")
72 .. F I=1:1:4 S $P(X,U,I)=$P(X,U,I)+$P(OB,U,I)
73 .. S $P(X,U,5)=$P(X,U,5)+$G(CO($P(CPN," ")))
74 .. S ^TMP($J,"GT")=X
75 .. Q
76 . Q
77 ;
78 S PG=0
79 S LINE=""
80 S $P(LINE,"-",81)=""
81 W:($E(IOST)="C") @IOF
82 D HDR1
83 ;
84 S AP=""
85 S CPN=""
86 ;
87 F S AP=$O(^TMP($J,QTR,AP)) Q:(AP="") D G:(ZX=U) OUT
88 . W !!,"APPROPRIATION: ",AP,!!
89 . F S CPN=$O(^TMP($J,QTR,AP,CPN)) Q:(CPN="") D Q:(ZX=U)
90 .. ;
91 .. ; WRITE APPROPRIATION (9999 GRAND TOTAL) TOTALS.
92 .. ;
93 .. I +CPN=9999 D PAUSE:$Y+5>IOSL Q:(ZX=U) D Q
94 ... W !,"TOTAL:"
95 ... S X=$G(^TMP($J,QTR,AP,CPN))
96 ... W ?21,$J($FN($P(X,U,1),"P,",2),14)
97 ... W ?36,$J($FN($P(X,U,4),"P,",2),14)
98 ... W ?52,$J($FN($P(X,U,3),"P,",2),14)
99 ... W ?66,$J($FN($P(X,U,5),"P,",2),14)
100 ... W !
101 ... Q
102 .. ;
103 .. ; WRITE CONTROL POINT TOTALS.
104 .. ;
105 .. D PAUSE:($Y+5>IOSL) Q:(ZX=U)
106 .. S X=CPN S:X<100 X=$E(1000+X,2,999) W $E(X,1,15)
107 .. I $P($G(^PRC(420,PRC("SITE"),1,+CPN,0)),U,19)=1 W " *" ;MARK DEACTIVATED CONTROL POINT.
108 .. S X=$G(^TMP($J,QTR,AP,CPN))
109 .. W ?21,$J($FN($P(X,U,1),"P,",2),14)
110 .. W ?36,$J($FN($P(X,U,4),"P,",2),14)
111 .. W ?52,$J($FN($P(X,U,3),"P,",2),14)
112 .. W ?66,$J($FN($P(X,U,5),"P,",2),14)
113 .. W !
114 .. ; COMPUTE FYTD OBLIGATION AMOUNT BY APPROPRIATION.
115 .. S $P(^TMP($J,QTR,AP,"9999 GRAND TOTAL"),U,5)=$P(^TMP($J,QTR,AP,"9999 GRAND TOTAL"),U,5)+$G(CO($P(CPN," ")))
116 .. Q
117 ;
118 ; WRITE STATION (SITE) GRAND TOTALS.
119 ;
120 D PAUSE:($Y+5>IOSL) Q:(ZX=U)
121 W !!,"STATION TOTALS: "
122 S X=$G(^TMP($J,"GT"))
123 W ?21,$J($FN($P(X,U,1),"P,",2),14)
124 W ?36,$J($FN($P(X,U,4),"P,",2),14)
125 W ?52,$J($FN($P(X,U,3),"P,",2),14)
126 W ?66,$J($FN($P(X,U,5),"P,",2),14)
127 W:($E(IOST)="P") @IOF
128 ;
129OUT K PRC,PRCF,PRCB,^TMP($J)
130 Q
131 ;
132HDR1 S PG=PG+1
133 W !,"STATUS OF FUNDS - 826 REPORT"
134 W ?40,"STATION NO: ",SI
135 W ?71,"PAGE: ",$J(PG,3)
136 W !!,"* = DEACTIVATED CONTROL POINT"
137 W !!,"FISCAL YEAR: ",FY
138 W !,"QUARTER:",?14,QTR
139 W !!,?54,"UNOBLIGATED"
140 W !,?22,"COST CEILING",?38,"OBLIGATIONS",?58,"BALANCE",?69,"FYTD"
141 W !,"FUND CONTROL POINT",?22,"FOR QTR",?38,"FOR QTR",?58,"FOR QTR",?69,"OBLIGATIONS"
142 W !,LINE
143 Q
144 ;
145HDR W @IOF
146 S PG=PG+1
147 W !,"826 REPORT - STATION NO: ",SI
148 W ?71,"PAGE: ",$J(PG,3)
149 W !,"* = DEACTIVATED CONTROL POINT"
150 W !,LINE,!
151 Q
152 ;
153PAUSE I $E(IOST)="C" D Q:(ZX=U)
154 . S ZX=""
155 . R !,"Press <return> to continue or '^' to quit: ",ZX:DTIME
156 . S:('$T) ZX=U
157 . Q
158 D HDR
159 Q
Note: See TracBrowser for help on using the repository browser.