PRCAUDT ;SF - ISC/YJK-AUDIT A NEW BILL/EDIT INCOMPLETE AR ;10/17/96 5:33 PM
V ;;4.5;Accounts Receivable;**1,21,57,97,143,107,173,321,342,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
NEW DIR,LOOP,RTYPES,X,Y
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
; PRCA*4.5*349 - New prompt to allow user to filter for rate type
I LOOP D Q:$G(DTOUT)!$G(DUOUT)
. N DIR,X,Y
. W !!,"Select rate types to loop through, or hit 'Enter' for all rate types.",!
. F D Q:$G(DTOUT)!$G(DUOUT)!(X="")
.. S DIR(0)="PO^399.3:AE",DIR("A")="Select Rate Types to Include"
.. D ^DIR
.. I X]"" D
... S:'$D(RTYPES(+U)) RTYPES(+Y)=$P(Y,U,2)
G:$G(DTOUT)!$G(DUOUT) END
; PRCA*4.5*349 - End new code
D AUDITB(0,0,LOOP,.RTYPES) ; PRCA*4.5*349 - Add rate types filter list
Q
;
AUDITB(PRCABN,PRAUTOA,LOOP,RTYPES) ;
; PRCABN = the ien of the entry to audit or 0 for batch entry above
; PRAUTOA = 1 for auto-audit
; LOOP = 1 if looping through bills, 0 if not
; RTYPES = Array of rate types to display (if not defined, show all rate types) (PRCA*4.5*349)
N PRCA,PRCASEG,PREND,PRQUIT,X,XX,Y ; PRCA*4.5*321
S PREND=0,PRCA("AUTO_AUDIT")=PRAUTOA
F D Q:$S(PREND:1,PRAUTOA:1,1:0)
. K PRCABT
. S PRQUIT=0 ; PRCA*4.5*321
. S PRCA("MESG")="*** AUDITED AND RELEASED ***"
. I LOOP,'$O(^PRCA(430,"AC",18,PRCABN)) W !!,"*** Loop Done ***",!! S PREND=1 Q
. I PRAUTOA S PRCA("CKSITE")="",PRCA("SITE")=$P($$BILL(PRCABN),"-") K PRCAT
. I '$D(PRCA("CKSITE")) D CKSITE K:$D(PRCA("CKSITE")) PRCAT I '$D(PRCA("CKSITE")) S PREND=1 Q
. I LOOP S PRCABN=$O(^PRCA(430,"AC",18,PRCABN)) I 'PRCABN S PREND=1 Q
. ; PRCA*4.5*349 - If filtering by rate types, do not audit claims that do not match selected rate types
. I LOOP,$D(RTYPES)>1 D Q:PRQUIT
.. N RATETYPE
.. S RATETYPE=$$GET1^DIQ(399,PRCABN_",",.07,"I")
.. I RATETYPE="" S PRQUIT=1 Q
.. S:'$D(RTYPES(RATETYPE)) PRQUIT=1
. ; PRCA*4.5*349 - End new code
. I LOOP!PRAUTOA D Q:PRQUIT
.. I $$BILLREJ(PRCABN) S PRQUIT=1 Q ; PRCA*4.5*321 - claim has reject messages, do not audit
.. S PRCATY=$P(^PRCA(430,PRCABN,0),U,2),PRCA("SEG")=$S(+$P(^(0),U,21)>240:$P(^(0),U,21),1:"")
.. S PRCA("STATUS")=$P(^PRCA(430,PRCABN,0),U,8),PRCA("APPR")=$P(^(0),U,18)
. E D Q:PREND!PRQUIT
.. 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 Q
.. I $$BILLREJ(PRCABN) D S PRQUIT=1 Q ; PRCA*4.5*321
... D PAUSE("Claim has reject messages, can not be audited")
. ;
. S PRCAKT=$S($P(^PRCA(430,PRCABN,0),U,2)]"":$P(^(0),U,2),1:"")
. I +PRCAKT'>0 D:$G(PRAUTOA) SETERR("NO CATEGORY DEFINED FOR BILL "_$$BILL(PRCABN)) D END Q
. S PRCARI=$O(^PRCA(430.2,"AC",21,0))
. 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
. 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
. 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
. ;
. I '$G(PRAUTOA) D DISPL,DISPLACC^PRCAFUT D Q:PREND
.. I $D(PRCA("EXIT")) S PREND=1 Q
.. D MESSG
. S PRCARETN=0,PRCAOK=$G(PRAUTOA)
. I '$G(PRAUTOA) D ASK I $D(PRCA("EXIT")) D END S PREND=1 Q
. I PRCAOK=1 D D:$D(PRCA("EXIT")) END Q
.. K PRCA("EXIT") D MTCHK I $D(PRCA("EXIT")) Q
.. D:PRCAT="T" THIRD^PRCAUDT1
.. I +$P(^PRCA(430,PRCABN,0),U,5)'>0 D CAUSED^PRCAUDT1 Q:PRCAOK=0
.. D COMMENTS^PRCAUT3 Q:$D(PRCA("EXIT"))
.. S PRCASIG=0 D SIG K PRCA("EXIT") Q:PRCASIG=0
.. D UPBALN^PRCAUDT1,UPSEG
.. I '$$ACCK^PRCAACC(PRCABN),("^28^29^"'[("^"_$G(PRCAKT)_"^")) D EN^PRCAFBD(PRCABN,.ERR)
.. I $G(PRCAKT)=28 D EN^PRCACPV(PRCABN,.ERR) S:ERR<0 PRCA("MESG")="FMS document created . . . "
.. K PRCA("EXIT")
.. I +$G(ERR)>0 D D END Q
... N Z,Z0,Z1
... S Z="Unable to create FMS Billing Document: ",Z0=$P(ERR,U,2),Z1="Status remains NEW BILL."
... I '$G(PRAUTOA) D
.... W *7,!!,Z,!,?10,Z0,!!,Z1,!! H 3
... E D
.... D SETERR(Z),SETERR(Z0),SETERR(Z1)
... S PRCA("STATUS")=18 D UPSTATS^PRCAUT2
... ;
.. I '$G(PRAUTOA) D SIG1 W !,PRCA("MESG")
.. D END
. I PRCARETN=1,'$G(PRAUTOA) D RETN^PRCAUDT1 Q
. D END
D END
Q
;
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
D CLEAN^DILF
Q
;
;======================== SUBROUTINES ==========================
BULL(PRCABN) ; Send a bulletin for auto audit errors
; PRCABN = ien of bill in file 430
N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,PRCAE,CT,Z
S XMTO("I:G.RCDPE PAYMENTS")="",CT=0
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"
S CT=CT+1,PRCAE(CT)=" ",Z=0
F S Z=$O(^TMP($J,"PRCA_AUTO_AUDIT_ERROR",Z)) Q:'Z S CT=CT+1,PRCAE(CT)=$G(^(Z))
S XMBODY="PRCAE"
D SENDMSG^XMXAPI("","AUTO AUDIT FAILED FOR BILL "_$$BILL(PRCABN),XMBODY,.XMTO)
Q
;
DIC S DIC="^PRCA(430,",DIC(0)="AEQM" D BILLN^PRCAUTL Q
DIE W ! S DA=PRCABN,DIC="^PRCA(430,",PRCA("LOCK")=0 D LOCKF^PRCAWO1 Q:PRCA("LOCK")=1 S DIE=DIC
I '$$ACCK^PRCAACC(PRCABN),("^27^28^"'[("^"_PRCAKT_"^")) D CPLK^PRCAFUT(PRCABN)
Q:$D(PRCA("EXIT")) S DR="[PRCAE AUDIT]" D ^DIE K DIE,DR Q
DISPL ;display the accounts receivable data user has entered.
Q:'$D(PRCABN) NEW DIC,L,FR,TO,FLDS,IOP,BY
S IOP=IO(0),DIC="^PRCA(430,",FLDS="[PRCA DISP AUDIT]",(FR,TO)=PRCABN,L=0,BY="@NUMBER" D EN1^DIP,WOBIL^PRCAUDT1 Q
ASK S %=2 W !,"IS THIS DATA CORRECT" D YN^DICN I %<0 S PRCA("EXIT")="" Q
I %=0 D M1^PRCAMESG G ASK
I %=1 S PRCAOK=1 Q
ASK1 S %=2 W !!,"Do you want to edit this information " D YN^DICN I %<0 S PRCA("EXIT")="" Q
I %=0 D M2^PRCAMESG G ASK1
I %=1 D DIE,DISPL,DISPLACC^PRCAFUT G ASK
ASK2 S %=2 W !!,"Then do you want to return this bill to the service" D YN^DICN I %<0 S PRCA("EXIT")="" Q
Q:%=2 I %=0 W !,"Answer 'Y' (YES) or 'N' (NO)" G ASK2
ASK3 S %=2 W !,"Are you sure you want to return" D YN^DICN I %<0 S PRCA("EXIT")="" Q
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
I %=1 S PRCARETN=1 Q
Q ;end of ASK
SIG N PRCADUZ
I $G(PRAUTOA) S PRCADUZ=+$O(^VA(200,"B","PRCA,AUTOAUDIT",0)),PRCANM="AUTO-AUDIT"
I '$G(PRAUTOA) S DA=PRCABN D SIG^PRCASIG
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
Q
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
Q
MESSG Q
SEGMT D:$D(^DGCR(399,PRCABN)) ^IBCAMS S:'$D(^DGCR(399,PRCABN)) Y=297 Q
UPSEG ;
S PRCAT=$P(^PRCA(430,PRCABN,0),U,2),$P(^(0),U,21)=""
D SEGMT^PRCAEOL
Q
CKSITE ;check site parameter and user number.
NEW DIC
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")
S PRCA("CKSITE")="" Q
MTCHK N PRCAI,PRCAMT,PRCAMT1,Z,Z0
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
I PRCAMT1=1 Q
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."
I '$G(PRAUTOA) D
. W !!,?3,Z,?3,Z0,!
E D
. D SETERR("BILL: "_$$BILL(PRCABN)),SETERR(Z),SETERR(Z0)
S PRCA("EXIT")=""
Q
;ZZPJH WIP 8/21/17
AUDITX(PRCABN) ; Auto audit a bill
N PRAUTOA
K ^TMP($J,"PRCA_AUTO_AUDIT_ERROR")
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
I '$D(^TMP($J,"PRCA_AUTO_AUDIT_ERROR")) D AUDITB(PRCABN,1,0)
;
I $D(^TMP($J,"PRCA_AUTO_AUDIT_ERROR")) D BULL(PRCABN)
K ^TMP($J,"PRCA_AUTO_AUDIT_ERROR")
Q
;
SETERR(TEXT) ;
S ^TMP($J,"PRCA_AUTO_AUDIT_ERROR",+$O(^TMP($J,"PRCA_AUTO_AUDIT_ERROR",""),-1)+1)=TEXT
Q
;
BILL(PRCABN) ; Returns AR bill number in external format
Q $P($G(^PRCA(430,+$G(PRCABN),0)),U)
;
BILLREJ(PRCABN) ; EP Check if bill has reject messages. Added for PRCA*4.5*321
; Changed for PRCA*4.5*349 to only return 1 if there any reject messages with
; uncompleted reviews instead of if there were any reject messages at all
; Input - PRCABN - Internal Entry number from ACCOUNTS RECEIVABLE file [#430]
; (Note - file #399 has same IEN as file #430)
; Output - 1 - Reject messages 0 - No Reject messages
N BILLNO,RETURN
S BILLNO=$$GET1^DIQ(399,PRCABN_",",.01,"I")
S RETURN=$$BILLREJ2^IBJTU6(BILLNO) ; API call covered by IA 7092 - PRCA*4.5*349
Q RETURN
;
PAUSE(MSG) ; Display message and pause till user responds
; INPUT - MSG - Message to display to user
; Output - None
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !!,MSG,!
S DIR(0)="EA"
S DIR("A")="Type <Enter> to continue: "
D ^DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAUDT 9313 printed Dec 13, 2024@01:41:57 Page 2
PRCAUDT ;SF - ISC/YJK-AUDIT A NEW BILL/EDIT INCOMPLETE AR ;10/17/96 5:33 PM
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.
+2 NEW DIR,LOOP,RTYPES,X,Y
+3 WRITE !
SET DIR("B")="YES"
SET DIR("A")="Do you want to loop thru 'NEW BILLS'"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET LOOP=+Y
+4 ; PRCA*4.5*349 - New prompt to allow user to filter for rate type
+5 IF LOOP
Begin DoDot:1
+6 NEW DIR,X,Y
+7 WRITE !!,"Select rate types to loop through, or hit 'Enter' for all rate types.",!
+8 FOR
Begin DoDot:2
+9 SET DIR(0)="PO^399.3:AE"
SET DIR("A")="Select Rate Types to Include"
+10 DO ^DIR
+11 IF X]""
Begin DoDot:3
+12 if '$DATA(RTYPES(+U))
SET RTYPES(+Y)=$PIECE(Y,U,2)
End DoDot:3
End DoDot:2
if $GET(DTOUT)!$GET(DUOUT)!(X="")
QUIT
End DoDot:1
if $GET(DTOUT)!$GET(DUOUT)
QUIT
+13 if $GET(DTOUT)!$GET(DUOUT)
GOTO END
+14 ; PRCA*4.5*349 - End new code
+15 ; PRCA*4.5*349 - Add rate types filter list
DO AUDITB(0,0,LOOP,.RTYPES)
+16 QUIT
+17 ;
AUDITB(PRCABN,PRAUTOA,LOOP,RTYPES) ;
+1 ; PRCABN = the ien of the entry to audit or 0 for batch entry above
+2 ; PRAUTOA = 1 for auto-audit
+3 ; LOOP = 1 if looping through bills, 0 if not
+4 ; RTYPES = Array of rate types to display (if not defined, show all rate types) (PRCA*4.5*349)
+5 ; PRCA*4.5*321
NEW PRCA,PRCASEG,PREND,PRQUIT,X,XX,Y
+6 SET PREND=0
SET PRCA("AUTO_AUDIT")=PRAUTOA
+7 FOR
Begin DoDot:1
+8 KILL PRCABT
+9 ; PRCA*4.5*321
SET PRQUIT=0
+10 SET PRCA("MESG")="*** AUDITED AND RELEASED ***"
+11 IF LOOP
IF '$ORDER(^PRCA(430,"AC",18,PRCABN))
WRITE !!,"*** Loop Done ***",!!
SET PREND=1
QUIT
+12 IF PRAUTOA
SET PRCA("CKSITE")=""
SET PRCA("SITE")=$PIECE($$BILL(PRCABN),"-")
KILL PRCAT
+13 IF '$DATA(PRCA("CKSITE"))
DO CKSITE
if $DATA(PRCA("CKSITE"))
KILL PRCAT
IF '$DATA(PRCA("CKSITE"))
SET PREND=1
QUIT
+14 IF LOOP
SET PRCABN=$ORDER(^PRCA(430,"AC",18,PRCABN))
IF 'PRCABN
SET PREND=1
QUIT
+15 ; PRCA*4.5*349 - If filtering by rate types, do not audit claims that do not match selected rate types
+16 IF LOOP
IF $DATA(RTYPES)>1
Begin DoDot:2
+17 NEW RATETYPE
+18 SET RATETYPE=$$GET1^DIQ(399,PRCABN_",",.07,"I")
+19 IF RATETYPE=""
SET PRQUIT=1
QUIT
+20 if '$DATA(RTYPES(RATETYPE))
SET PRQUIT=1
End DoDot:2
if PRQUIT
QUIT
+21 ; PRCA*4.5*349 - End new code
+22 IF LOOP!PRAUTOA
Begin DoDot:2
+23 ; PRCA*4.5*321 - claim has reject messages, do not audit
IF $$BILLREJ(PRCABN)
SET PRQUIT=1
QUIT
+24 SET PRCATY=$PIECE(^PRCA(430,PRCABN,0),U,2)
SET PRCA("SEG")=$SELECT(+$PIECE(^(0),U,21)>240:$PIECE(^(0),U,21),1:"")
+25 SET PRCA("STATUS")=$PIECE(^PRCA(430,PRCABN,0),U,8)
SET PRCA("APPR")=$PIECE(^(0),U,18)
End DoDot:2
if PRQUIT
QUIT
+26 IF '$TEST
Begin DoDot:2
+27 SET DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I Z0=104"
+28 DO DIC
IF '$GET(PRCABN)
SET PREND=1
QUIT
+29 ; PRCA*4.5*321
IF $$BILLREJ(PRCABN)
Begin DoDot:3
+30 DO PAUSE("Claim has reject messages, can not be audited")
End DoDot:3
SET PRQUIT=1
QUIT
End DoDot:2
if PREND!PRQUIT
QUIT
+31 ;
+32 SET PRCAKT=$SELECT($PIECE(^PRCA(430,PRCABN,0),U,2)]"":$PIECE(^(0),U,2),1:"")
+33 IF +PRCAKT'>0
if $GET(PRAUTOA)
DO SETERR("NO CATEGORY DEFINED FOR BILL "_$$BILL(PRCABN))
DO END
QUIT
+34 SET PRCARI=$ORDER(^PRCA(430.2,"AC",21,0))
+35 IF $PIECE(^PRCA(430,PRCABN,0),U,21)=""
SET X=PRCABN
if PRCARI=PRCAKT
DO SEGMT
if '$DATA(Y)
SET Y=-1
SET PRCASEG=$SELECT(PRCARI=PRCAKT&(Y<1):"",PRCARI=PRCAKT:Y,$DATA(^PRCA(430.2,PRCAKT,0)):$PIECE(^(0),U,3),1:"")
SET $PIECE(^PRCA(430,PRCABN,0),U,21)=PRCASEG
+36 SET PRCAT=$SELECT($DATA(^PRCA(430.2,PRCAKT,0)):$PIECE(^(0),U,6),1:"")
IF PRCAT=""
if $GET(PRAUTOA)
DO SETERR("NO CATEGORY TYPE DEFINED FOR BILL "_$$BILL(PRCABN))
DO END
QUIT
+37 IF $PIECE(^PRCA(430.2,PRCAKT,0),U,7)=24
SET PRCAT("C")=1
SET Z0=$PIECE(^PRCA(430,PRCABN,0),U,16)
if +Z0'>0
SET Z0=PRCAKT
SET $PIECE(^PRCA(430,PRCABN,0),U,21)=$SELECT($DATA(^PRCA(430.2,+Z0,0)):$PIECE(^(0),U,3),1:0)
KILL Z0,PRCAKT
+38 ;
+39 IF '$GET(PRAUTOA)
DO DISPL
DO DISPLACC^PRCAFUT
Begin DoDot:2
+40 IF $DATA(PRCA("EXIT"))
SET PREND=1
QUIT
+41 DO MESSG
End DoDot:2
if PREND
QUIT
+42 SET PRCARETN=0
SET PRCAOK=$GET(PRAUTOA)
+43 IF '$GET(PRAUTOA)
DO ASK
IF $DATA(PRCA("EXIT"))
DO END
SET PREND=1
QUIT
+44 IF PRCAOK=1
Begin DoDot:2
+45 KILL PRCA("EXIT")
DO MTCHK
IF $DATA(PRCA("EXIT"))
QUIT
+46 if PRCAT="T"
DO THIRD^PRCAUDT1
+47 IF +$PIECE(^PRCA(430,PRCABN,0),U,5)'>0
DO CAUSED^PRCAUDT1
if PRCAOK=0
QUIT
+48 DO COMMENTS^PRCAUT3
if $DATA(PRCA("EXIT"))
QUIT
+49 SET PRCASIG=0
DO SIG
KILL PRCA("EXIT")
if PRCASIG=0
QUIT
+50 DO UPBALN^PRCAUDT1
DO UPSEG
+51 IF '$$ACCK^PRCAACC(PRCABN)
IF ("^28^29^"'[("^"_$GET(PRCAKT)_"^"))
DO EN^PRCAFBD(PRCABN,.ERR)
+52 IF $GET(PRCAKT)=28
DO EN^PRCACPV(PRCABN,.ERR)
if ERR<0
SET PRCA("MESG")="FMS document created . . . "
+53 KILL PRCA("EXIT")
+54 IF +$GET(ERR)>0
Begin DoDot:3
+55 NEW Z,Z0,Z1
+56 SET Z="Unable to create FMS Billing Document: "
SET Z0=$PIECE(ERR,U,2)
SET Z1="Status remains NEW BILL."
+57 IF '$GET(PRAUTOA)
Begin DoDot:4
+58 WRITE *7,!!,Z,!,?10,Z0,!!,Z1,!!
HANG 3
End DoDot:4
+59 IF '$TEST
Begin DoDot:4
+60 DO SETERR(Z)
DO SETERR(Z0)
DO SETERR(Z1)
End DoDot:4
+61 SET PRCA("STATUS")=18
DO UPSTATS^PRCAUT2
+62 ;
End DoDot:3
DO END
QUIT
+63 IF '$GET(PRAUTOA)
DO SIG1
WRITE !,PRCA("MESG")
+64 DO END
End DoDot:2
if $DATA(PRCA("EXIT"))
DO END
QUIT
+65 IF PRCARETN=1
IF '$GET(PRAUTOA)
DO RETN^PRCAUDT1
QUIT
+66 DO END
End DoDot:1
if $SELECT(PREND
QUIT
+67 DO END
+68 QUIT
+69 ;
END LOCK -^PRCA(430,+$GET(PRCABN))
KILL %,DA,PRCAKT,PRCATY,PRCANM,PRCARETN,PRCAOK,PRCAT,DIC,DIE,DR,ERR,PRCASIG,J,Z0,D0,DI,PRC,PRCARI,DIR,DIRUT,DIROUT,DUOUT
+1 DO CLEAN^DILF
+2 QUIT
+3 ;
+4 ;======================== SUBROUTINES ==========================
BULL(PRCABN) ; Send a bulletin for auto audit errors
+1 ; PRCABN = ien of bill in file 430
+2 NEW XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,PRCAE,CT,Z
+3 SET XMTO("I:G.RCDPE PAYMENTS")=""
SET CT=0
+4 SET CT=CT+1
SET PRCAE(CT)="The following problem(s) were encountered when attempting to auto-audit a bill"
SET CT=CT+1
SET PRCAE(CT)="from IB's electronic return messages"
+5 SET CT=CT+1
SET PRCAE(CT)=" "
SET Z=0
+6 FOR
SET Z=$ORDER(^TMP($JOB,"PRCA_AUTO_AUDIT_ERROR",Z))
if 'Z
QUIT
SET CT=CT+1
SET PRCAE(CT)=$GET(^(Z))
+7 SET XMBODY="PRCAE"
+8 DO SENDMSG^XMXAPI("","AUTO AUDIT FAILED FOR BILL "_$$BILL(PRCABN),XMBODY,.XMTO)
+9 QUIT
+10 ;
DIC SET DIC="^PRCA(430,"
SET DIC(0)="AEQM"
DO BILLN^PRCAUTL
QUIT
DIE WRITE !
SET DA=PRCABN
SET DIC="^PRCA(430,"
SET PRCA("LOCK")=0
DO LOCKF^PRCAWO1
if PRCA("LOCK")=1
QUIT
SET DIE=DIC
+1 IF '$$ACCK^PRCAACC(PRCABN)
IF ("^27^28^"'[("^"_PRCAKT_"^"))
DO CPLK^PRCAFUT(PRCABN)
+2 if $DATA(PRCA("EXIT"))
QUIT
SET DR="[PRCAE AUDIT]"
DO ^DIE
KILL DIE,DR
QUIT
DISPL ;display the accounts receivable data user has entered.
+1 if '$DATA(PRCABN)
QUIT
NEW DIC,L,FR,TO,FLDS,IOP,BY
+2 SET IOP=IO(0)
SET DIC="^PRCA(430,"
SET FLDS="[PRCA DISP AUDIT]"
SET (FR,TO)=PRCABN
SET L=0
SET BY="@NUMBER"
DO EN1^DIP
DO WOBIL^PRCAUDT1
QUIT
ASK SET %=2
WRITE !,"IS THIS DATA CORRECT"
DO YN^DICN
IF %<0
SET PRCA("EXIT")=""
QUIT
+1 IF %=0
DO M1^PRCAMESG
GOTO ASK
+2 IF %=1
SET PRCAOK=1
QUIT
ASK1 SET %=2
WRITE !!,"Do you want to edit this information "
DO YN^DICN
IF %<0
SET PRCA("EXIT")=""
QUIT
+1 IF %=0
DO M2^PRCAMESG
GOTO ASK1
+2 IF %=1
DO DIE
DO DISPL
DO DISPLACC^PRCAFUT
GOTO ASK
ASK2 SET %=2
WRITE !!,"Then do you want to return this bill to the service"
DO YN^DICN
IF %<0
SET PRCA("EXIT")=""
QUIT
+1 if %=2
QUIT
IF %=0
WRITE !,"Answer 'Y' (YES) or 'N' (NO)"
GOTO ASK2
ASK3 SET %=2
WRITE !,"Are you sure you want to return"
DO YN^DICN
IF %<0
SET PRCA("EXIT")=""
QUIT
+1 IF %=0
WRITE "Answer 'Y' (YES) if you want to return this bill to the service that originated it. If not, answer 'N' (NO)."
GOTO ASK3
+2 IF %=1
SET PRCARETN=1
QUIT
+3 ;end of ASK
QUIT
SIG NEW PRCADUZ
+1 IF $GET(PRAUTOA)
SET PRCADUZ=+$ORDER(^VA(200,"B","PRCA,AUTOAUDIT",0))
SET PRCANM="AUTO-AUDIT"
+2 IF '$GET(PRAUTOA)
SET DA=PRCABN
DO SIG^PRCASIG
+3 DO NOW^%DTC
IF $DATA(PRCANM)
SET $PIECE(^PRCA(430,PRCABN,9),U,1,3)=$SELECT('$GET(PRAUTOA):+DUZ,1:PRCADUZ)_U_PRCANM_U_%
SET PRCASIG=1
+4 QUIT
SIG1 SET PRCANM=$PIECE($GET(^VA(200,DUZ,20)),U,2)
IF PRCANM]""
DO EN^PRCASIG(.PRCANM,DUZ,PRCABN_+$PIECE(^PRCA(430,PRCABN,0),U,3))
SET $PIECE(^PRCA(430,PRCABN,9),U,2)=PRCANM
+1 QUIT
MESSG QUIT
SEGMT if $DATA(^DGCR(399,PRCABN))
DO ^IBCAMS
if '$DATA(^DGCR(399,PRCABN))
SET Y=297
QUIT
UPSEG ;
+1 SET PRCAT=$PIECE(^PRCA(430,PRCABN,0),U,2)
SET $PIECE(^(0),U,21)=""
+2 DO SEGMT^PRCAEOL
+3 QUIT
CKSITE ;check site parameter and user number.
+1 NEW DIC
+2 SET DIC="^DIC(4,"
SET DIC(0)="QEAM"
SET DIC("B")=$PIECE($GET(^RC(342,1,0)),"^")
SET DIC("A")="SITE: "
DO ^DIC
if Y<0
QUIT
SET PRCA("SITE")=+$$GET1^DIQ(4,+Y,99)
if 'PRCA("SITE")
QUIT
+3 SET PRCA("CKSITE")=""
QUIT
MTCHK NEW PRCAI,PRCAMT,PRCAMT1,Z,Z0
+1 SET PRCAMT1=0
FOR PRCAI=0:0
SET PRCAI=$ORDER(^PRCA(430,PRCABN,2,PRCAI))
if 'PRCAI
QUIT
SET PRCAMT=+$PIECE($GET(^(PRCAI,0)),"^",8)
IF PRCAMT
SET PRCAMT1=PRCAMT1+1
+2 IF PRCAMT1=1
QUIT
+3 SET Z="Currently, just one Fiscal Year amount is sent to FMS."
SET Z0="This bill has "_PRCAMT1_" entered and should be returned to the service."
+4 IF '$GET(PRAUTOA)
Begin DoDot:1
+5 WRITE !!,?3,Z,?3,Z0,!
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO SETERR("BILL: "_$$BILL(PRCABN))
DO SETERR(Z)
DO SETERR(Z0)
End DoDot:1
+8 SET PRCA("EXIT")=""
+9 QUIT
+10 ;ZZPJH WIP 8/21/17
AUDITX(PRCABN) ; Auto audit a bill
+1 NEW PRAUTOA
+2 KILL ^TMP($JOB,"PRCA_AUTO_AUDIT_ERROR")
+3 ;PRCA*4.5*342, Pass text only
LOCK +^PRCA(430,+$GET(PRCABN)):$GET(DILOCKTM,5)
IF '$TEST
DO SETERR("ANOTHER USER HAS LOCKED BILL "_$$BILL(PRCABN))
+4 IF '$DATA(^TMP($JOB,"PRCA_AUTO_AUDIT_ERROR"))
DO AUDITB(PRCABN,1,0)
+5 ;
+6 IF $DATA(^TMP($JOB,"PRCA_AUTO_AUDIT_ERROR"))
DO BULL(PRCABN)
+7 KILL ^TMP($JOB,"PRCA_AUTO_AUDIT_ERROR")
+8 QUIT
+9 ;
SETERR(TEXT) ;
+1 SET ^TMP($JOB,"PRCA_AUTO_AUDIT_ERROR",+$ORDER(^TMP($JOB,"PRCA_AUTO_AUDIT_ERROR",""),-1)+1)=TEXT
+2 QUIT
+3 ;
BILL(PRCABN) ; Returns AR bill number in external format
+1 QUIT $PIECE($GET(^PRCA(430,+$GET(PRCABN),0)),U)
+2 ;
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
+2 ; uncompleted reviews instead of if there were any reject messages at all
+3 ; Input - PRCABN - Internal Entry number from ACCOUNTS RECEIVABLE file [#430]
+4 ; (Note - file #399 has same IEN as file #430)
+5 ; Output - 1 - Reject messages 0 - No Reject messages
+6 NEW BILLNO,RETURN
+7 SET BILLNO=$$GET1^DIQ(399,PRCABN_",",.01,"I")
+8 ; API call covered by IA 7092 - PRCA*4.5*349
SET RETURN=$$BILLREJ2^IBJTU6(BILLNO)
+9 QUIT RETURN
+10 ;
PAUSE(MSG) ; Display message and pause till user responds
+1 ; INPUT - MSG - Message to display to user
+2 ; Output - None
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 WRITE !!,MSG,!
+5 SET DIR(0)="EA"
+6 SET DIR("A")="Type <Enter> to continue: "
+7 DO ^DIR
+8 QUIT
