source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBR1.m@ 619

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1PRCBR1 ;WISC@ALTOONA/CTB-ROUTINE TO RELEASE TRANSACTIONS FROM FUND DISTRIBUTION FILE ; 01/31/94 4:06 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4SE ;DIRECT ENTRY POINT, UN QUEUED
5 I $D(ZTQUEUED) D KILL^%ZTLOAD
6 S X="BUDGET RELEASE" D ^PRCFALCK I '% D REQUE Q
7SE1 D NOW^%DTC S DT=X S:'$D(PRCFTIME) PRCFTIME=%
8 D DUZ^PRCFSITE G:'% OUT
9 I '$D(^PRCF(421,"AL",PRCF("SIFY"),1)) W !!,"FUND DISTRIBUTION RELEASE ABORTED. NO TRANSACTIONS FOUND FOR STATION NUMBER "_PRC("SITE")_"." G OUT
10 W:$D(IOF) @IOF W "Beginning transaction release...",!!
11C S U="^" K ^PRCF(421,"AI",1),^TMP("PRCB",$J,"CP",2) S DA=0
12 F ZI=1:1 S DA=$O(^PRCF(421,"AL",PRCF("SIFY"),1,DA)) Q:'DA Q:'$D(^PRCF(421,DA,0)) S PRCB("TRDA")=DA,TRDA(0)=^PRCF(421,DA,0) Q:$P(TRDA(0),"-",1,2)'=PRCF("SIFY") D A Q:$D(PRCFA("QUIT"))
13 G:$D(PRCFA("QUIT")) OUT S PRCB("CP")=9999 D LOAD
14OUT K ^TMP("PRCB",$J,"CP"),%,%D,%H,%I,%M,%X,%Y,BY,C,DA,DHD,DIC,DLAYGO,FLDS,G,I,IOP,J,K,J,M,N,NOW,P,PRCF,PRCFA,PRCB,PRSAL,PRCFTIME,T,X,Y,Z,ZI
15 D EN^DDIOL("End of Released Transactions List **************")
16 S X="BUDGET RELEASE" D UNLOCK^PRCFALCK Q
17REQUE I '$D(ZTQUEUED) W !!,$C(7),"Try releasing at a later time." Q
18 S ZTIO=$S($D(PRCFA("NOPRINT")):"@",1:IO) D REQ^%ZTLOAD
19 Q
20A ;PROCEDURE TO DETERMINE IF CONTROL POINT IS AUTOMATED D B IF IT IS, A1 IF ITIS NOT
21 S PRCB("CK")=0,PRCB("CP")=+($P(TRDA(0),U,2)),PRC("SITE")=+TRDA(0),PRC("FY")=$P(TRDA(0),"-",2)
22 I $D(^PRC(420,PRC("SITE"),1,PRCB("CP"),0)),$P(^(0),U,11)["Y" D B Q:$D(PRCFA("QUIT")) D:PRCB("CK")'=1 REL Q
23 D LOAD
24 S DA=PRCB("TRDA")
25 S MESSAGE=""
26 D ENCODE^PRCBES1(DA,DUZ,.MESSAGE)
27 K MESSAGE
28 D REL
29 Q
30LOAD ;LOAD ALL TRANSACTIONS FOR A SPECIFIC CONTROL POINT INTO THE 'ON PRINT LIST FIELD AND CROSS REFERENCE
31 I '$D(^TMP("PRCB",$J,"CP",2,PRCB("CP"))) S ^TMP("PRCB",$J,"CP",2,PRCB("CP"))="",M=0 F J=1:1 S M=$O(^PRCF(421,"AC",PRCF("SIFY")_"-"_PRCB("CP"),M)) Q:M="" S ^PRCF(421,"AI",1,M)="",$P(^PRCF(421,M,2),"^",13)=1
32 Q
33B ;RELEASE INDIVIDUAL SEQUENCE NUMBER
34 D LOAD S PRCFC(1)=+TRDA(0),PRCFC=$P(TRDA(0),U,2),PRCFC(2)=$P(PRCFC," ",1),PRCFC(3)=$P(TRDA(0),U,6),PRC("BBFY")=$P(TRDA(0),"^",23)
35 S I=PRCFC(2)_"^"_PRC("FY")_"^"_PRC("BBFY"),PRC("APP")=$P($$ACC^PRC0C(PRC("SITE"),I),"^",11)
36 S PRCFC(8)=PRC("APP"),PRCFC(9)=$P($P(TRDA(0),U,1),"-",3) F I=1:1:4 S PRCFC(I+3)=$P(TRDA(0),U,I+6)
37 F PRCFK=1:1:4 I PRCFC(PRCFK+3)'="",$P($G(^PRCF(421,PRCB("TRDA"),4)),U,PRCFK+6)="" S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRCFK_"-"_PRCFC(2),X=$P(Z,"-",1,2)_"-"_PRCFC(2),PRCB("CK")=1 D EN1 Q:$D(PRCFA("QUIT"))
38 K PRCFK,PRCFC Q
39REL ;KILL NON RELEASE INDICATOR, ENCODE RELEASER AND MARK TRANSACTION
40 S DA=PRCB("TRDA") K PRCB("CK"),^PRCF(421,"AL",PRCF("SIFY"),1,DA) S ^PRCF(421,"AL",PRCF("SIFY"),2,DA)="",$P(^PRCF(421,DA,0),"^",20)=2
41 S $P(^PRCF(421,DA,0),"^",18)=DT
42 S MESSAGE=""
43 D ENCODE^PRCBES1(DA,DUZ,.MESSAGE)
44 K MESSAGE
45 D ^PRCBBUL
46 W !,"Trans #: ",$P(^PRCF(421,DA,0),U),?21,"FCP: ",$E($P(^PRC(420,PRC("SITE"),1,PRCB("CP"),0),U),1,15)
47 F II=1:1:4 I $P(^PRCF(421,DA,0),U,II+6)]"" W ?43,"QTR: ",II,$P("ST,ND,RD,TH",",",II),?52,"AMT: ",$J($P(^(0),U,II+6),12,2)," Released.",!
48 Q
49EN1 D EN1^PRCSUT3 G:'X W4 S X1=X
50EN2 S DLAYGO=410,DIC=410,DIC(0)="MXLZ" D ^DIC G:Y<0 W5 S DA=+Y S $P(^PRCF(421,PRCB("TRDA"),4),U,PRCFK+6)=DA
51 S ^PRCS(410,DA,0)=^PRCS(410,DA,0)_"^C^^^"_PRCFC(1),^(4)="^^"_PRCFC(PRCFK+3)_"^"_$P($$DATE^PRC0C("T","E"),"^",7)_"^^^^"_PRCFC(PRCFK+3),^(6)=PRCFC(PRCFK+3)_U_PRCFC(3)_U_PRCFC(9),^(3)=PRCFC_U_PRCFC(8)
52 S ^PRCS(410,"AN",$E(PRCFC,1,30),DA)=""
53 S U="^"
54 S PRCF(7)=U_U_U_$P(PRC("PER"),U,3)_U_$P(PRCFTIME,".")_U_U_PRCFTIME
55 S ^PRCS(410,DA,7)=PRCF(7)
56 K PRCF(7)
57 S MESSAGE=""
58 D ENCODE^PRCSC1(DA,DUZ,.MESSAGE)
59 K MESSAGE
60 S PRC("BBFY")=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRCB("CP"),1)
61 D EDIT^PRC0B(.X,"410;^PRCS(410,;"_DA,"28.5///^S X="_PRC("BBFY"),"LS")
62 D ERS410^PRC0G(DA_"^"_"O")
63 S PRCHOBL=1,X=PRCFC(PRCFK+3) D TRANS1^PRCSES K PRCHOBL
64 S %X="^PRCF(421,"_PRCB("TRDA")_",1,",%Y="^PRCS(410,DA,""CO""," D %XY^%RCR S PRCB("CK")=2 Q
65W4 W !!,"UNABLE TO MAKE ENTRY ",X," IN FILE 410.1, FURTHER PROCESSING TERMINATED. CONTACT YOUR SITE MANAGER." S PRCFA("QUIT")="" R X:2 Q
66W5 W !!,"UNABLE TO MAKE ENTRY ",X," IN FILE 410, FURTHER PROCESSING TERMINATED. CONTACT YOUR SITE MANAGER." S PRCFA("QUIT")="" R X:2 Q
67LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
68 L @("+"_DIC_DA_"):10") S PRSAL=$T Q:PRSAL'=0 I PRSAL=0 W !!,$C(7),"THIS ENTRY IS BEING EDITED BY ANOTHER USER. TRY LATER." Q
Note: See TracBrowser for help on using the repository browser.