- PRCBR2 ;WISC@ALTOONA/CTB-ENTER CEILING TRANSACTION BY FISCAL ;12/28/94 09:24
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ENC ;ENTER CEILING TRANSACTION
- D EN G:'% EXIT S X1=X,X=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP")) G EXIT:'X
- S X=X1 D EN1^PRCSUT3 S X1=X D EN2^PRCSUT3 S X=X1 D W,LOCK^PRCSUT G:PRCSL=0 ENC
- S DIC(0)="AEMQ",DIE=DIC,DR="[PRCSENC]" D ^DIE,ERS410^PRC0G(DA_"^O") D
- . N A,B,X,Y,XMY
- . D NAMES^PRCBBUL
- . S X(1)="CP: "_PRC("CP")_" QTR: "_PRC("QTR")_" REF #: "_$P($G(^PRCS(410,DA,4)),"^",5)_" AMT: "_$P($G(^(4)),"^",3) QUIT:'$P($G(^(4)),"^",3)
- . S X(2)="COMMENT:"
- . S A=2,B=0 F S B=$O(^PRCS(410,DA,"CO",B)) QUIT:'B S A=A+1,X(A)=$G(^(B,0))
- . D:$O(XMY("")) MM^PRC0B2("Place a Ceiling Transaction","X(",.XMY)
- . QUIT
- L @("-"_DIC_DA_")") S T(1)="Ceiling" D W3 G:%'=1 EXIT W !! G ENC
- W W !!,"This transaction is assigned transaction number: ",X Q
- Q
- W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official" R X:5 G EXIT
- W3 W ! S %A="Would you like to enter another "_T(1)_" transaction",%B="",%=1 D ^PRCFYN Q:%'=0
- EXIT K DA,DIC,DIE,DR,PRCF,PRCS,PRCSL,X,X1 Q
- EN ;CREATE NEW TRANSACTION NUMBER
- D EN1^PRCBSUT K C1,DA,DIC Q
- QDEV ;ask devide
- I '$$TM^%ZTLOAD D G OUT
- . W !,"The DHCP system job 'TASK MANAGER' is not running."
- . W !,"The release of these transactions cannot be queued."
- . W !,"Please call site manager to start the TASK MANAGER and try later."
- . QUIT
- D DEV G:POP OUT^PRCBR
- QUE ;queue release as a background job
- I '$D(^PRCF(421,"AL",PRCF("SIFY"),1)) W !,"No transactions have been selected for release at this time.",!! G OUT
- D NOW^%DTC S PRCFTIME=%,ZTRTN="^PRCBR1",ZTSAVE("PRCFTIME")="",ZTSAVE("PRCF*")="",ZTSAVE("PRC*")="",ZTSAVE("PRCB*")="",ZTDESC="RELEASE BUDGET TRANSACTIONS",ZTDTH=$H,ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^PRCFQ ;CHANGED "ZTIO=IO"-TEN
- OUT S X="BUDGET RELEASE" D UNLOCK^PRCFALCK
- KILL K %,%X,D,FAIL,J,K,PRCF,Y,RUN Q
- ;
- REL ;reader help
- W !!,"If you answer 'NO', you will have to release these transactions at a later time."
- W !,"By answering 'YES', the transaction(s) selected will be released and posted to",!,"the Control Point(s) now. If you answer 'YES', you will NOT be able to",!
- W "'^' to quit or access your CRT will this job is running.",!,"This job must run to completion."
- Q
- ;
- DEV ;device selection
- W ! S %ZIS="N",IOP="Q",%ZIS("A")="Select DEVICE: ",%ZIS("B")="" D ^%ZIS
- I POP W "Try releasing transaction(s) at a later time" Q
- I IO=$G(IO(0)) W !,"You cannot select your home device.",$C(7),! G DEV
- I IOST'?1"P".E W !,"You must select a printer device.",$C(7),! G DEV
- I $G(IO("Q"))'=1 W !,"You must select a printer device for queuing",$C(7),! G DEV
- Q
- ;
- REL1 ;reader help from ^PRCBE
- W !!,"Answer 'YES' if this transaction is complete and ready to be released to",!,"the Fund Control Point."
- W !!,"Enter 'NO' if you want to edit this transaction at a later time.",!!
- Q
- ;
- ;A=file 421 ri
- FCPVAL(A) ;EF valid fcp in file 421, EF value=1 if invalid
- N B,C,Z
- S B=$G(^PRCF(421,A,0)),C=$P(B,"^",22) D I Z="",C S B=$G(^PRCF(421,C,0)) D
- . S Z=$$FCPVAL^PRC0D("^"_$P(B,"-")_"^"_(+$P(B,"^",2))_"^"_$P(B,"-",2)_"^"_(+$$DATE^PRC0C($P(B,"^",23),"I")))
- . D:Z EN^DDIOL(" Transaction "_$P(B,"^")_" has an invalid set-up FCP "_$P(B,"^",2))
- QUIT Z
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCBR2 3385 printed Feb 18, 2025@23:27:13 Page 2
- PRCBR2 ;WISC@ALTOONA/CTB-ENTER CEILING TRANSACTION BY FISCAL ;12/28/94 09:24
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- ENC ;ENTER CEILING TRANSACTION
- +1 DO EN
- if '%
- GOTO EXIT
- SET X1=X
- SET X=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"))
- if 'X
- GOTO EXIT
- +2 SET X=X1
- DO EN1^PRCSUT3
- SET X1=X
- DO EN2^PRCSUT3
- SET X=X1
- DO W
- DO LOCK^PRCSUT
- if PRCSL=0
- GOTO ENC
- +3 SET DIC(0)="AEMQ"
- SET DIE=DIC
- SET DR="[PRCSENC]"
- DO ^DIE
- DO ERS410^PRC0G(DA_"^O")
- Begin DoDot:1
- +4 NEW A,B,X,Y,XMY
- +5 DO NAMES^PRCBBUL
- +6 SET X(1)="CP: "_PRC("CP")_" QTR: "_PRC("QTR")_" REF #: "_$PIECE($GET(^PRCS(410,DA,4)),"^",5)_" AMT: "_$PIECE($GET(^(4)),"^",3)
- if '$PIECE($GET(^(4)),"^",3)
- QUIT
- +7 SET X(2)="COMMENT:"
- +8 SET A=2
- SET B=0
- FOR
- SET B=$ORDER(^PRCS(410,DA,"CO",B))
- if 'B
- QUIT
- SET A=A+1
- SET X(A)=$GET(^(B,0))
- +9 if $ORDER(XMY(""))
- DO MM^PRC0B2("Place a Ceiling Transaction","X(",.XMY)
- +10 QUIT
- End DoDot:1
- +11 LOCK @("-"_DIC_DA_")")
- SET T(1)="Ceiling"
- DO W3
- if %'=1
- GOTO EXIT
- WRITE !!
- GOTO ENC
- W WRITE !!,"This transaction is assigned transaction number: ",X
- QUIT
- +1 QUIT
- W2 WRITE !!,"You are not an authorized control point user.",!,"Contact your control point official"
- READ X:5
- GOTO EXIT
- W3 WRITE !
- SET %A="Would you like to enter another "_T(1)_" transaction"
- SET %B=""
- SET %=1
- DO ^PRCFYN
- if %'=0
- QUIT
- EXIT KILL DA,DIC,DIE,DR,PRCF,PRCS,PRCSL,X,X1
- QUIT
- EN ;CREATE NEW TRANSACTION NUMBER
- +1 DO EN1^PRCBSUT
- KILL C1,DA,DIC
- QUIT
- QDEV ;ask devide
- +1 IF '$$TM^%ZTLOAD
- Begin DoDot:1
- +2 WRITE !,"The DHCP system job 'TASK MANAGER' is not running."
- +3 WRITE !,"The release of these transactions cannot be queued."
- +4 WRITE !,"Please call site manager to start the TASK MANAGER and try later."
- +5 QUIT
- End DoDot:1
- GOTO OUT
- +6 DO DEV
- if POP
- GOTO OUT^PRCBR
- QUE ;queue release as a background job
- +1 IF '$DATA(^PRCF(421,"AL",PRCF("SIFY"),1))
- WRITE !,"No transactions have been selected for release at this time.",!!
- GOTO OUT
- +2 ;CHANGED "ZTIO=IO"-TEN
- DO NOW^%DTC
- SET PRCFTIME=%
- SET ZTRTN="^PRCBR1"
- SET ZTSAVE("PRCFTIME")=""
- SET ZTSAVE("PRCF*")=""
- SET ZTSAVE("PRC*")=""
- SET ZTSAVE("PRCB*")=""
- SET ZTDESC="RELEASE BUDGET TRANSACTIONS"
- SET ZTDTH=$HOROLOG
- SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
- DO ^PRCFQ
- OUT SET X="BUDGET RELEASE"
- DO UNLOCK^PRCFALCK
- KILL KILL %,%X,D,FAIL,J,K,PRCF,Y,RUN
- QUIT
- +1 ;
- REL ;reader help
- +1 WRITE !!,"If you answer 'NO', you will have to release these transactions at a later time."
- +2 WRITE !,"By answering 'YES', the transaction(s) selected will be released and posted to",!,"the Control Point(s) now. If you answer 'YES', you will NOT be able to",!
- +3 WRITE "'^' to quit or access your CRT will this job is running.",!,"This job must run to completion."
- +4 QUIT
- +5 ;
- DEV ;device selection
- +1 WRITE !
- SET %ZIS="N"
- SET IOP="Q"
- SET %ZIS("A")="Select DEVICE: "
- SET %ZIS("B")=""
- DO ^%ZIS
- +2 IF POP
- WRITE "Try releasing transaction(s) at a later time"
- QUIT
- +3 IF IO=$GET(IO(0))
- WRITE !,"You cannot select your home device.",$CHAR(7),!
- GOTO DEV
- +4 IF IOST'?1"P".E
- WRITE !,"You must select a printer device.",$CHAR(7),!
- GOTO DEV
- +5 IF $GET(IO("Q"))'=1
- WRITE !,"You must select a printer device for queuing",$CHAR(7),!
- GOTO DEV
- +6 QUIT
- +7 ;
- REL1 ;reader help from ^PRCBE
- +1 WRITE !!,"Answer 'YES' if this transaction is complete and ready to be released to",!,"the Fund Control Point."
- +2 WRITE !!,"Enter 'NO' if you want to edit this transaction at a later time.",!!
- +3 QUIT
- +4 ;
- +5 ;A=file 421 ri
- FCPVAL(A) ;EF valid fcp in file 421, EF value=1 if invalid
- +1 NEW B,C,Z
- +2 SET B=$GET(^PRCF(421,A,0))
- SET C=$PIECE(B,"^",22)
- Begin DoDot:1
- +3 SET Z=$$FCPVAL^PRC0D("^"_$PIECE(B,"-")_"^"_(+$PIECE(B,"^",2))_"^"_$PIECE(B,"-",2)_"^"_(+$$DATE^PRC0C($PIECE(B,"^",23),"I")))
- +4 if Z
- DO EN^DDIOL(" Transaction "_$PIECE(B,"^")_" has an invalid set-up FCP "_$PIECE(B,"^",2))
- End DoDot:1
- IF Z=""
- IF C
- SET B=$GET(^PRCF(421,C,0))
- Begin DoDot:1
- End DoDot:1
- +5 QUIT Z
- +6 ;
