source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBR.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1PRCBR ;WISC@ALTOONA/CLH/CTB-ROUTINE TO RELEASE FUND DISTRIBUTION TRANSACTIONS ; 10 Apr 93 3:50 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 N X,DIR,DIC,DR,DIE,DIK,PRC,PRCF,PRCB,PRCFA,%,Y,Z,Z1,Q,J,K,D,Y,FAIL
5 S X="BUDGET RELEASE" D ^PRCFALCK I '% G KILL
6 S PRCF("X")="ABFS" D ^PRCFSITE G:'% OUT
7 S X=$O(^PRCF(421,"AL",PRCF("SIFY"),"")) I X'=0&(X'=1) W !!,$C(7),"There are no PENDING RELEASE transactions for FY: ",PRC("FY") R X:3 G OUT
8 S K=0 I '$D(^PRC(420,PRC("SITE"),2,DUZ)) W !,"You are not authorized to release funds for station ",PRC("SITE"),",",!,"PLEASE CONTACT YOUR APPLICATION MANAGER.",$C(7) R X:3 G OUT
9 D SIG^PRCFACX0 K PRCFK I $D(PRCFA("SIGFAIL")) K PRCFA("SIGFAIL") G OUT
10 N DIR,Y,X
11 S PRCB("CK")="" S DIR(0)="YO",DIR("A")="Do you wish to review/edit any transactions",DIR("B")="NO",DIR("?")="Enter yes to review/edit a transaction, '^' to quit" D ^DIR G:Y["^" OUT
12 I Y D
13 . S DR="[PRCB NEW TRANSACTION]",DIC("A")="Select Sequence Number for "_$S($D(PRCB("MDIV")):"Station "_PRC("SITE")_",",1:"")_" FY "_PRC("FY")_": "
14 . S Z="",PRCFLAST=PRCB("LAST") D EN21^PRCBE S PRCB("LAST")=PRCFLAST K PRCFLAST I '$D(PRCF("SIFY")) S PRCF("SIFY")=PRC("SITE")_"-"_PRC("FY")
15ASK R !,"Enter Sequence Number of Transaction(s) to be Released: ",X:DTIME G:X["?" Q1 G:X["^" OUT G:X="ALL" ALL G:X["-" DASH G:X="" UNDO I X'?1.N W $C(7)," ??" G ASK
16 S (Z,X1)=X D ZERO S X1=Z I '$D(^PRCF(421,"B",PRCF("SIFY")_"-"_X1)) W $C(7),!," ??" G Q1A
17 S DA=$O(^PRCF(421,"B",PRCF("SIFY")_"-"_X1,0)) I $D(^PRCF(421,"AL",PRCF("SIFY"),2,DA)) W $C(7),!," THIS SEQUENCE HAS ALREADY BEEN RELEASED. RERELEASE IS NOT PERMITTED." G Q1A
18 I $D(^PRCF(421,"AL",PRCF("SIFY"),1,DA)) W !,$C(7),"THIS TRANSACTION HAS ALREADY BEEN SELECTED FOR RELEASE. NO ACTION TAKEN." H 2 K PRCB("CK") G ASK
19 W " OK" K PRCB("CK") D ONE
20 G ASK
21UNDO I '$D(^PRCF(421,"AL",PRCF("SIFY"),1)) W !!,$C(7),"No transactions have been selected for releasing for FY: ",PRC("FY") G ASK
22 W !!,"To not release a transaction already selected to be released"
23 S DIC("A")="Enter the last 4 digits of the transaction for "_$S($D(PRCB("MDIV")):"Station "_PRC("SITE")_",",1:"")_" FY "_PRC("FY")_": "
24 S DIC("S")="S ZX=^(0) I $P(ZX,U)[PRCF(""SIFY"")&($P(ZX,U,11)="""")&($P(ZX,U)'[""0000"")&(+$P(ZX,U,20)=1)",DIC=421,DIC(0)="AEQZ",D="D" D IX^DIC K DIC G:Y<0 DEV S DA=+Y
25 D UNREL(DA)
26 ;if transfer fund
27 I $P(^PRCF(421,DA,0),"^",22) D UNREL($P(^(0),"^",22))
28 G UNDO
29 ;
30UNREL(DA) I $D(^PRCF(421,"AL",PRCF("SIFY"),1,DA)),'$D(^PRCF(421,"AL",PRCF("SIFY"),2,DA)) S DIE="^PRCF(421,",DR="11.5////^S X=0" D ^DIE K ^PRCF(421,"AL",PRCF("SIFY"),1,DA)
31 QUIT
32DEV ;ask device
33 G QDEV^PRCBR2
34Q1 F I=1:1 Q:$P($T(X+I),";",3,99)="" W !,$P($T(X+I),";",3,99)
35 S DIR(0)="Y",DIR("A")="Do you wish to see the list of all unreleased transactions",DIR("?")="Enter yes to look at list, no or '^' to quit" D ^DIR G:'Y ASK
36Q1A W !!,"Unreleased Sequence Numbers for Station ",PRC("SITE"),", FY: ",PRC("FY"),! F I=0,40 W ?I," SEQ # TRANS # CP# TOTAL"
37 W ! S N=0 F I=0:1 S N=$O(^PRCF(421,"AL",PRCF("SIFY"),0,N)) Q:'N D
38 . S X1="",X=^PRCF(421,N,0) F J=7:1:10 S X1=X1+$P(X,"^",J)
39 . W:'(I#2)*I ! W ?I#2*40,$J(+$P(X,"-",3),4,0)," ",$P(X,"^")," CP-",+$P(X,"^",2)," $",$J(X1,0,2) K X1,X,J
40 . Q
41 G ASK
42X ;;
43 ;;Enter the Sequence Number, or indicate a range of sequence numbers by
44 ;;separating the first and last numbers with a dash (-).
45 ;;Type "ALL" to release all unreleased transactions.
46 ;;
47ALL ;TRANSFER ALL TRANSACTIONS INTO ^TMP
48 S DA=0 F I=1:1 S DA=$O(^PRCF(421,"AL",PRCF("SIFY"),0,DA)) Q:DA="" D ONE
49 G UNDO
50ONE ;mark release status
51 QUIT:$$FCPVAL^PRCBR2(DA)
52 D REL(DA)
53 ;if transfer fund
54 I $P(^PRCF(421,DA,0),"^",22) D REL($P(^(0),"^",22))
55 QUIT
56 ;
57REL(DA) I '$D(^PRCF(421,"AL",PRCF("SIFY"),1,DA)),'$D(^PRCF(421,"AL",PRCF("SIFY"),2,DA)) S DIE="^PRCF(421,",DR="11.5////^S X=1" D ^DIE K ^PRCF(421,"AL",PRCF("SIFY"),0,DA)
58 QUIT
59 ;
60DASH ;release all transactions within a range of sequence numbers
61 I X'?.N1"-".N W !,"Incorrect format. ",$C(7) G ASK
62 S X1=+$P(X,"-",2),X=+$P(X,"-",1) I X1>PRCB("LAST") S X1=PRCB("LAST") I X'<X1 W !,"ILLOGICAL RANGE, THE FIRST NUMBER IS NOT LESS THAN THE SECOND.",$C(7) G ASK
63 S PRCB("NUM")=0 S Q=X-1,Q1=X1-1 S Z=Q D ZERO S Q=Z,Z=Q1 D ZERO S Q1=Z,PRCB("LO")=$O(^PRCF(421,"B",PRCF("SIFY")_"-"_Q)) I PRCB("LO")="" W !,"Sorry, I'm a little confused. Let's try it again.",! G ASK
64 S PRCB("LO")=$O(^PRCF(421,"B",PRCB("LO"),0)) I PRCB("LO")="" W !,"Please check your numbers and let's try again.",! G ASK
65D1 S PRCB("HI")=$O(^PRCF(421,"B",PRCF("SIFY")_"-"_Q1))
66 S PRCB("HI")=$O(^PRCF(421,"B",PRCB("HI"),0))
67 S DA=PRCB("LO")-.5 F I=0:0 S DA=$O(^PRCF(421,"AL",PRCF("SIFY"),0,DA)) Q:DA=""!(DA>PRCB("HI")) D ONE
68 W " DONE" K PRCB("CK") G ASK
69ZERO ;place up to 3 leading zeros onto a number
70 S Z="000"_Z,Z=$E(Z,$L(Z)-3,$L(Z)) Q
71 ;
72OUT S X="BUDGET RELEASE" D UNLOCK^PRCFALCK
73KILL K DIRUT,DTOUT,DIROUT,DUOUT Q
Note: See TracBrowser for help on using the repository browser.