| 1 | PRCBR0 ;WISC@ALTOONA/CTB-CONTINUATION OF ^PRCFBR ; 10 Sep 89 3:08 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q1 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
|
|---|
| 6 | Q1A 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
|
|---|
| 9 | Q1A1 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
|
|---|
| 12 | X ;;
|
|---|
| 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 | ;;
|
|---|
| 17 | ALL ;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
|
|---|
| 20 | ONE ;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
|
|---|
| 23 | DASH ;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
|
|---|
| 28 | D1 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
|
|---|
| 32 | ZERO ; PLACE UP TO 3 LEADING ZEROS ONTO A NUMBER
|
|---|
| 33 | S Z="000"_Z,Z=$E(Z,$L(Z)-3,$L(Z)) Q
|
|---|
| 34 | ;
|
|---|
| 35 | QUE ;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
|
|---|
| 42 | OUT S X="BUDGET RELEASE" D UNLOCK^PRCFALCK
|
|---|
| 43 | KILL K %,%X,D,FAIL,J,K,PRCF,Y Q
|
|---|
