source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBR0.m@ 897

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PRCBR0 ;WISC@ALTOONA/CTB-CONTINUATION OF ^PRCFBR ; 10 Sep 89 3:08 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4Q1 W $C(7),! F I=1:1 Q:$P($T(X+I),";",3,99)="" W !,$P($T(X+I),";",3,99)
5 W ! S %A="Do you wish to see the list of all unreleased transactions",%B="",%=2 D ^PRCFYN G:%'=1 ASK^PRCBR
6Q1A W !!,"Unreleased Sequence Numbers for Station ",PRC("SITE"),", FY: ",PRC("FY"),! F I=0,40 W ?I," SEQ # TRANS # CP# TOTAL"
7 W ! S N=0 F I=0:1 S N=$O(^PRCF(421,"AL",PRCF("SIFY"),0,N)) Q:'N D:$D(^PRCF(421,N,0))#2 Q1A1
8 G ASK^PRCBR
9Q1A1 S X1="",X=^PRCF(421,N,0) F J=7:1:10 S X1=X1+$P(X,"^",J)
10 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
11 Q
12X ;;
13 ;;Enter the Sequence Number, or indicate a range of sequence numbers by
14 ;;separating the first and last numbers with a dash (-).
15 ;;Type "ALL" to release all unreleased transactions.
16 ;;
17ALL ;TRANSFER ALL TRANSACTIONS INTO ^TMP
18 S DA=0 F I=1:1 S DA=$O(^PRCF(421,"AL",PRCF("SIFY"),0,DA)) Q:DA="" D ONE
19 D QUE Q
20ONE ;MARK ONE TRANSACTION AS RELEASED
21 S ^PRCF(421,"AL",PRCF("SIFY"),1,DA)="",$P(^PRCF(421,DA,0),"^",20)=1 K ^PRCF(421,"AL",PRCF("SIFY"),0,DA)
22 Q
23DASH ;RELEASE ALL TRANSACTIONS WITHIN A RANGE OF SEQUENCE NUMBERS
24 I X'?.N1"-".N W !,"Incorrect format. ",$C(7) G ASK^PRCBR
25 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^PRCBR
26 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. Lets try it again.",! G ASK^PRCBR
27 S PRCB("LO")=$O(^PRCF(421,"B",PRCB("LO"),0)) I PRCB("LO")="" W !,"Please check your numbers and lets try again.",! G ASK^PRCBR
28D1 S PRCB("HI")=$O(^PRCF(421,"B",PRCF("SIFY")_"-"_Q1)) ;I PRCB("HI")="" S Z=Q1-1 D ZERO S Q1=Z G D1
29 S PRCB("HI")=$O(^PRCF(421,"B",PRCB("HI"),0))
30 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
31 W " DONE" K PRCB("CK") G ASK^PRCBR
32ZERO ; PLACE UP TO 3 LEADING ZEROS ONTO A NUMBER
33 S Z="000"_Z,Z=$E(Z,$L(Z)-3,$L(Z)) Q
34 ;
35QUE ;QUEUE PRCBR1 TO RUN RELEASE AS TASKMAN JOB
36 I '$D(^PRCF(421,"AL",PRCF("SIFY"),1)) W !,"No transactions have been scheduled for release at this time.",!! G OUT
37 S %A="Do you wish to generate the printout with this option",%B="",%=2 D ^PRCFYN I %=2 S PRCFA("NOPRINT")="",ZTIO=""
38 D NOW^PRCFQ S PRCFTIME=% S ZTRTN="^PRCBR1",ZTSAVE("PRCFTIME")="",ZTSAVE("PRCF*")="",ZTDESC="RELEASE BUDGET TRANSACTIONS" D ^PRCFQ
39 I $D(NODEV) S %X="You must select a device or time, you are past the point of no return.*" D MSG^PRCFQ G QUE
40 K PRCFTIME G OUT
41 Q
42OUT S X="BUDGET RELEASE" D UNLOCK^PRCFALCK
43KILL K %,%X,D,FAIL,J,K,PRCF,Y Q
Note: See TracBrowser for help on using the repository browser.