Summary Table

Categories Total Count
PII 0
URL 0
DNS 0
EKL 0
IP 0
PORT 0
VsID 0
CF 0
AI 0
VPD 0
PL 0
Other 0

File Content

Cache for Windows^INT^WNS^^~Format=Cache.S~^RAW
%RO on 30 Aug 2018 05:58:26PM
PRCAFUT^INT^1^64890,64607.700853^0
PRCAFUT ;WASH-ISC@ALTOONA/CLH-FMS Utilities ;10/8/96 10:50 AM
V ;;4.5;Accounts Receivable;**5,39,64,92,104,169,188,194,220,231,315,338**;Mar 20, 1995;Build 67
;;Per VA Directive 6402, this routine should not be modified.
CPLK(PRCABN) ;get control point from file 430 and set DR string to edit CP data
N DR,X,Y,QUIT,FUND,FTBL,CAT,CATTYP,CATTYPE,CP,BBFY,EBFY,DIC,BGFY,CPTBL,CC,SCC,EXIT,FYERROR
K PRCA("EXIT")
S PRCA("SITE")=$S($G(PRCABN):$P($P($G(^PRCA(430,PRCABN,0)),"^"),"-"),1:$$SITE^RCMSITE)
S CP=$P($G(^PRCA(430,PRCABN,11)),U)
S CAT=+$P($G(^PRCA(430,PRCABN,0)),U,2),CATTYP=$P($G(^PRCA(430.2,CAT,0)),U,13)
I CAT>39,CAT<45 D G END
.S TYPE="09" D CHKELEM,REV Q:$G(PRCA("EXIT"))
.S DR="257///^S X=$G(PRCA(""SITE""))"
.;I CAT'=42 S DR=DR_";258////1"
.D DIE
.Q
I CAT=47 D G END ;315
.S TYPE="02",FUND="0160R1" ; patch PRCA*4.5*338
.S DR="259///"_TYPE_";203///^S X=FUND"
.D DIE
.Q
D TYPE Q:$D(PRCA("EXIT"))
I CATTYP=2 K PRCA("EXIT") D G END
. ;reibursement logic (if there is such a thing)
. S DR="203" D DIE K DR I $D(Y) Q
. I '$D(FUND) S FUND=$P($G(^PRCA(430,PRCABN,11)),U,17) D I FUND=-1 S PRCA("EXIT")="" Q
.. N X,Y,DIC
.. S X=FUND,DIC="^PRCD(420.14,",DIC(0)="XMNZ",DIC("B")=FUND D ^DIC
.. I +Y<0 D FUND^PRCAFBDU D Q:FUND=-1
... S DIC="^PRCD(420.14,",DIC(0)="AEMNQZ",DIC("A")="FUND: ",DIC("B")=FUND
... D ^DIC
... S:+Y<0 FUND=-1 Q
.. S FUND=Y
.. S BBFY=$E($P(Y(0),U,3),3,4),EBFY=$E($P(Y(0),U,4),3,4)
..Q
.S PRCABN(1)=$O(^PRCA(430,+PRCABN,2,0))
.S PRCABN(2)=$G(^PRCA(430,+PRCABN,2,PRCABN(1),0))
.S PRCABN(4)=+$G(PRCABN(2))
.S X=BBFY D ^%DT S PRCABN(3)=$E(Y,1,3)
.K ^PRCA(430,PRCABN,2,PRCABN(1),0)
.K ^PRCA(430,PRCABN,2,"B",PRCABN(4),PRCABN(1))
.S ^PRCA(430,PRCABN,2,PRCABN(3),0)=PRCABN(2)
.S $P(^PRCA(430,PRCABN,2,PRCABN(3),0),"^")=BBFY
.S ^PRCA(430,PRCABN,2,"B",BBFY,PRCABN(3))=""
.D DOCREQ^PRC0C(+FUND,"REV","FTBL")
. I '$D(FTBL) S PRCA("EXIT")=1 D Q
.. W !,*7,"FMS REQUIRED FIELDS missing. Edit the IFCAP REQUIRED FIELDS table",!,"for FUND/FY combination."
.. Q
. S DR="259////^S X=CAT;257////^S X=$G(PRCA(""SITE""));201////^S X=BBFY;202////^S X=$S($G(EBFY)'=BBFY:EBFY,1:"""")"
. D DR
. Q
;Ask Beginning/end budget fiscal year
D FY^PRCAFUT1
I $D(FYERROR) S PRCA("EXIT")=1 Q
;S BGFY=$P(^PRCA(430,PRCABN,0),U,10),BGFY=$$FY^RCFN01(BGFY)
S DR="250;I '$D(CPTBL) D CPTBL^PRCAFUT;259////^S X=CAT;204////^S X=$P(CPTBL,U);206////^S X=$P(CPTBL,U,3)"
S DR=DR_";203////^S X=$P(CPTBL,U,5);201////^S X=$E($P(CPTBL,U,6),3,4)"
S DR(1,430,1)="202////^S X=$S($P(CPTBL,U,7)'=$P(CPTBL,U,6):$E($P(CPTBL,U,7),3,4),1:"""")"
S DR(1,430,2)="261////^S X=$P(CPTBL,U,10)"
S DA=PRCABN D ^DIE K DR
I $D(Y) S PRCA("EXIT")=1 Q
K DR
D FTBL Q:'$D(FTBL)
S (X,PRCABN(1))=$E($P(CPTBL,U,6),3,4)
D ^%DT S PRCABN(2)=$E(Y,1,3)
S PRCABN(3)=$O(^PRCA(430,+PRCABN,2,0))
S PRCABN(4)=$G(^PRCA(430,+PRCABN,2,PRCABN(3),0))
S PRCABN(5)=$E(PRCABN(4),1,2)
K ^PRCA(430,PRCABN,2,PRCABN(3),0)
K ^PRCA(430,PRCABN,2,"B",PRCABN(5),PRCABN(3))
S ^PRCA(430,PRCABN,2,PRCABN(2),0)=PRCABN(4)
S $P(^PRCA(430,PRCABN,2,PRCABN(2),0),"^")=PRCABN(1)
S ^PRCA(430,PRCABN,2,"B",PRCABN(1),PRCABN(2))=""
S $P(^PRCA(430,PRCABN,2,0),"^",3)=PRCABN(2)
Q
FTBL S FUND=$$FUND^PRC0C($P(CPTBL,U,5),$P(CPTBL,U,6))
D DOCREQ^PRC0C(+FUND,"SPE","FTBL")
I '$D(FTBL) W !!,*7,"UNABLE TO GET FMS-LINE FUND ACCOUNTING INFORMATION. CHECK CONTROL POINT." H 5 S PRCA("EXIT")=1 Q
S DR="257////^S X=$G(PRCA(""SITE""))"
DR I $$INTEG^RCFN01($G(PRCA("SITE"))) S DR=DR_";260"
I $G(FTBL("AO"))="Y" S DR=DR_";204"
I $G(FTBL("FCPRJ"))="Y" S DR=DR_";I '$D(CPTBL) D CPTBL^PRCAFUT;206////^S X=$P(CPTBL,U,3)"
I $G(FTBL("CC"))="Y" S DR=DR_";251;252////^S X=$G(SCC)"
I $G(FTBL("BOC"))="Y" S DR=DR_";253"
I $G(FTBL("SBOC"))="Y"!(CAT=20) S DR=DR_";254"
I $G(FTBL("JOB"))="Y" S DR=DR_";261"
I $G(FTBL("RC"))="Y" S DR=DR_";263"
I $G(FTBL("REV"))="Y" D DIE Q:$G(PRCA("EXIT")) D REV Q:$G(PRCA("EXIT"))
I $G(FTBL("SREV"))="Y" S DR=$S(DR="":"256",1:DR_";256")
I $G(FTBL("OC"))="Y" S DR=$S(DR="":"205",1:DR_";205")
I DR'="" D DIE
Q
DIE S DA=PRCABN,DIE="^PRCA(430," D ^DIE
END I $D(Y) S PRCA("EXIT")=1
K DR Q
;
RECTYP(BN) ;Refund or reimbursement
I '$D(BN),'$D(^PRCA(430,BN,0)) Q -1
Q $P($G(^PRCA(430,BN,11)),U,10)
;
REV ;lookup revenue by calling "C" xref
N DS,DIC,DIBTDH,HELP,I,IAT,OUT,RV,X,Y
S OUT=0,RV=$P($G(^PRCA(430,PRCABN,11)),U,6)
F D Q:OUT
.W !,"REVENUE SOURCE: "_$S(RV'="":RV_"// ",1:"") R X:DTIME
.I $E(X)="?",X?."?" D @($S($L(X)=1:"REVH1",1:"REVH2")) S DIC=347.3,DIC(0)="QE" D ^DIC Q:Y<1 Q
.I $E(X)="^",X?."^" S OUT=1,PRCA("EXIT")=1 Q
.I X="@" W "?? Required" Q
.I X="",RV'="" S OUT=1 Q
.I X="",RV="" W "??" D REVH1 Q
.I $D(^RC(347.3,"B",X)) D Q
..S DS=$P($G(^RC(347.3,+$O(^RC(347.3,"B",X,0)),0)),U,2),IAT=$P(^(0),U,3)
..W " "_DS W:IAT " INACTIVE" D REVDIE
.S DIC="^RC(347.3,",DIC(0)="QE",D="C" D IX^DIC I Y<1 D REVH1 Q
.S X=$P(Y,U,2) D REVDIE
S DR=""
Q
REVDIE S DA=PRCABN,DIE="^PRCA(430,",DR="255///"_X D ^DIE I $G(X)'="" S OUT=1 Q
D REVH1 Q
REVH1 S HELP("DIHELP",1)=$G(^DD(430,255,3)) D MSG^DIALOG("WH","",70,5,"HELP") Q
REVH2 D HELP^DIE(430,"",255,"D","HELP"),MSG^DIALOG("WH","",70,8,"HELP") Q
;
FUND ;get fund
N DIC,Y
S DIC="^PRCD(420.14,",DIC(0)="EMNQZ"
D ^DIC
I $D(DUOUT)!$D(DTOUT) S PRCA("EXIT")=1 Q
Q:+Y<0
S FUND=Y
S BBFY=$E($P(Y(0),U,3),3,4),EBFY=$E($P(Y(0),U,4),3,4)
Q
;
DISPLACC ;display account information
Q:'$D(PRCABN) NEW DIC,L,FR,TO,FLDS,IOP,X
R !!,"Press <RETURN> to continue: ",X:60
I X["^" S PRCA("EXIT")="" Q
S IOP=IO(0),DIC="^PRCA(430,",FLDS="[PRCA DISP AUDIT2]",(FR,TO)=PRCABN,L=0,BY="@NUMBER" D EN1^DIP
Q
;
CP ;lookup control point
N DIC
S DIC="^PRC(420,"_$S($D(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE)_",1,",DIC(0)="EMNQ",X=CP
D ^DIC
I +Y<0 K X,CP Q
S CP=+Y
Q
;
CC ;cost center
G CC^PRCAFBDU
;
BOC ;budget object code
G BOC^PRCAFBDU
;
TYPE ;ask if bill is a refund or reimbursement
W !!,"Building FMS Accounting Elements...",!
N DIR,Y,TYPE
I +$G(CAT)=1 S CAT="02",CATTYPE=2 D CHKELEM Q
I +$G(CAT)=10 S CAT=50,CATTYPE=2 D CHKELEM Q
I +$G(CAT)=47 S CAT="02" Q
D BDTRANS^PRCAFBDU
Q:$D(PRCA("EXIT"))
S CATTYP=$S(TYPE="01":"1",TYPE="20":"1",1:"2")
S CAT=TYPE ; I CAT>2 S CAT=$S(CAT=4:"20",1:"9")
D CHKELEM
Q
;
CHKELEM ;check for correct accounting line data
N I
Q:'$D(^PRCA(430,PRCABN,11))
I $G(CATTYP)=1 D Q
. F I=6,7 S $P(^PRCA(430,PRCABN,11),U,I)=""
. Q
Q:$G(TYPE)=10
F I=1:1:5,11:1:16,18:1:21 S $P(^PRCA(430,PRCABN,11),U,I)=""
S $P(^PRCA(430,PRCABN,11),U,15)="05"
Q
CPTBL ;build CP table
S:'$D(BGFY) BGFY=$$FY^RCFN01(DT)
S BGFY(1)=$S(BGFY>50:19,1:20)
S CPTBL=$$ACC^PRC0C($G(PRCA("SITE")),+CP_U_BGFY_U_BGFY(1)_BGFY)
I '$D(CPTBL) S CPTBL=""
Q
;
CPHLP ;executable help for cp prompt
N DIC,X,Y
S DIC="^PRC(420,"_$S($D(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE)_",1,",DIC(0)="EMQ",X="?" D ^DIC
Q
;
FND(BILL) ;Get fund for a bill
I '$D(^PRCA(430,BILL,0)) Q -1
I $D(^PRCA(430,BILL,11)),$P(^(11),"^",17)'="" Q $P(^(11),"^",17)
I $P(^PRCA(430,BILL,0),"^",18)'="" Q $E($P(^(0),"^",18),4,9)
Q -1
;