source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAUDT.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1PRCAUDT ;SF-ISC/YJK-AUDIT A NEW BILL/EDIT INCOMPLETE AR ;10/17/96 5:33 PM
2V ;;4.5;Accounts Receivable;**1,21,57,97,143,107,173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 NEW X,Y,LOOP,DIR
5 W ! S DIR("B")="YES",DIR("A")="Do you want to loop thru 'NEW BILLS'",DIR(0)="Y" D ^DIR K DIR G:$D(DIRUT) END S LOOP=+Y
6 D AUDITB(0,0,LOOP)
7 Q
8 ;
9AUDITB(PRCABN,PRAUTOA,LOOP) ;
10 ; PRCABN = the ien of the entry to audit or 0 for batch entry above
11 ; PRAUTOA = 1 for auto-audit
12 ; LOOP = 1 if looping through bills, 0 if not
13 N PREND,PRCA,PRCASEG,X,Y
14 S PREND=0,PRCA("AUTO_AUDIT")=PRAUTOA
15 F D Q:$S(PREND:1,PRAUTOA:1,1:0)
16 . K PRCABT S PRCA("MESG")="*** AUDITED AND RELEASED ***"
17 . I LOOP,'$O(^PRCA(430,"AC",18,PRCABN)) W !!,"*** Loop Done ***",!! S PREND=1 Q
18 . I PRAUTOA S PRCA("CKSITE")="",PRCA("SITE")=$P($$BILL(PRCABN),"-") K PRCAT
19 . I '$D(PRCA("CKSITE")) D CKSITE K:$D(PRCA("CKSITE")) PRCAT I '$D(PRCA("CKSITE")) S PREND=1 Q
20 . I LOOP S PRCABN=$O(^PRCA(430,"AC",18,PRCABN)) I 'PRCABN S PREND=1 Q
21 . I LOOP!PRAUTOA D
22 .. S PRCATY=$P(^PRCA(430,PRCABN,0),U,2),PRCA("SEG")=$S(+$P(^(0),U,21)>240:$P(^(0),U,21),1:"")
23 .. S PRCA("STATUS")=$P(^PRCA(430,PRCABN,0),U,8),PRCA("APPR")=$P(^(0),U,18)
24 . E D Q:PREND
25 .. S DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I Z0=104" D DIC I '$G(PRCABN) S PREND=1
26 . ;
27 . S PRCAKT=$S($P(^PRCA(430,PRCABN,0),U,2)]"":$P(^(0),U,2),1:"")
28 . I +PRCAKT'>0 D:$G(PRAUTOA) SETERR("NO CATEGORY DEFINED FOR BILL "_$$BILL(PRCABN)) D END Q
29 . S PRCARI=$O(^PRCA(430.2,"AC",21,0))
30 . I $P(^PRCA(430,PRCABN,0),U,21)="" S X=PRCABN D:PRCARI=PRCAKT SEGMT S:'$D(Y) Y=-1 S PRCASEG=$S(PRCARI=PRCAKT&(Y<1):"",PRCARI=PRCAKT:Y,$D(^PRCA(430.2,PRCAKT,0)):$P(^(0),U,3),1:""),$P(^PRCA(430,PRCABN,0),U,21)=PRCASEG
31 . S PRCAT=$S($D(^PRCA(430.2,PRCAKT,0)):$P(^(0),U,6),1:"") I PRCAT="" D:$G(PRAUTOA) SETERR("NO CATEGORY TYPE DEFINED FOR BILL "_$$BILL(PRCABN)) D END Q
32 . I $P(^PRCA(430.2,PRCAKT,0),U,7)=24 S PRCAT("C")=1,Z0=$P(^PRCA(430,PRCABN,0),U,16) S:+Z0'>0 Z0=PRCAKT S $P(^PRCA(430,PRCABN,0),U,21)=$S($D(^PRCA(430.2,+Z0,0)):$P(^(0),U,3),1:0) K Z0,PRCAKT
33 . ;
34 . I '$G(PRAUTOA) D DISPL,DISPLACC^PRCAFUT D Q:PREND
35 .. I $D(PRCA("EXIT")) S PREND=1 Q
36 .. D MESSG
37 . S PRCARETN=0,PRCAOK=$G(PRAUTOA)
38 . I '$G(PRAUTOA) D ASK I $D(PRCA("EXIT")) D END S PREND=1 Q
39 . I PRCAOK=1 D D:$D(PRCA("EXIT")) END Q
40 .. K PRCA("EXIT") D MTCHK I $D(PRCA("EXIT")) Q
41 .. D:PRCAT="T" THIRD^PRCAUDT1
42 .. I +$P(^PRCA(430,PRCABN,0),U,5)'>0 D CAUSED^PRCAUDT1 Q:PRCAOK=0
43 .. D COMMENTS^PRCAUT3 Q:$D(PRCA("EXIT"))
44 .. S PRCASIG=0 D SIG K PRCA("EXIT") Q:PRCASIG=0
45 .. D UPBALN^PRCAUDT1,UPSEG
46 .. I '$$ACCK^PRCAACC(PRCABN),("^28^29^"'[("^"_$G(PRCAKT)_"^")) D EN^PRCAFBD(PRCABN,.ERR)
47 .. I $G(PRCAKT)=28 D EN^PRCACPV(PRCABN,.ERR) S:ERR<0 PRCA("MESG")="FMS document created . . . "
48 .. K PRCA("EXIT")
49 .. I +$G(ERR)>0 D D END Q
50 ... N Z,Z0,Z1
51 ... S Z="Unable to create FMS Billing Document: ",Z0=$P(ERR,U,2),Z1="Status remains NEW BILL."
52 ... I '$G(PRAUTOA) D
53 .... W *7,!!,Z,!,?10,Z0,!!,Z1,!! H 3
54 ... E D
55 .... D SETERR(Z),SETERR(Z0),SETERR(Z1)
56 ... S PRCA("STATUS")=18 D UPSTATS^PRCAUT2
57 ... ;
58 .. I '$G(PRAUTOA) D SIG1 W !,PRCA("MESG")
59 .. D END
60 . I PRCARETN=1,'$G(PRAUTOA) D RETN^PRCAUDT1 Q
61 . D END
62 D END
63 Q
64 ;
65END L -^PRCA(430,+$G(PRCABN)) K %,DA,PRCAKT,PRCATY,PRCANM,PRCARETN,PRCAOK,PRCAT,DIC,DIE,DR,ERR,PRCASIG,J,Z0,D0,DI,PRC,PRCARI,DIR,DIRUT,DIROUT,DUOUT
66 D CLEAN^DILF
67 Q
68 ;
69 ;======================== SUBROUTINES ==========================
70BULL(PRCABN) ; Send a bulletin for auto audit errors
71 ; PRCABN = ien of bill in file 430
72 N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,PRCAE,CT,Z
73 S XMTO("I:G.RCDPE PAYMENTS")="",CT=0
74 S CT=CT+1,PRCAE(CT)="The following problem(s) were encountered when attempting to auto-audit a bill",CT=CT+1,PRCAE(CT)="from IB's electronic return messages"
75 S CT=CT+1,PRCAE(CT)=" ",Z=0
76 F S Z=$O(^TMP($J,"PRCA_AUTO_AUDIT_ERROR",Z)) Q:'Z S CT=CT+1,PRCAE(CT)=$G(^(Z))
77 S XMBODY="PRCAE"
78 D SENDMSG^XMXAPI("","AUTO AUDIT FAILED FOR BILL "_$$BILL(PRCABN),XMBODY,.XMTO)
79 Q
80 ;
81DIC S DIC="^PRCA(430,",DIC(0)="AEQM" D BILLN^PRCAUTL Q
82DIE W ! S DA=PRCABN,DIC="^PRCA(430,",PRCA("LOCK")=0 D LOCKF^PRCAWO1 Q:PRCA("LOCK")=1 S DIE=DIC
83 I '$$ACCK^PRCAACC(PRCABN),("^27^28^"'[("^"_PRCAKT_"^")) D CPLK^PRCAFUT(PRCABN)
84 Q:$D(PRCA("EXIT")) S DR="[PRCAE AUDIT]" D ^DIE K DIE,DR Q
85DISPL ;display the accounts receivable data user has entered.
86 Q:'$D(PRCABN) NEW DIC,L,FR,TO,FLDS,IOP,BY
87 S IOP=IO(0),DIC="^PRCA(430,",FLDS="[PRCA DISP AUDIT]",(FR,TO)=PRCABN,L=0,BY="@NUMBER" D EN1^DIP,WOBIL^PRCAUDT1 Q
88ASK S %=2 W !,"IS THIS DATA CORRECT" D YN^DICN I %<0 S PRCA("EXIT")="" Q
89 I %=0 D M1^PRCAMESG G ASK
90 I %=1 S PRCAOK=1 Q
91ASK1 S %=2 W !!,"Do you want to edit this information " D YN^DICN I %<0 S PRCA("EXIT")="" Q
92 I %=0 D M2^PRCAMESG G ASK1
93 I %=1 D DIE,DISPL,DISPLACC^PRCAFUT G ASK
94ASK2 S %=2 W !!,"Then do you want to return this bill to the service" D YN^DICN I %<0 S PRCA("EXIT")="" Q
95 Q:%=2 I %=0 W !,"Answer 'Y' (YES) or 'N' (NO)" G ASK2
96ASK3 S %=2 W !,"Are you sure you want to return" D YN^DICN I %<0 S PRCA("EXIT")="" Q
97 I %=0 W "Answer 'Y' (YES) if you want to return this bill to the service that originated it. If not, answer 'N' (NO)." G ASK3
98 I %=1 S PRCARETN=1 Q
99 Q ;end of ASK
100SIG N PRCADUZ
101 I $G(PRAUTOA) S PRCADUZ=+$O(^VA(200,"B","PRCA,AUTOAUDIT",0)),PRCANM="AUTO-AUDIT"
102 I '$G(PRAUTOA) S DA=PRCABN D SIG^PRCASIG
103 D NOW^%DTC I $D(PRCANM) S $P(^PRCA(430,PRCABN,9),U,1,3)=$S('$G(PRAUTOA):+DUZ,1:PRCADUZ)_U_PRCANM_U_%,PRCASIG=1
104 Q
105SIG1 S PRCANM=$P($G(^VA(200,DUZ,20)),U,2) I PRCANM]"" D EN^PRCASIG(.PRCANM,DUZ,PRCABN_+$P(^PRCA(430,PRCABN,0),U,3)) S $P(^PRCA(430,PRCABN,9),U,2)=PRCANM
106 Q
107MESSG Q
108SEGMT D:$D(^DGCR(399,PRCABN)) ^IBCAMS S:'$D(^DGCR(399,PRCABN)) Y=297 Q
109UPSEG ;
110 S PRCAT=$P(^PRCA(430,PRCABN,0),U,2),$P(^(0),U,21)=""
111 D SEGMT^PRCAEOL
112 Q
113CKSITE ;check site parameter and user number.
114 NEW DIC
115 S DIC="^DIC(4,",DIC(0)="QEAM",DIC("B")=$P($G(^RC(342,1,0)),"^"),DIC("A")="SITE: " D ^DIC Q:Y<0 S PRCA("SITE")=+$$GET1^DIQ(4,+Y,99) Q:'PRCA("SITE")
116 S PRCA("CKSITE")="" Q
117MTCHK N PRCAI,PRCAMT,PRCAMT1,Z,Z0
118 S PRCAMT1=0 F PRCAI=0:0 S PRCAI=$O(^PRCA(430,PRCABN,2,PRCAI)) Q:'PRCAI S PRCAMT=+$P($G(^(PRCAI,0)),"^",8) I PRCAMT S PRCAMT1=PRCAMT1+1
119 I PRCAMT1=1 Q
120 S Z="Currently, just one Fiscal Year amount is sent to FMS.",Z0="This bill has "_PRCAMT1_" entered and should be returned to the service."
121 I '$G(PRAUTOA) D
122 . W !!,?3,Z,?3,Z0,!
123 E D
124 . D SETERR("BILL: "_$$BILL(PRCABN)),SETERR(Z),SETERR(Z0)
125 S PRCA("EXIT")=""
126 Q
127 ;
128AUDITX(PRCABN) ; Auto audit a bill
129 N PRAUTOA
130 K ^TMP($J,"PRCA_AUTO_AUDIT_ERROR")
131 L +^PRCA(430,+$G(PRCABN)):5 I '$T D SETERR(PRCABN,"ANOTHER USER HAS LOCKED BILL "_$$BILL(PRCABN))
132 I '$D(^TMP($J,"PRCA_AUTO_AUDIT_ERROR")) D AUDITB(PRCABN,1,0)
133 ;
134 I $D(^TMP($J,"PRCA_AUTO_AUDIT_ERROR")) D BULL(PRCABN)
135 K ^TMP($J,"PRCA_AUTO_AUDIT_ERROR")
136 Q
137 ;
138SETERR(TEXT) ;
139 S ^TMP($J,"PRCA_AUTO_AUDIT_ERROR",+$O(^TMP($J,"PRCA_AUTO_AUDIT_ERROR",""),-1)+1)=TEXT
140 Q
141 ;
142BILL(PRCABN) ; Returns AR bill number in external format
143 Q $P($G(^PRCA(430,+$G(PRCABN),0)),U)
144 ;
Note: See TracBrowser for help on using the repository browser.