- PRCS826 ;WISC/CLH/TEN-826 CEILING RPT ;6/29/00 12:22
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- CEIL(SI,FY,QTR,CA,CO) ;
- N TN,IN,CP
- ;
- ; CALCULATE TOTAL CEILING DOLLARS FOR USER SELECTED QUARTER.
- ;
- S TN=SI_"-"_FY_"-"_QTR_"-000"
- ;
- ; PICK ALL TRANSACTIONS FOR USER SELECTED QUARTER.
- ;
- F D Q:'TN!($P(TN,"-",3)'=QTR)
- . S TN=$O(^PRCS(410,"AE",TN))
- . Q:('TN)!($P(TN,"-",3)'=QTR)
- . S CP=+$P(TN,"-",4)
- . S CA(CP)=0
- . S IN=0
- . ; PICK ALL "CEILING" TRANSACTION TYPES WITHIN QTR.
- . F D Q:'IN
- .. S IN=$O(^PRCS(410,"AE",TN,IN))
- .. Q:'IN
- .. 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
- .. Q
- . Q
- ;
- ; CALCULATE TOTAL USER SELECTED FISCAL YEAR-TO-DATE OBLIGATIONS.
- ;
- S TN=SI_"-"_FY_"-1-000"
- ;
- ; PICK ALL TRANSACTIONS FOR USER SELECTED FISCAL YEAR.
- ;
- F D Q:'TN!($P(TN,"-",2)'=FY)
- . S TN=$O(^PRCS(410,"AE",TN))
- . Q:('TN)!($P(TN,"-",2)'=FY)
- . S CP=+$P(TN,"-",4)
- . I '$D(CO(CP)) S CO(CP)=0
- . S IN=0
- . ; PICK ALL "OBLIGATION" TRANSACTION TYPES WITHIN FISCAL YEAR.
- . F D Q:'IN
- .. S IN=$O(^PRCS(410,"AE",TN,IN))
- .. Q:'IN
- .. 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
- .. Q
- . Q
- ;
- Q ;QUIT PROGRAM
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCS826 1357 printed Apr 23, 2025@18:31:40 Page 2
- PRCS826 ;WISC/CLH/TEN-826 CEILING RPT ;6/29/00 12:22
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- CEIL(SI,FY,QTR,CA,CO) ;
- +1 NEW TN,IN,CP
- +2 ;
- +3 ; CALCULATE TOTAL CEILING DOLLARS FOR USER SELECTED QUARTER.
- +4 ;
- +5 SET TN=SI_"-"_FY_"-"_QTR_"-000"
- +6 ;
- +7 ; PICK ALL TRANSACTIONS FOR USER SELECTED QUARTER.
- +8 ;
- +9 FOR
- Begin DoDot:1
- +10 SET TN=$ORDER(^PRCS(410,"AE",TN))
- +11 if ('TN)!($PIECE(TN,"-",3)'=QTR)
- QUIT
- +12 SET CP=+$PIECE(TN,"-",4)
- +13 SET CA(CP)=0
- +14 SET IN=0
- +15 ; PICK ALL "CEILING" TRANSACTION TYPES WITHIN QTR.
- +16 FOR
- Begin DoDot:2
- +17 SET IN=$ORDER(^PRCS(410,"AE",TN,IN))
- +18 if 'IN
- QUIT
- +19 ;"C"=CEILING
- IF $DATA(^PRCS(410,IN,0))
- IF $PIECE(^PRCS(410,IN,0),U,2)="C"
- SET CA(CP)=CA(CP)+$PIECE($GET(^PRCS(410,IN,6)),"^")
- +20 QUIT
- End DoDot:2
- if 'IN
- QUIT
- +21 QUIT
- End DoDot:1
- if 'TN!($PIECE(TN,"-",3)'=QTR)
- QUIT
- +22 ;
- +23 ; CALCULATE TOTAL USER SELECTED FISCAL YEAR-TO-DATE OBLIGATIONS.
- +24 ;
- +25 SET TN=SI_"-"_FY_"-1-000"
- +26 ;
- +27 ; PICK ALL TRANSACTIONS FOR USER SELECTED FISCAL YEAR.
- +28 ;
- +29 FOR
- Begin DoDot:1
- +30 SET TN=$ORDER(^PRCS(410,"AE",TN))
- +31 if ('TN)!($PIECE(TN,"-",2)'=FY)
- QUIT
- +32 SET CP=+$PIECE(TN,"-",4)
- +33 IF '$DATA(CO(CP))
- SET CO(CP)=0
- +34 SET IN=0
- +35 ; PICK ALL "OBLIGATION" TRANSACTION TYPES WITHIN FISCAL YEAR.
- +36 FOR
- Begin DoDot:2
- +37 SET IN=$ORDER(^PRCS(410,"AE",TN,IN))
- +38 if 'IN
- QUIT
- +39 ;"O"=OBLIGATION
- IF $DATA(^PRCS(410,IN,0))
- IF $PIECE(^PRCS(410,IN,0),U,2)="O"
- SET CO(CP)=CO(CP)+$PIECE($GET(^PRCS(410,IN,4)),U,3)
- +40 QUIT
- End DoDot:2
- if 'IN
- QUIT
- +41 QUIT
- End DoDot:1
- if 'TN!($PIECE(TN,"-",2)'=FY)
- QUIT
- +42 ;
- +43 ;QUIT PROGRAM
- QUIT
