69 lines
4.3 KiB
Mathematica
69 lines
4.3 KiB
Mathematica
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
|