PRCAFBDU ;WASH-ISC@ALTOONA,PA/CLH-FMS Billing Document Utilities ;6/27/96 11:48 AM
V ;;4.5;Accounts Receivable;**2,16,29,42,168,169,204,198,358**;Mar 20, 1995;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
;PRCA*4.5*358 Modify FCP Cost Center verification to use
; all defined cost centers attached to FCP.
;
BDGEN ;regenerate billing document
N Y,ID,REFMS
EN N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S DIC="^PRCA(430,",DIC(0)="AEMNQZ",DIC("A")="Select BILL NUMBER: "
D ^DIC K DIC Q:+Y<0
I $$GSTAT^RCFMFN02("B"_+Y)'=3 W !!,*7,"You CANNOT resend a document that has NOT REJECTED in FMS.",!! G EN
S PRCABN=+Y
S DIR(0)="Y",DIR("A")="Are you sure",DIR("A",1)="This will RESEND the selected Billing Document to FMS.",DIR("B")="NO" D ^DIR K DIR
W ! G:+Y'=1 EN
;Setting variable REFMS flags for retransmission of document and will
;have a date of DT for transmission to FMS.
S REFMS=1 D RSEND
G EN
RSEND S FMSNUM="B"_PRCABN
D DEL^RCFMFN02(FMSNUM)
K FMSNUM
D EN^PRCAFBD(PRCABN)
K PRCABN
Q
;
BDMGEN ;regenerate modified billing document
N Y,DIC,BN,AMT,ADJTYO,TDT,TN,ERR,REFMS
EN2 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S DIC="^PRCA(433,",DIC(0)="AEMNQZ",DIC("A")="Select A/R TRANSACTION NUMBER: " D ^DIC
Q:+Y<0
I $$GSTAT^RCFMFN02("T"_+Y)'=3 W !!,*7,"You CANNOT resend a document that has NOT REJECTED in FMS.",!! G EN2
S TN=+Y,BN=$P(^PRCA(433,TN,0),U,2),TDT=$P(^(1),U),ADJTYP=$P(^(1),U,2),AMT=$P(^(1),U,5)
S DIR(0)="Y",DIR("A")="Are you sure",DIR("A",1)="This will RESEND the selected Billing Document to FMS.",DIR("B")="NO" D ^DIR K DIR
W ! G:+Y'=1 EN2
S FMSNUM="T"_TN,REFMS=1
D DEL^RCFMFN02(FMSNUM)
K FMSNUM
D EN^PRCAFBDM(BN,AMT,ADJTYP,TDT,TN,.ERR)
G EN2
;
;
CC ;cost center PRCA*4.5*358
N DIC,Y
D COST^PRCSREC2($S($D(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE),CP)
S DIC="^PRCD(420.1,",DIC(0)="EMNQ",DIC("A")="COST CENTER: "
D ^DIC Q:+Y<0
I $D(DUOUT)!($D(DTOUT)) S PRCA("EXIT")=1 Q
I '$D(^TMP($J,"PRCCC",$P(Y,U))) W !!,*7,"Invalid Cost Center for the Control Point" D CCDISP Q ;PRCA*4.5*358
S CCC=+Y,CC=$E(+Y,1,4)_"00",SCC=$E(+Y,5,6)
K ^TMP("PRCCC",$J) ;PRCA*4.5*358
Q
;
BOC ;budget object code
N DIC,Y
I '$D(CCC) S CCC=$P($G(^PRCA(430,$S($D(PRCABN):PRCABN,$D(DA):DA,1:-1),11)),U,2)
S DIC="^PRCD(420.2,",DIC(0)="EMNQ"
D ^DIC Q:+Y<0
I $D(DUOUT)!($D(DTOUT)) S PRCA("EXIT")=1 Q
I +CCC>0,'$D(^PRCD(420.1,CCC,1,+Y,0)) S Y=-1 Q
S BOC=+Y
Q
;
CCDISP ;display valid cost centers for FCP
N DIC,X,Y
S X="?"
S DIC="^PRC(420,"_$S($D(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE)_",1,"_+CP_",2,"
S DIC("S")="I '$P($G(^PRCD(420.1,+Y,0)),U,2)"
S DIC(0)="EMNQ"
D ^DIC
Q
;
BOCDISP ;display valid BOCs
N ZZDA,DIC,X,Y
S:'$D(CCC) CCC=$P($G(^PRCA(430,$S($D(PRCABN):PRCABN,1:$G(DA)),11)),U,2)
S DIC="^PRCD(420.1,"_+CCC_",1,",DIC(0)="EMNQ",X="?"
W ?10,!!,"Valid BOCs for this Cost Center are:",!
D ^DIC
Q
;
RHLP ;help for refund/reimbursement prompt
W !!,"If this BILL will create a receivable for a budget element, i.e. Control Point,",!,"Answer REFUND. Otherwise answer REIMBURSEMENT.",!!,"A REFUND will ALWAYS reference a Control Point, i.e. SALARY OVERPAYMENT."
W !,"A REIMBURSEMENT is usually for services, i.e. Emergency/Humanitarian Care.",!!
Q
;
ACCT ;edit accounting line information on rejected documents
NEW BILL,DIE,DA,PRCABN,DIC,X,Y,L,FR,TO,FLDS,DIR,REFMS
ACCT1 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
SET (DIC,DIE)="^PRCA(430,",DIC(0)="AEMNQ",DIC("A")="Select BILL NUMBER: " DO ^DIC
QUIT:+Y<0
I '$P($G(^PRCA(430,+Y,6)),"^",21) W !,"YOU CAN ONLY SELECT BILLS THAT ARE ACTIVE.",! G ACCT1
I $D(RCONVERT) S PRCABN=+Y G EDT
SET BILL="B"_+Y
SET PRCABN=+Y
EDT SET IOP=IO(0),DIC="^PRCA(430,",FLDS="[PRCA DISP AUDIT2]",(FR,TO)=PRCABN,L=0,BY="@NUMBER" DO EN1^DIP
SET (DIC,DIE)="^PRCA(430,"
DO CPLK^PRCAFUT(PRCABN)
QUIT:$D(PRCA("EXIT"))
;DO:'$DATA(RCONVERT) RSEND
I '$D(RCONVERT) S REFMS=1 D RSEND
G ACCT
;
FUND ;valid fund seletion
NEW DIC,X,Y
S DIC(0)="EMNQ",DIC="^PRCD(420.14,",X="?"
D ^DIC
Q
SBOC ;remove SUB BOC from rejected bills
N DIE,DA,DIC,DR
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S (DIC,DIE)="^PRCA(430,",DIC(0)="AEMNQ" D ^DIC
Q:+Y<0
S DA=+Y
S DR="254///^S X=""@""" D ^DIE
W !,"SUB BOC removed.",!
Q
;
BDTRANS ;Select trans type for billing documents
N DIC,DA,X,Y
S DIC="^PRCA(347.4,",DIC(0)="AEMNQ",DIC("A")="Select TRANS. TYPE: ",DIC("S")="I $P(^(0),U,2)=1" D ^DIC
I +Y<0 S PRCA("EXIT")=1 Q
S TYPE=$P(Y,U,2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAFBDU 4594 printed Oct 16, 2024@17:40:21 Page 2
PRCAFBDU ;WASH-ISC@ALTOONA,PA/CLH-FMS Billing Document Utilities ;6/27/96 11:48 AM
V ;;4.5;Accounts Receivable;**2,16,29,42,168,169,204,198,358**;Mar 20, 1995;Build 19
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;PRCA*4.5*358 Modify FCP Cost Center verification to use
+4 ; all defined cost centers attached to FCP.
+5 ;
BDGEN ;regenerate billing document
+1 NEW Y,ID,REFMS
EN NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+1 SET DIC="^PRCA(430,"
SET DIC(0)="AEMNQZ"
SET DIC("A")="Select BILL NUMBER: "
+2 DO ^DIC
KILL DIC
if +Y<0
QUIT
+3 IF $$GSTAT^RCFMFN02("B"_+Y)'=3
WRITE !!,*7,"You CANNOT resend a document that has NOT REJECTED in FMS.",!!
GOTO EN
+4 SET PRCABN=+Y
+5 SET DIR(0)="Y"
SET DIR("A")="Are you sure"
SET DIR("A",1)="This will RESEND the selected Billing Document to FMS."
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+6 WRITE !
if +Y'=1
GOTO EN
+7 ;Setting variable REFMS flags for retransmission of document and will
+8 ;have a date of DT for transmission to FMS.
+9 SET REFMS=1
DO RSEND
+10 GOTO EN
RSEND SET FMSNUM="B"_PRCABN
+1 DO DEL^RCFMFN02(FMSNUM)
+2 KILL FMSNUM
+3 DO EN^PRCAFBD(PRCABN)
+4 KILL PRCABN
+5 QUIT
+6 ;
BDMGEN ;regenerate modified billing document
+1 NEW Y,DIC,BN,AMT,ADJTYO,TDT,TN,ERR,REFMS
EN2 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+1 SET DIC="^PRCA(433,"
SET DIC(0)="AEMNQZ"
SET DIC("A")="Select A/R TRANSACTION NUMBER: "
DO ^DIC
+2 if +Y<0
QUIT
+3 IF $$GSTAT^RCFMFN02("T"_+Y)'=3
WRITE !!,*7,"You CANNOT resend a document that has NOT REJECTED in FMS.",!!
GOTO EN2
+4 SET TN=+Y
SET BN=$PIECE(^PRCA(433,TN,0),U,2)
SET TDT=$PIECE(^(1),U)
SET ADJTYP=$PIECE(^(1),U,2)
SET AMT=$PIECE(^(1),U,5)
+5 SET DIR(0)="Y"
SET DIR("A")="Are you sure"
SET DIR("A",1)="This will RESEND the selected Billing Document to FMS."
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+6 WRITE !
if +Y'=1
GOTO EN2
+7 SET FMSNUM="T"_TN
SET REFMS=1
+8 DO DEL^RCFMFN02(FMSNUM)
+9 KILL FMSNUM
+10 DO EN^PRCAFBDM(BN,AMT,ADJTYP,TDT,TN,.ERR)
+11 GOTO EN2
+12 ;
+13 ;
CC ;cost center PRCA*4.5*358
+1 NEW DIC,Y
+2 DO COST^PRCSREC2($SELECT($DATA(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE),CP)
+3 SET DIC="^PRCD(420.1,"
SET DIC(0)="EMNQ"
SET DIC("A")="COST CENTER: "
+4 DO ^DIC
if +Y<0
QUIT
+5 IF $DATA(DUOUT)!($DATA(DTOUT))
SET PRCA("EXIT")=1
QUIT
+6 ;PRCA*4.5*358
IF '$DATA(^TMP($JOB,"PRCCC",$PIECE(Y,U)))
WRITE !!,*7,"Invalid Cost Center for the Control Point"
DO CCDISP
QUIT
+7 SET CCC=+Y
SET CC=$EXTRACT(+Y,1,4)_"00"
SET SCC=$EXTRACT(+Y,5,6)
+8 ;PRCA*4.5*358
KILL ^TMP("PRCCC",$JOB)
+9 QUIT
+10 ;
BOC ;budget object code
+1 NEW DIC,Y
+2 IF '$DATA(CCC)
SET CCC=$PIECE($GET(^PRCA(430,$SELECT($DATA(PRCABN):PRCABN,$DATA(DA):DA,1:-1),11)),U,2)
+3 SET DIC="^PRCD(420.2,"
SET DIC(0)="EMNQ"
+4 DO ^DIC
if +Y<0
QUIT
+5 IF $DATA(DUOUT)!($DATA(DTOUT))
SET PRCA("EXIT")=1
QUIT
+6 IF +CCC>0
IF '$DATA(^PRCD(420.1,CCC,1,+Y,0))
SET Y=-1
QUIT
+7 SET BOC=+Y
+8 QUIT
+9 ;
CCDISP ;display valid cost centers for FCP
+1 NEW DIC,X,Y
+2 SET X="?"
+3 SET DIC="^PRC(420,"_$SELECT($DATA(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE)_",1,"_+CP_",2,"
+4 SET DIC("S")="I '$P($G(^PRCD(420.1,+Y,0)),U,2)"
+5 SET DIC(0)="EMNQ"
+6 DO ^DIC
+7 QUIT
+8 ;
BOCDISP ;display valid BOCs
+1 NEW ZZDA,DIC,X,Y
+2 if '$DATA(CCC)
SET CCC=$PIECE($GET(^PRCA(430,$SELECT($DATA(PRCABN):PRCABN,1:$GET(DA)),11)),U,2)
+3 SET DIC="^PRCD(420.1,"_+CCC_",1,"
SET DIC(0)="EMNQ"
SET X="?"
+4 WRITE ?10,!!,"Valid BOCs for this Cost Center are:",!
+5 DO ^DIC
+6 QUIT
+7 ;
RHLP ;help for refund/reimbursement prompt
+1 WRITE !!,"If this BILL will create a receivable for a budget element, i.e. Control Point,",!,"Answer REFUND. Otherwise answer REIMBURSEMENT.",!!,"A REFUND will ALWAYS reference a Control Point, i.e. SALARY OVERPAYMENT."
+2 WRITE !,"A REIMBURSEMENT is usually for services, i.e. Emergency/Humanitarian Care.",!!
+3 QUIT
+4 ;
ACCT ;edit accounting line information on rejected documents
+1 NEW BILL,DIE,DA,PRCABN,DIC,X,Y,L,FR,TO,FLDS,DIR,REFMS
ACCT1 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+1 SET (DIC,DIE)="^PRCA(430,"
SET DIC(0)="AEMNQ"
SET DIC("A")="Select BILL NUMBER: "
DO ^DIC
+2 if +Y<0
QUIT
+3 IF '$PIECE($GET(^PRCA(430,+Y,6)),"^",21)
WRITE !,"YOU CAN ONLY SELECT BILLS THAT ARE ACTIVE.",!
GOTO ACCT1
+4 IF $DATA(RCONVERT)
SET PRCABN=+Y
GOTO EDT
+5 SET BILL="B"_+Y
+6 SET PRCABN=+Y
EDT SET IOP=IO(0)
SET DIC="^PRCA(430,"
SET FLDS="[PRCA DISP AUDIT2]"
SET (FR,TO)=PRCABN
SET L=0
SET BY="@NUMBER"
DO EN1^DIP
+1 SET (DIC,DIE)="^PRCA(430,"
+2 DO CPLK^PRCAFUT(PRCABN)
+3 if $DATA(PRCA("EXIT"))
QUIT
+4 ;DO:'$DATA(RCONVERT) RSEND
+5 IF '$DATA(RCONVERT)
SET REFMS=1
DO RSEND
+6 GOTO ACCT
+7 ;
FUND ;valid fund seletion
+1 NEW DIC,X,Y
+2 SET DIC(0)="EMNQ"
SET DIC="^PRCD(420.14,"
SET X="?"
+3 DO ^DIC
+4 QUIT
SBOC ;remove SUB BOC from rejected bills
+1 NEW DIE,DA,DIC,DR
+2 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+3 SET (DIC,DIE)="^PRCA(430,"
SET DIC(0)="AEMNQ"
DO ^DIC
+4 if +Y<0
QUIT
+5 SET DA=+Y
+6 SET DR="254///^S X=""@"""
DO ^DIE
+7 WRITE !,"SUB BOC removed.",!
+8 QUIT
+9 ;
BDTRANS ;Select trans type for billing documents
+1 NEW DIC,DA,X,Y
+2 SET DIC="^PRCA(347.4,"
SET DIC(0)="AEMNQ"
SET DIC("A")="Select TRANS. TYPE: "
SET DIC("S")="I $P(^(0),U,2)=1"
DO ^DIC
+3 IF +Y<0
SET PRCA("EXIT")=1
QUIT
+4 SET TYPE=$PIECE(Y,U,2)
+5 QUIT
+6 ;
