source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBR2.m@ 1078

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1PRCBR2 ;WISC@ALTOONA/CTB-ENTER CEILING TRANSACTION BY FISCAL ;12/28/94 09:24
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4ENC ;ENTER CEILING TRANSACTION
5 D EN G:'% EXIT S X1=X,X=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP")) G EXIT:'X
6 S X=X1 D EN1^PRCSUT3 S X1=X D EN2^PRCSUT3 S X=X1 D W,LOCK^PRCSUT G:PRCSL=0 ENC
7 S DIC(0)="AEMQ",DIE=DIC,DR="[PRCSENC]" D ^DIE,ERS410^PRC0G(DA_"^O") D
8 . N A,B,X,Y,XMY
9 . D NAMES^PRCBBUL
10 . 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)
11 . S X(2)="COMMENT:"
12 . 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))
13 . D:$O(XMY("")) MM^PRC0B2("Place a Ceiling Transaction","X(",.XMY)
14 . QUIT
15 L @("-"_DIC_DA_")") S T(1)="Ceiling" D W3 G:%'=1 EXIT W !! G ENC
16W W !!,"This transaction is assigned transaction number: ",X Q
17 Q
18W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official" R X:5 G EXIT
19W3 W ! S %A="Would you like to enter another "_T(1)_" transaction",%B="",%=1 D ^PRCFYN Q:%'=0
20EXIT K DA,DIC,DIE,DR,PRCF,PRCS,PRCSL,X,X1 Q
21EN ;CREATE NEW TRANSACTION NUMBER
22 D EN1^PRCBSUT K C1,DA,DIC Q
23QDEV ;ask devide
24 I '$$TM^%ZTLOAD D G OUT
25 . W !,"The DHCP system job 'TASK MANAGER' is not running."
26 . W !,"The release of these transactions cannot be queued."
27 . W !,"Please call site manager to start the TASK MANAGER and try later."
28 . QUIT
29 D DEV G:POP OUT^PRCBR
30QUE ;queue release as a background job
31 I '$D(^PRCF(421,"AL",PRCF("SIFY"),1)) W !,"No transactions have been selected for release at this time.",!! G OUT
32 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
33OUT S X="BUDGET RELEASE" D UNLOCK^PRCFALCK
34KILL K %,%X,D,FAIL,J,K,PRCF,Y,RUN Q
35 ;
36REL ;reader help
37 W !!,"If you answer 'NO', you will have to release these transactions at a later time."
38 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",!
39 W "'^' to quit or access your CRT will this job is running.",!,"This job must run to completion."
40 Q
41 ;
42DEV ;device selection
43 W ! S %ZIS="N",IOP="Q",%ZIS("A")="Select DEVICE: ",%ZIS("B")="" D ^%ZIS
44 I POP W "Try releasing transaction(s) at a later time" Q
45 I IO=$G(IO(0)) W !,"You cannot select your home device.",$C(7),! G DEV
46 I IOST'?1"P".E W !,"You must select a printer device.",$C(7),! G DEV
47 I $G(IO("Q"))'=1 W !,"You must select a printer device for queuing",$C(7),! G DEV
48 Q
49 ;
50REL1 ;reader help from ^PRCBE
51 W !!,"Answer 'YES' if this transaction is complete and ready to be released to",!,"the Fund Control Point."
52 W !!,"Enter 'NO' if you want to edit this transaction at a later time.",!!
53 Q
54 ;
55 ;A=file 421 ri
56FCPVAL(A) ;EF valid fcp in file 421, EF value=1 if invalid
57 N B,C,Z
58 S B=$G(^PRCF(421,A,0)),C=$P(B,"^",22) D I Z="",C S B=$G(^PRCF(421,C,0)) D
59 . S Z=$$FCPVAL^PRC0D("^"_$P(B,"-")_"^"_(+$P(B,"^",2))_"^"_$P(B,"-",2)_"^"_(+$$DATE^PRC0C($P(B,"^",23),"I")))
60 . D:Z EN^DDIOL(" Transaction "_$P(B,"^")_" has an invalid set-up FCP "_$P(B,"^",2))
61 QUIT Z
62 ;
Note: See TracBrowser for help on using the repository browser.