source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAUDT1.m@ 1087

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1PRCAUDT1 ;SF-ISC/YJK-SUBROUTINE AUDIT A NEW BILL/EDIT INCOMPLETE AR ;5/1/95 3:05 PM
2V ;;4.5;Accounts Receivable;**1,173**;Mar 20, 1995
3 ;This audits a new bill and edits incomplete accounts receivables.
4 ;
5 ; DBIA for reference to file 399.3: DBIA4118
6 ;
7RETN S DR="36",DA=PRCABN,DIE="^PRCA(430," D ^DIE K DR,DIE,DA
8 S PRCA("STATUS")=$O(^PRCA(430.3,"AC",220,"")),PRCA("SDT")=DT,PRCASV("STATUS")=1 D UPSTATS^PRCAUT2 S $P(^PRCA(430,PRCABN,3),U,1)=DT,$P(^(3),U,2)=DUZ
9 W !,"THE BILL HAS BEEN RETURNED",! Q ;end of RETN
10 K DR Q
11WOBIL ;Check if the patient account has old written-off bills.
12 Q:('$D(PRCAT))!('$D(PRCABN)) Q:"CP"'[PRCAT S PRCA("DEBTOR")=$P(^PRCA(430,PRCABN,0),U,9) Q:PRCA("DEBTOR")="" S PRCAWOB=$O(^PRCA(430.3,"AC",109,0)),Z0=0
13 F PRCAWO=0:0 S Z0=$O(^PRCA(430,"C",PRCA("DEBTOR"),Z0)) Q:+Z0'>0 I Z0'=PRCABN D WOBIL1 Q:$D(PRCA("WO"))
14 W:$D(PRCA("WO")) !,*7,"This debtor has had another account written-off",!
15 K PRCAWO,PRCAWOB,PRCA("DEBTOR"),Z0,PRCA("WO") Q
16WOBIL1 I $P(^PRCA(430,Z0,0),U,8)=PRCAWOB S PRCA("WO")=1 Q
17 Q
18UPBALN I $P(^PRCA(430,PRCABN,0),U,3)="",$D(^PRCA(430,PRCABN,2,0)) D ORAMT
19 I '$D(^PRCA(430,PRCABN,7)) S $P(^(7),U,1)=$P(^(0),U,3)
20 S:+$P(^PRCA(430,PRCABN,7),U,1)'>0 $P(^PRCA(430,PRCABN,7),U,1)=$P(^PRCA(430,PRCABN,0),U,3)
21 S $P(^PRCA(430,PRCABN,0),U,4)=$S($P(^PRCA(430,PRCABN,0),U,2)>0:$P(^PRCA(430.2,$P(^(0),U,2),0),U,4),1:"")
22 S $P(^PRCA(430,PRCABN,0),U,12)=$S($D(PRCA("SITE")):PRCA("SITE"),1:"") I '$D(PRCA("SITE")) W:'$G(PRAUTOA) !!,"HELP AT UPBALN+4",!
23 S PRCA("STATUS")=$O(^PRCA(430.3,"AC",102,"")),PRCA("SDT")=DT D UPSTATS^PRCAUT2 Q ;end of UPBALN
24ORAMT S PRCAK1=0,%=0
25 F PRCAK=0:0 S %=$O(^PRCA(430,PRCABN,2,%)) Q:'% S PRCAK1=PRCAK1+$P(^PRCA(430,PRCABN,2,%,0),U,2)
26 S $P(^PRCA(430,PRCABN,0),U,3)=PRCAK1 K PRCAK,PRCAK1,% Q
27 ;
28CAUSED ;edit caused by,principal balance and general ledger number.
29 I '$G(PRAUTOA) K PRCA("AUTO_AUDIT")
30 S DA=PRCABN,DR="[PRCA CAUSED BY]",DIE="^PRCA(430," D ^DIE
31 I $D(Y) D
32 . S PRCAOK=0
33 . I '$G(PRAUTOA) W *7,"YOU SHOULD MAKE AN ENTRY !" Q
34 . D SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(PRCABN)),SETERR^PRCAUDT("ERROR ENCOUNTERED STORING 'BILL RESULTING FROM'")
35 K DR
36 Q
37 ;
38THIRD ; Check for 3rd party info on AR bill
39 Q:$D(^PRCA(430,PRCABN,202))
40 ; PRAUTOA is the flag for IB's call to audit-audit an electronic bill
41 N Z S Z="This bill does not have 3rd party information."
42 I $G(PRAUTOA) D SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(PRCABN)),SETERR^PRCAUDT(Z) Q
43 W !,Z,!
44 S %=2 W "Do you want to enter the data " D YN^DICN Q:(%<0)!(%=2)
45 I %=0 W !,"You may enter 'INSURED NAME', 'ID NO', 'GROUP NAME' and 'GROUP NO' for this bill. Answer 'Y' (YES) or 'N' (NO)." G THIRD
46 S DIE="^PRCA(430,",DR="[PRCAE INSURANCE DATA]",DA=PRCABN D ^DIE K DR,DIE,DA Q
47 ;
48RESFROM ; Update the BILL RESULTING FROM field for a rate type in RATE TYPE file
49 ; #399.3
50 N X,Y,DIR,RC1,RCDA,DIC,DTOUT,DUOUT
51 S RC1=0
52 F S DIC(0)="AEMQ",DIC="^DGCR(399.3," W ! D ^DIC Q:Y'>0 S RCDA=+Y D Q:$D(DUOUT)!$D(DTOUT) ; IA 4118
53 . S RC1=1
54 . S DIR(0)="YA",DIR("A")="AUTO-AUDIT?: ",DIR("B")=$S($P($G(^DGCR(399.3,+RCDA,0)),U,11)'="":"YES",1:"NO")
55 . D ^DIR K DIR
56 . Q:$D(DUOUT)!$D(DTOUT)
57 . I Y=1 S DR=".11",DIE="^DGCR(399.3,",DA=RCDA D ^DIE Q
58 . S DR=".11///@",DIE="^DGCR(399.3,",DA=RCDA D ^DIE W ! Q
59 Q
60 ;
Note: See TracBrowser for help on using the repository browser.