Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCAUDT

PRCAUDT.m

Go to the documentation of this file.
  1. PRCAUDT ;SF - ISC/YJK-AUDIT A NEW BILL/EDIT INCOMPLETE AR ;10/17/96 5:33 PM
  1. V ;;4.5;Accounts Receivable;**1,21,57,97,143,107,173,321,342,349**;Mar 20, 1995;Build 44
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. NEW DIR,LOOP,RTYPES,X,Y
  1. 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
  1. ; PRCA*4.5*349 - New prompt to allow user to filter for rate type
  1. I LOOP D Q:$G(DTOUT)!$G(DUOUT)
  1. . N DIR,X,Y
  1. . W !!,"Select rate types to loop through, or hit 'Enter' for all rate types.",!
  1. . F D Q:$G(DTOUT)!$G(DUOUT)!(X="")
  1. .. S DIR(0)="PO^399.3:AE",DIR("A")="Select Rate Types to Include"
  1. .. D ^DIR
  1. .. I X]"" D
  1. ... S:'$D(RTYPES(+U)) RTYPES(+Y)=$P(Y,U,2)
  1. G:$G(DTOUT)!$G(DUOUT) END
  1. ; PRCA*4.5*349 - End new code
  1. D AUDITB(0,0,LOOP,.RTYPES) ; PRCA*4.5*349 - Add rate types filter list
  1. Q
  1. ;
  1. AUDITB(PRCABN,PRAUTOA,LOOP,RTYPES) ;
  1. ; PRCABN = the ien of the entry to audit or 0 for batch entry above
  1. ; PRAUTOA = 1 for auto-audit
  1. ; LOOP = 1 if looping through bills, 0 if not
  1. ; RTYPES = Array of rate types to display (if not defined, show all rate types) (PRCA*4.5*349)
  1. N PRCA,PRCASEG,PREND,PRQUIT,X,XX,Y ; PRCA*4.5*321
  1. S PREND=0,PRCA("AUTO_AUDIT")=PRAUTOA
  1. F D Q:$S(PREND:1,PRAUTOA:1,1:0)
  1. . K PRCABT
  1. . S PRQUIT=0 ; PRCA*4.5*321
  1. . S PRCA("MESG")="*** AUDITED AND RELEASED ***"
  1. . I LOOP,'$O(^PRCA(430,"AC",18,PRCABN)) W !!,"*** Loop Done ***",!! S PREND=1 Q
  1. . I PRAUTOA S PRCA("CKSITE")="",PRCA("SITE")=$P($$BILL(PRCABN),"-") K PRCAT
  1. . I '$D(PRCA("CKSITE")) D CKSITE K:$D(PRCA("CKSITE")) PRCAT I '$D(PRCA("CKSITE")) S PREND=1 Q
  1. . I LOOP S PRCABN=$O(^PRCA(430,"AC",18,PRCABN)) I 'PRCABN S PREND=1 Q
  1. . ; PRCA*4.5*349 - If filtering by rate types, do not audit claims that do not match selected rate types
  1. . I LOOP,$D(RTYPES)>1 D Q:PRQUIT
  1. .. N RATETYPE
  1. .. S RATETYPE=$$GET1^DIQ(399,PRCABN_",",.07,"I")
  1. .. I RATETYPE="" S PRQUIT=1 Q
  1. .. S:'$D(RTYPES(RATETYPE)) PRQUIT=1
  1. . ; PRCA*4.5*349 - End new code
  1. . I LOOP!PRAUTOA D Q:PRQUIT
  1. .. I $$BILLREJ(PRCABN) S PRQUIT=1 Q ; PRCA*4.5*321 - claim has reject messages, do not audit
  1. .. S PRCATY=$P(^PRCA(430,PRCABN,0),U,2),PRCA("SEG")=$S(+$P(^(0),U,21)>240:$P(^(0),U,21),1:"")
  1. .. S PRCA("STATUS")=$P(^PRCA(430,PRCABN,0),U,8),PRCA("APPR")=$P(^(0),U,18)
  1. . E D Q:PREND!PRQUIT
  1. .. S DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I Z0=104"
  1. .. D DIC I '$G(PRCABN) S PREND=1 Q
  1. .. I $$BILLREJ(PRCABN) D S PRQUIT=1 Q ; PRCA*4.5*321
  1. ... D PAUSE("Claim has reject messages, can not be audited")
  1. . ;
  1. . S PRCAKT=$S($P(^PRCA(430,PRCABN,0),U,2)]"":$P(^(0),U,2),1:"")
  1. . I +PRCAKT'>0 D:$G(PRAUTOA) SETERR("NO CATEGORY DEFINED FOR BILL "_$$BILL(PRCABN)) D END Q
  1. . S PRCARI=$O(^PRCA(430.2,"AC",21,0))
  1. . 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
  1. . 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
  1. . 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
  1. . ;
  1. . I '$G(PRAUTOA) D DISPL,DISPLACC^PRCAFUT D Q:PREND
  1. .. I $D(PRCA("EXIT")) S PREND=1 Q
  1. .. D MESSG
  1. . S PRCARETN=0,PRCAOK=$G(PRAUTOA)
  1. . I '$G(PRAUTOA) D ASK I $D(PRCA("EXIT")) D END S PREND=1 Q
  1. . I PRCAOK=1 D D:$D(PRCA("EXIT")) END Q
  1. .. K PRCA("EXIT") D MTCHK I $D(PRCA("EXIT")) Q
  1. .. D:PRCAT="T" THIRD^PRCAUDT1
  1. .. I +$P(^PRCA(430,PRCABN,0),U,5)'>0 D CAUSED^PRCAUDT1 Q:PRCAOK=0
  1. .. D COMMENTS^PRCAUT3 Q:$D(PRCA("EXIT"))
  1. .. S PRCASIG=0 D SIG K PRCA("EXIT") Q:PRCASIG=0
  1. .. D UPBALN^PRCAUDT1,UPSEG
  1. .. I '$$ACCK^PRCAACC(PRCABN),("^28^29^"'[("^"_$G(PRCAKT)_"^")) D EN^PRCAFBD(PRCABN,.ERR)
  1. .. I $G(PRCAKT)=28 D EN^PRCACPV(PRCABN,.ERR) S:ERR<0 PRCA("MESG")="FMS document created . . . "
  1. .. K PRCA("EXIT")
  1. .. I +$G(ERR)>0 D D END Q
  1. ... N Z,Z0,Z1
  1. ... S Z="Unable to create FMS Billing Document: ",Z0=$P(ERR,U,2),Z1="Status remains NEW BILL."
  1. ... I '$G(PRAUTOA) D
  1. .... W *7,!!,Z,!,?10,Z0,!!,Z1,!! H 3
  1. ... E D
  1. .... D SETERR(Z),SETERR(Z0),SETERR(Z1)
  1. ... S PRCA("STATUS")=18 D UPSTATS^PRCAUT2
  1. ... ;
  1. .. I '$G(PRAUTOA) D SIG1 W !,PRCA("MESG")
  1. .. D END
  1. . I PRCARETN=1,'$G(PRAUTOA) D RETN^PRCAUDT1 Q
  1. . D END
  1. D END
  1. Q
  1. ;
  1. END 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
  1. D CLEAN^DILF
  1. Q
  1. ;
  1. ;======================== SUBROUTINES ==========================
  1. BULL(PRCABN) ; Send a bulletin for auto audit errors
  1. ; PRCABN = ien of bill in file 430
  1. N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,PRCAE,CT,Z
  1. S XMTO("I:G.RCDPE PAYMENTS")="",CT=0
  1. 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"
  1. S CT=CT+1,PRCAE(CT)=" ",Z=0
  1. F S Z=$O(^TMP($J,"PRCA_AUTO_AUDIT_ERROR",Z)) Q:'Z S CT=CT+1,PRCAE(CT)=$G(^(Z))
  1. S XMBODY="PRCAE"
  1. D SENDMSG^XMXAPI("","AUTO AUDIT FAILED FOR BILL "_$$BILL(PRCABN),XMBODY,.XMTO)
  1. Q
  1. ;
  1. DIC S DIC="^PRCA(430,",DIC(0)="AEQM" D BILLN^PRCAUTL Q
  1. DIE W ! S DA=PRCABN,DIC="^PRCA(430,",PRCA("LOCK")=0 D LOCKF^PRCAWO1 Q:PRCA("LOCK")=1 S DIE=DIC
  1. I '$$ACCK^PRCAACC(PRCABN),("^27^28^"'[("^"_PRCAKT_"^")) D CPLK^PRCAFUT(PRCABN)
  1. Q:$D(PRCA("EXIT")) S DR="[PRCAE AUDIT]" D ^DIE K DIE,DR Q
  1. DISPL ;display the accounts receivable data user has entered.
  1. Q:'$D(PRCABN) NEW DIC,L,FR,TO,FLDS,IOP,BY
  1. S IOP=IO(0),DIC="^PRCA(430,",FLDS="[PRCA DISP AUDIT]",(FR,TO)=PRCABN,L=0,BY="@NUMBER" D EN1^DIP,WOBIL^PRCAUDT1 Q
  1. ASK S %=2 W !,"IS THIS DATA CORRECT" D YN^DICN I %<0 S PRCA("EXIT")="" Q
  1. I %=0 D M1^PRCAMESG G ASK
  1. I %=1 S PRCAOK=1 Q
  1. ASK1 S %=2 W !!,"Do you want to edit this information " D YN^DICN I %<0 S PRCA("EXIT")="" Q
  1. I %=0 D M2^PRCAMESG G ASK1
  1. I %=1 D DIE,DISPL,DISPLACC^PRCAFUT G ASK
  1. ASK2 S %=2 W !!,"Then do you want to return this bill to the service" D YN^DICN I %<0 S PRCA("EXIT")="" Q
  1. Q:%=2 I %=0 W !,"Answer 'Y' (YES) or 'N' (NO)" G ASK2
  1. ASK3 S %=2 W !,"Are you sure you want to return" D YN^DICN I %<0 S PRCA("EXIT")="" Q
  1. 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
  1. I %=1 S PRCARETN=1 Q
  1. Q ;end of ASK
  1. SIG N PRCADUZ
  1. I $G(PRAUTOA) S PRCADUZ=+$O(^VA(200,"B","PRCA,AUTOAUDIT",0)),PRCANM="AUTO-AUDIT"
  1. I '$G(PRAUTOA) S DA=PRCABN D SIG^PRCASIG
  1. 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
  1. Q
  1. SIG1 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
  1. Q
  1. MESSG Q
  1. SEGMT D:$D(^DGCR(399,PRCABN)) ^IBCAMS S:'$D(^DGCR(399,PRCABN)) Y=297 Q
  1. UPSEG ;
  1. S PRCAT=$P(^PRCA(430,PRCABN,0),U,2),$P(^(0),U,21)=""
  1. D SEGMT^PRCAEOL
  1. Q
  1. CKSITE ;check site parameter and user number.
  1. NEW DIC
  1. 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")
  1. S PRCA("CKSITE")="" Q
  1. MTCHK N PRCAI,PRCAMT,PRCAMT1,Z,Z0
  1. 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
  1. I PRCAMT1=1 Q
  1. 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."
  1. I '$G(PRAUTOA) D
  1. . W !!,?3,Z,?3,Z0,!
  1. E D
  1. . D SETERR("BILL: "_$$BILL(PRCABN)),SETERR(Z),SETERR(Z0)
  1. S PRCA("EXIT")=""
  1. Q
  1. ;ZZPJH WIP 8/21/17
  1. AUDITX(PRCABN) ; Auto audit a bill
  1. N PRAUTOA
  1. K ^TMP($J,"PRCA_AUTO_AUDIT_ERROR")
  1. L +^PRCA(430,+$G(PRCABN)):$G(DILOCKTM,5) I '$T D SETERR("ANOTHER USER HAS LOCKED BILL "_$$BILL(PRCABN)) ;PRCA*4.5*342, Pass text only
  1. I '$D(^TMP($J,"PRCA_AUTO_AUDIT_ERROR")) D AUDITB(PRCABN,1,0)
  1. ;
  1. I $D(^TMP($J,"PRCA_AUTO_AUDIT_ERROR")) D BULL(PRCABN)
  1. K ^TMP($J,"PRCA_AUTO_AUDIT_ERROR")
  1. Q
  1. ;
  1. SETERR(TEXT) ;
  1. S ^TMP($J,"PRCA_AUTO_AUDIT_ERROR",+$O(^TMP($J,"PRCA_AUTO_AUDIT_ERROR",""),-1)+1)=TEXT
  1. Q
  1. ;
  1. BILL(PRCABN) ; Returns AR bill number in external format
  1. Q $P($G(^PRCA(430,+$G(PRCABN),0)),U)
  1. ;
  1. BILLREJ(PRCABN) ; EP Check if bill has reject messages. Added for PRCA*4.5*321
  1. ; Changed for PRCA*4.5*349 to only return 1 if there any reject messages with
  1. ; uncompleted reviews instead of if there were any reject messages at all
  1. ; Input - PRCABN - Internal Entry number from ACCOUNTS RECEIVABLE file [#430]
  1. ; (Note - file #399 has same IEN as file #430)
  1. ; Output - 1 - Reject messages 0 - No Reject messages
  1. N BILLNO,RETURN
  1. S BILLNO=$$GET1^DIQ(399,PRCABN_",",.01,"I")
  1. S RETURN=$$BILLREJ2^IBJTU6(BILLNO) ; API call covered by IA 7092 - PRCA*4.5*349
  1. Q RETURN
  1. ;
  1. PAUSE(MSG) ; Display message and pause till user responds
  1. ; INPUT - MSG - Message to display to user
  1. ; Output - None
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. W !!,MSG,!
  1. S DIR(0)="EA"
  1. S DIR("A")="Type <Enter> to continue: "
  1. D ^DIR
  1. Q