source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCS826.m@ 724

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRCS826 ;WISC/CLH/TEN-826 CEILING RPT ;6/29/00 12:22
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4CEIL(SI,FY,QTR,CA,CO) ;
5 N TN,IN,CP
6 ;
7 ; CALCULATE TOTAL CEILING DOLLARS FOR USER SELECTED QUARTER.
8 ;
9 S TN=SI_"-"_FY_"-"_QTR_"-000"
10 ;
11 ; PICK ALL TRANSACTIONS FOR USER SELECTED QUARTER.
12 ;
13 F D Q:'TN!($P(TN,"-",3)'=QTR)
14 . S TN=$O(^PRCS(410,"AE",TN))
15 . Q:('TN)!($P(TN,"-",3)'=QTR)
16 . S CP=+$P(TN,"-",4)
17 . S CA(CP)=0
18 . S IN=0
19 . ; PICK ALL "CEILING" TRANSACTION TYPES WITHIN QTR.
20 . F D Q:'IN
21 .. S IN=$O(^PRCS(410,"AE",TN,IN))
22 .. Q:'IN
23 .. I $D(^PRCS(410,IN,0)),$P(^PRCS(410,IN,0),U,2)="C" S CA(CP)=CA(CP)+$P($G(^PRCS(410,IN,6)),"^") ;"C"=CEILING
24 .. Q
25 . Q
26 ;
27 ; CALCULATE TOTAL USER SELECTED FISCAL YEAR-TO-DATE OBLIGATIONS.
28 ;
29 S TN=SI_"-"_FY_"-1-000"
30 ;
31 ; PICK ALL TRANSACTIONS FOR USER SELECTED FISCAL YEAR.
32 ;
33 F D Q:'TN!($P(TN,"-",2)'=FY)
34 . S TN=$O(^PRCS(410,"AE",TN))
35 . Q:('TN)!($P(TN,"-",2)'=FY)
36 . S CP=+$P(TN,"-",4)
37 . I '$D(CO(CP)) S CO(CP)=0
38 . S IN=0
39 . ; PICK ALL "OBLIGATION" TRANSACTION TYPES WITHIN FISCAL YEAR.
40 . F D Q:'IN
41 .. S IN=$O(^PRCS(410,"AE",TN,IN))
42 .. Q:'IN
43 .. I $D(^PRCS(410,IN,0)),$P(^PRCS(410,IN,0),U,2)="O" S CO(CP)=CO(CP)+$P($G(^PRCS(410,IN,4)),U,3) ;"O"=OBLIGATION
44 .. Q
45 . Q
46 ;
47 Q ;QUIT PROGRAM
Note: See TracBrowser for help on using the repository browser.