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

PRCBR1 ;WISC@ALTOONA/CTB-ROUTINE TO RELEASE TRANSACTIONS FROM FUND DISTRIBUTION FILE ; 01/31/94  4:06 PM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
SE ;DIRECT ENTRY POINT, UN QUEUED
 I $D(ZTQUEUED) D KILL^%ZTLOAD
 S X="BUDGET RELEASE" D ^PRCFALCK I '% D REQUE Q
SE1 D NOW^%DTC S DT=X S:'$D(PRCFTIME) PRCFTIME=%
 D DUZ^PRCFSITE G:'% OUT
 I '$D(^PRCF(421,"AL",PRCF("SIFY"),1)) W !!,"FUND DISTRIBUTION RELEASE ABORTED.  NO TRANSACTIONS FOUND FOR STATION NUMBER "_PRC("SITE")_"." G OUT
 W:$D(IOF) @IOF W "Beginning transaction release...",!!
C S U="^" K ^PRCF(421,"AI",1),^TMP("PRCB",$J,"CP",2) S DA=0
 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"))
 G:$D(PRCFA("QUIT")) OUT S PRCB("CP")=9999 D LOAD
OUT 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
 D EN^DDIOL("End of Released Transactions List **************")
 S X="BUDGET RELEASE" D UNLOCK^PRCFALCK Q
REQUE I '$D(ZTQUEUED) W !!,$C(7),"Try releasing at a later time." Q
 S ZTIO=$S($D(PRCFA("NOPRINT")):"@",1:IO) D REQ^%ZTLOAD
 Q
A ;PROCEDURE TO DETERMINE IF CONTROL POINT IS AUTOMATED  D B IF IT IS, A1 IF ITIS NOT
 S PRCB("CK")=0,PRCB("CP")=+($P(TRDA(0),U,2)),PRC("SITE")=+TRDA(0),PRC("FY")=$P(TRDA(0),"-",2)
 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
 D LOAD
 S DA=PRCB("TRDA")
 S MESSAGE=""
 D ENCODE^PRCBES1(DA,DUZ,.MESSAGE)
 K MESSAGE
 D REL
 Q
LOAD ;LOAD ALL TRANSACTIONS FOR A SPECIFIC CONTROL POINT INTO THE 'ON PRINT LIST FIELD AND CROSS REFERENCE
 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
 Q
B ;RELEASE INDIVIDUAL SEQUENCE NUMBER
 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)
 S I=PRCFC(2)_"^"_PRC("FY")_"^"_PRC("BBFY"),PRC("APP")=$P($$ACC^PRC0C(PRC("SITE"),I),"^",11)
 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)
 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"))
 K PRCFK,PRCFC Q
REL ;KILL NON RELEASE INDICATOR, ENCODE RELEASER AND MARK TRANSACTION
 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
 S $P(^PRCF(421,DA,0),"^",18)=DT
 S MESSAGE=""
 D ENCODE^PRCBES1(DA,DUZ,.MESSAGE)
 K MESSAGE
 D ^PRCBBUL
 W !,"Trans #: ",$P(^PRCF(421,DA,0),U),?21,"FCP: ",$E($P(^PRC(420,PRC("SITE"),1,PRCB("CP"),0),U),1,15)
 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.",!
 Q
EN1 D EN1^PRCSUT3 G:'X W4 S X1=X
EN2 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
 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)
 S ^PRCS(410,"AN",$E(PRCFC,1,30),DA)=""
 S U="^"
 S PRCF(7)=U_U_U_$P(PRC("PER"),U,3)_U_$P(PRCFTIME,".")_U_U_PRCFTIME
 S ^PRCS(410,DA,7)=PRCF(7)
 K PRCF(7)
 S MESSAGE=""
 D ENCODE^PRCSC1(DA,DUZ,.MESSAGE)
 K MESSAGE
 S PRC("BBFY")=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRCB("CP"),1)
 D EDIT^PRC0B(.X,"410;^PRCS(410,;"_DA,"28.5///^S X="_PRC("BBFY"),"LS")
 D ERS410^PRC0G(DA_"^"_"O")
 S PRCHOBL=1,X=PRCFC(PRCFK+3) D TRANS1^PRCSES K PRCHOBL
 S %X="^PRCF(421,"_PRCB("TRDA")_",1,",%Y="^PRCS(410,DA,""CO""," D %XY^%RCR S PRCB("CK")=2 Q
W4 W !!,"UNABLE TO MAKE ENTRY ",X," IN FILE 410.1, FURTHER PROCESSING TERMINATED.  CONTACT YOUR SITE MANAGER." S PRCFA("QUIT")="" R X:2 Q
W5 W !!,"UNABLE TO MAKE ENTRY ",X," IN FILE 410, FURTHER PROCESSING TERMINATED. CONTACT YOUR SITE MANAGER." S PRCFA("QUIT")="" R X:2 Q
LOCK ;LOCK GLOBAL THAT IS BEING ACCESSED BY ANOTHER USER
 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