Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCB1E

PRCB1E.m

Go to the documentation of this file. 
  1. PRCB1E ;WISC/PLT-QUARTERLY CARRY FORWARD ; 03/01/96  1:27 PM
  1. V ;;5.1;IFCAP;**64,72**;Oct 20, 2000
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  QUIT  ;invalid entry
  1.  ;
  1. EN ;quarterly carry forward
  1.  N PRCA,PRCB,PRCQCD,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRC,PRCDES
  1.  N A,B,C
  1.  S PRCQCD=1 ;over lapping days
  1. Q1 ;station
  1.  S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT
  1.  S PRCRI(420)=+PRC("SITE")
  1. Q2 S B="O^1:Carry forward Outstanding Requests;2:Carry forward balances for all control points;3:Carry forward balances for a single control point"
  1.  K X,Y S Y(1)="^W ""Enter an option number 1 to 3."""
  1.  D SC^PRC0A(.X,.Y,"Select Number",B,"")
  1.  S A=Y K X,Y
  1.  G EXIT:A=""!(A["^")
  1.  S PRCOPT=+A
  1.  I PRCOPT=1 G Q4
  1.  I "12"[PRCOPT G Q4
  1. Q3 ;select control point
  1.  S PRCDI="420;^PRC(420,;"_PRC("SITE")
  1.  S $P(PRCDI,"~",2)="420.01;"_$P($P(PRCDI,"~"),";",2)_PRCRI(420)_",1,;"
  1.  S X("S")="I ^(0)-9999"
  1.  D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQS","Select Fund Control Point: ")
  1.  I Y<0!(X="") S PRCQT="^" G Q2
  1.  K X S PRCRI(420.01)=+Y,PRC("CP")=$P($P(Y,"^")," ")
  1. Q4 ;fiscal year - quarter
  1.  S A=$P($G(^PRC(420,PRC("SITE"),0)),"^",9),A=$$DATE^PRC0C(A,"I")
  1.  S PRCA=$P(A,"^")_"-"_$P(A,"^",2)_"^"_$P(A,"^",7)_"^"_$P(A,"^",8)
  1.  S A=$$DATE^PRC0C($P(PRCA,"^",3)+100,"H"),A=$$QTRDATE^PRC0D(+A,$P(A,"^",2))
  1.  S B="" F C=$P(A,"^",8):1 S:C-3#7'=6&(C-3#7) B=B+1 Q:B=PRCQCD
  1.  S $P(PRCA,"^",4,5)=$P($$DATE^PRC0C(C-1,"H"),"^",7,8)
  1.  D EN^DDIOL(" "),EN^DDIOL("The oldest OPEN quarter in file is "_$P(PRCA,"^",1)_".")
  1.  S E="O^4:6^K:X'?2N.1""-"".1N&(X'?4N.1""-"".1N)!($P(X,""-"",2)<1)!($P(X,""-"",2)>4) X",Y(1)="Enter a 2 or 4 digit year followed by a '-' and quarter #, like 88-3 or 1988-3"
  1.  D FT^PRC0A(.X,.Y,"For Budget Fiscal Year - Quarter (YY-Q)",E,"")
  1.  G:X["^"!(X="")!(Y'?2.4N.1"-".1N) Q2
  1.  S $P(Y,"-")=+$$YEAR^PRC0C($P(Y,"-"))
  1.  I "1"[PRCOPT,Y]$P(PRCA,"^")!(Y=$P(PRCA,"^")&($H-1<$P(PRCA,"^",5))) S A="You must close quarter "_$P(PRCA,"^")_" first after "_$E($P(PRCA,"^",4),4,5)_"/"_$E($P(PRCA,"^",4),6,7)_"/"_$E($P(PRCA,"^",4),2,3) D EN^DDIOL(A) G Q4
  1.  I "23"[PRCOPT,Y]$P(PRCA,"^")!(Y=$P(PRCA,"^")) D EN^DDIOL("You may only rerun closed quarters. That is any quarter before "_$P(PRCA,"^")) G Q4
  1.  I "1996-1"]Y D EN^DDIOL("Carry forward can not be run for any quarters before '96-1'.") G Q4
  1.  S $P(PRCOPT,"^",2)=Y,$P(PRCOPT,"^",3)=PRCRI(420),$P(PRCOPT,"^",4)=$G(PRCRI(420.01))
  1.  I $P(PRCOPT,"^",2)["-4",$P(^PRC(411,PRC("SITE"),0),"^",25)'="Y" D EN^DDIOL("The outstanding requests are not carried forward to the new fiscal year.")
  1. Q5 D YN^PRC0A(.X,.Y,"Ready to Run","O","NO")
  1.  I X["^"!(X="")!'Y S PRCOPT=$P(PRCOPT,"^") G Q4
  1.  D CF
  1. EXIT QUIT
  1.  ;
  1.  ;
  1. CF ;start carry forward
  1.  N PRCDUZ
  1.  S PRCDUZ=DUZ
  1.  I +PRCOPT=1 S ZTDESC="IFCAP Carry Forward Outstanding Requests from Qtr "_$E($P(PRCOPT,"^",2),3,999)
  1.  I +PRCOPT=2 S ZTDESC="IFCAP Carry Forward Balances for All CP'S from Qtr "_$E($P(PRCOPT,"^",2),3,999)
  1.  I +PRCOPT=3 S ZTDESC="IFCAP Carry Forward Balances for a Single CP from Qtr "_$E($P(PRCOPT,"^",2),3,999)
  1.  S PRCDES=ZTDESC
  1.  S ZTRTN="TMEN^PRCB1E1" F A="PRCOPT","PRCDUZ","PRCDES","DUZ*" S ZTSAVE(A)=""
  1.  D ^PRCFQ
  1.  QUIT