PRCBR0 ;WISC@ALTOONA/CTB-CONTINUATION OF ^PRCFBR ; 10 Sep 89 3:08 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q1 W $C(7),! F I=1:1 Q:$P($T(X+I),";",3,99)="" W !,$P($T(X+I),";",3,99)
W ! S %A="Do you wish to see the list of all unreleased transactions",%B="",%=2 D ^PRCFYN G:%'=1 ASK^PRCBR
Q1A W !!,"Unreleased Sequence Numbers for Station ",PRC("SITE"),", FY: ",PRC("FY"),! F I=0,40 W ?I," SEQ # TRANS # CP# TOTAL"
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
G ASK^PRCBR
Q1A1 S X1="",X=^PRCF(421,N,0) F J=7:1:10 S X1=X1+$P(X,"^",J)
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
Q
X ;;
;;Enter the Sequence Number, or indicate a range of sequence numbers by
;;separating the first and last numbers with a dash (-).
;;Type "ALL" to release all unreleased transactions.
;;
ALL ;TRANSFER ALL TRANSACTIONS INTO ^TMP
S DA=0 F I=1:1 S DA=$O(^PRCF(421,"AL",PRCF("SIFY"),0,DA)) Q:DA="" D ONE
D QUE Q
ONE ;MARK ONE TRANSACTION AS RELEASED
S ^PRCF(421,"AL",PRCF("SIFY"),1,DA)="",$P(^PRCF(421,DA,0),"^",20)=1 K ^PRCF(421,"AL",PRCF("SIFY"),0,DA)
Q
DASH ;RELEASE ALL TRANSACTIONS WITHIN A RANGE OF SEQUENCE NUMBERS
I X'?.N1"-".N W !,"Incorrect format. ",$C(7) G ASK^PRCBR
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
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
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
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
S PRCB("HI")=$O(^PRCF(421,"B",PRCB("HI"),0))
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
W " DONE" K PRCB("CK") G ASK^PRCBR
ZERO ; PLACE UP TO 3 LEADING ZEROS ONTO A NUMBER
S Z="000"_Z,Z=$E(Z,$L(Z)-3,$L(Z)) Q
;
QUE ;QUEUE PRCBR1 TO RUN RELEASE AS TASKMAN JOB
I '$D(^PRCF(421,"AL",PRCF("SIFY"),1)) W !,"No transactions have been scheduled for release at this time.",!! G OUT
S %A="Do you wish to generate the printout with this option",%B="",%=2 D ^PRCFYN I %=2 S PRCFA("NOPRINT")="",ZTIO=""
D NOW^PRCFQ S PRCFTIME=% S ZTRTN="^PRCBR1",ZTSAVE("PRCFTIME")="",ZTSAVE("PRCF*")="",ZTDESC="RELEASE BUDGET TRANSACTIONS" D ^PRCFQ
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
K PRCFTIME G OUT
Q
OUT S X="BUDGET RELEASE" D UNLOCK^PRCFALCK
KILL K %,%X,D,FAIL,J,K,PRCF,Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCBR0 2888 printed Apr 09, 2024@21:13:18 Page 2
PRCBR0 ;WISC@ALTOONA/CTB-CONTINUATION OF ^PRCFBR ; 10 Sep 89 3:08 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
Q1 WRITE $CHAR(7),!
FOR I=1:1
if $PIECE($TEXT(X+I),";",3,99)=""
QUIT
WRITE !,$PIECE($TEXT(X+I),";",3,99)
+1 WRITE !
SET %A="Do you wish to see the list of all unreleased transactions"
SET %B=""
SET %=2
DO ^PRCFYN
if %'=1
GOTO ASK^PRCBR
Q1A WRITE !!,"Unreleased Sequence Numbers for Station ",PRC("SITE"),", FY: ",PRC("FY"),!
FOR I=0,40
WRITE ?I," SEQ # TRANS # CP# TOTAL"
+1 WRITE !
SET N=0
FOR I=0:1
SET N=$ORDER(^PRCF(421,"AL",PRCF("SIFY"),0,N))
if 'N
QUIT
if $DATA(^PRCF(421,N,0))#2
DO Q1A1
+2 GOTO ASK^PRCBR
Q1A1 SET X1=""
SET X=^PRCF(421,N,0)
FOR J=7:1:10
SET X1=X1+$PIECE(X,"^",J)
+1 if '(I#2)*I
WRITE !
WRITE ?I#2*40,$JUSTIFY(+$PIECE(X,"-",3),4,0)," ",$PIECE(X,"^")," CP-",+$PIECE(X,"^",2)," $",$JUSTIFY(X1,0,2)
KILL X1,X,J
+2 QUIT
X ;;
+1 ;;Enter the Sequence Number, or indicate a range of sequence numbers by
+2 ;;separating the first and last numbers with a dash (-).
+3 ;;Type "ALL" to release all unreleased transactions.
+4 ;;
ALL ;TRANSFER ALL TRANSACTIONS INTO ^TMP
+1 SET DA=0
FOR I=1:1
SET DA=$ORDER(^PRCF(421,"AL",PRCF("SIFY"),0,DA))
if DA=""
QUIT
DO ONE
+2 DO QUE
QUIT
ONE ;MARK ONE TRANSACTION AS RELEASED
+1 SET ^PRCF(421,"AL",PRCF("SIFY"),1,DA)=""
SET $PIECE(^PRCF(421,DA,0),"^",20)=1
KILL ^PRCF(421,"AL",PRCF("SIFY"),0,DA)
+2 QUIT
DASH ;RELEASE ALL TRANSACTIONS WITHIN A RANGE OF SEQUENCE NUMBERS
+1 IF X'?.N1"-".N
WRITE !,"Incorrect format. ",$CHAR(7)
GOTO ASK^PRCBR
+2 SET X1=+$PIECE(X,"-",2)
SET X=+$PIECE(X,"-",1)
IF X1>PRCB("LAST")
SET X1=PRCB("LAST")
IF X'<X1
WRITE !,"ILLOGICAL RANGE, THE FIRST NUMBER IS NOT LESS THAN THE SECOND.",$CHAR(7)
GOTO ASK^PRCBR
+3 SET PRCB("NUM")=0
SET Q=X-1
SET Q1=X1-1
SET Z=Q
DO ZERO
SET Q=Z
SET Z=Q1
DO ZERO
SET Q1=Z
SET PRCB("LO")=$ORDER(^PRCF(421,"B",PRCF("SIFY")_"-"_Q))
IF PRCB("LO")=""
WRITE !,"Sorry, I'm a little confused. Lets try it again.",!
GOTO ASK^PRCBR
+4 SET PRCB("LO")=$ORDER(^PRCF(421,"B",PRCB("LO"),0))
IF PRCB("LO")=""
WRITE !,"Please check your numbers and lets try again.",!
GOTO ASK^PRCBR
D1 ;I PRCB("HI")="" S Z=Q1-1 D ZERO S Q1=Z G D1
SET PRCB("HI")=$ORDER(^PRCF(421,"B",PRCF("SIFY")_"-"_Q1))
+1 SET PRCB("HI")=$ORDER(^PRCF(421,"B",PRCB("HI"),0))
+2 SET DA=PRCB("LO")-.5
FOR I=0:0
SET DA=$ORDER(^PRCF(421,"AL",PRCF("SIFY"),0,DA))
if DA=""!(DA>PRCB("HI"))
QUIT
DO ONE
+3 WRITE " DONE"
KILL PRCB("CK")
GOTO ASK^PRCBR
ZERO ; PLACE UP TO 3 LEADING ZEROS ONTO A NUMBER
+1 SET Z="000"_Z
SET Z=$EXTRACT(Z,$LENGTH(Z)-3,$LENGTH(Z))
QUIT
+2 ;
QUE ;QUEUE PRCBR1 TO RUN RELEASE AS TASKMAN JOB
+1 IF '$DATA(^PRCF(421,"AL",PRCF("SIFY"),1))
WRITE !,"No transactions have been scheduled for release at this time.",!!
GOTO OUT
+2 SET %A="Do you wish to generate the printout with this option"
SET %B=""
SET %=2
DO ^PRCFYN
IF %=2
SET PRCFA("NOPRINT")=""
SET ZTIO=""
+3 DO NOW^PRCFQ
SET PRCFTIME=%
SET ZTRTN="^PRCBR1"
SET ZTSAVE("PRCFTIME")=""
SET ZTSAVE("PRCF*")=""
SET ZTDESC="RELEASE BUDGET TRANSACTIONS"
DO ^PRCFQ
+4 IF $DATA(NODEV)
SET %X="You must select a device or time, you are past the point of no return.*"
DO MSG^PRCFQ
GOTO QUE
+5 KILL PRCFTIME
GOTO OUT
+6 QUIT
OUT SET X="BUDGET RELEASE"
DO UNLOCK^PRCFALCK
KILL KILL %,%X,D,FAIL,J,K,PRCF,Y
QUIT
