source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAFBDU.m@ 738

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1PRCAFBDU ;WASH-ISC@ALTOONA,PA/CLH-FMS Billing Document Utilities ;6/27/96 11:48 AM
2V ;;4.5;Accounts Receivable;**2,16,29,42,168,169,204,198**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4BDGEN ;regenerate billing document
5 N Y,ID,REFMS
6EN N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
7 S DIC="^PRCA(430,",DIC(0)="AEMNQZ",DIC("A")="Select BILL NUMBER: "
8 D ^DIC K DIC Q:+Y<0
9 I $$GSTAT^RCFMFN02("B"_+Y)'=3 W !!,*7,"You CANNOT resend a document that has NOT REJECTED in FMS.",!! G EN
10 S PRCABN=+Y
11 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
12 W ! G:+Y'=1 EN
13 ;Setting variable REFMS flags for retransmission of document and will
14 ;have a date of DT for transmission to FMS.
15 S REFMS=1 D RSEND
16 G EN
17RSEND S FMSNUM="B"_PRCABN
18 D DEL^RCFMFN02(FMSNUM)
19 K FMSNUM
20 D EN^PRCAFBD(PRCABN)
21 K PRCABN
22 Q
23 ;
24BDMGEN ;regenerate modified billing document
25 N Y,DIC,BN,AMT,ADJTYO,TDT,TN,ERR,REFMS
26EN2 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
27 S DIC="^PRCA(433,",DIC(0)="AEMNQZ",DIC("A")="Select A/R TRANSACTION NUMBER: " D ^DIC
28 Q:+Y<0
29 I $$GSTAT^RCFMFN02("T"_+Y)'=3 W !!,*7,"You CANNOT resend a document that has NOT REJECTED in FMS.",!! G EN2
30 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)
31 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
32 W ! G:+Y'=1 EN2
33 S FMSNUM="T"_TN,REFMS=1
34 D DEL^RCFMFN02(FMSNUM)
35 K FMSNUM
36 D EN^PRCAFBDM(BN,AMT,ADJTYP,TDT,TN,.ERR)
37 G EN2
38 ;
39 ;
40CC ;cost center
41 N DIC,Y
42 S CCC=$$COST^PRCSREC2($S($D(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE),CP)
43 S DIC="^PRCD(420.1,",DIC(0)="EMNQ",DIC("A")="COST CENTER: "
44 D ^DIC Q:+Y<0
45 I $D(DUOUT)!($D(DTOUT)) S PRCA("EXIT")=1 Q
46 I CCC'[$P(Y,U) W !!,*7,"Invalid Cost Center for the Control Point" D CCDISP Q
47 S CCC=+Y,CC=$E(+Y,1,4)_"00",SCC=$E(+Y,5,6)
48 Q
49 ;
50BOC ;budget object code
51 N DIC,Y
52 I '$D(CCC) S CCC=$P($G(^PRCA(430,$S($D(PRCABN):PRCABN,$D(DA):DA,1:-1),11)),U,2)
53 S DIC="^PRCD(420.2,",DIC(0)="EMNQ"
54 D ^DIC Q:+Y<0
55 I $D(DUOUT)!($D(DTOUT)) S PRCA("EXIT")=1 Q
56 I +CCC>0,'$D(^PRCD(420.1,CCC,1,+Y,0)) S Y=-1 Q
57 S BOC=+Y
58 Q
59 ;
60CCDISP ;display valid cost centers
61 N DIC,X,Y
62 S:'$D(CCC) CCC=$$COST^PRCSREC2($S($D(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE),CP)
63 S X="?"
64 S DIC="^PRC(420,"_$S($D(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE)_",1,"_+CP_",2,"
65 S DIC(0)="EMNQ"
66 D ^DIC
67 Q
68 W !!,"Valid Cost Centers for this Control Point are:",!
69 F I=1:1:$L(CCC,U) W ?10,$E($P($G(^PRCD(420.1,$P(CCC,U,I),0)),U),1,40),!
70 Q
71 ;
72BOCDISP ;display valid BOCs
73 N ZZDA,DIC,X,Y
74 S:'$D(CCC) CCC=$P($G(^PRCA(430,$S($D(PRCABN):PRCABN,1:$G(DA)),11)),U,2)
75 S DIC="^PRCD(420.1,"_+CCC_",1,",DIC(0)="EMNQ",X="?"
76 W ?10,!!,"Valid BOCs for this Cost Center are:",!
77 D ^DIC
78 Q
79 ;
80RHLP ;help for refund/reimbursement prompt
81 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."
82 W !,"A REIMBURSEMENT is usually for services, i.e. Emergency/Humanitarian Care.",!!
83 Q
84 ;
85ACCT ;edit accounting line information on rejected documents
86 NEW BILL,DIE,DA,PRCABN,DIC,X,Y,L,FR,TO,FLDS,DIR,REFMS
87ACCT1 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
88 SET (DIC,DIE)="^PRCA(430,",DIC(0)="AEMNQ",DIC("A")="Select BILL NUMBER: " DO ^DIC
89 QUIT:+Y<0
90 I '$P($G(^PRCA(430,+Y,6)),"^",21) W !,"YOU CAN ONLY SELECT BILLS THAT ARE ACTIVE.",! G ACCT1
91 I $D(RCONVERT) S PRCABN=+Y G EDT
92 SET BILL="B"_+Y
93 SET PRCABN=+Y
94EDT SET IOP=IO(0),DIC="^PRCA(430,",FLDS="[PRCA DISP AUDIT2]",(FR,TO)=PRCABN,L=0,BY="@NUMBER" DO EN1^DIP
95 SET (DIC,DIE)="^PRCA(430,"
96 DO CPLK^PRCAFUT(PRCABN)
97 QUIT:$D(PRCA("EXIT"))
98 ;DO:'$DATA(RCONVERT) RSEND
99 I '$D(RCONVERT) S REFMS=1 D RSEND
100 G ACCT
101 ;
102FUND ;valid fund seletion
103 NEW DIC,X,Y
104 S DIC(0)="EMNQ",DIC="^PRCD(420.14,",X="?"
105 D ^DIC
106 Q
107SBOC ;remove SUB BOC from rejected bills
108 N DIE,DA,DIC,DR
109 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
110 S (DIC,DIE)="^PRCA(430,",DIC(0)="AEMNQ" D ^DIC
111 Q:+Y<0
112 S DA=+Y
113 S DR="254///^S X=""@""" D ^DIE
114 W !,"SUB BOC removed.",!
115 Q
116 ;
117BDTRANS ;Select trans type for billing documents
118 N DIC,DA,X,Y
119 S DIC="^PRCA(347.4,",DIC(0)="AEMNQ",DIC("A")="Select TRANS. TYPE: ",DIC("S")="I $P(^(0),U,2)=1" D ^DIC
120 I +Y<0 S PRCA("EXIT")=1 Q
121 S TYPE=$P(Y,U,2)
122 Q
123 ;
Note: See TracBrowser for help on using the repository browser.