PRCAUDT1 ;SF-ISC/YJK-SUBROUTINE AUDIT A NEW BILL/EDIT INCOMPLETE AR ;5/1/95 3:05 PM
V ;;4.5;Accounts Receivable;**1,173,371**;Mar 20, 1995;Build 29
;;Per VHA Directive 6402, this routine should not be modified.
;This audits a new bill and edits incomplete accounts receivables.
;
; DBIA for reference to file 399.3: DBIA4118
;
RETN S DR="36",DA=PRCABN,DIE="^PRCA(430," D ^DIE K DR,DIE,DA
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
W !,"THE BILL HAS BEEN RETURNED",! Q ;end of RETN
K DR Q
WOBIL ;Check if the patient account has old written-off bills.
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
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"))
W:$D(PRCA("WO")) !,*7,"This debtor has had another account written-off",!
K PRCAWO,PRCAWOB,PRCA("DEBTOR"),Z0,PRCA("WO") Q
WOBIL1 I $P(^PRCA(430,Z0,0),U,8)=PRCAWOB S PRCA("WO")=1 Q
Q
UPBALN I $P(^PRCA(430,PRCABN,0),U,3)="",$D(^PRCA(430,PRCABN,2,0)) D ORAMT
N PRCFDA I '$D(^PRCA(430,PRCABN,7)) S PRCFDA(430,PRCABN_",",71)=$P(^(0),U,3) D FILE^DIE(,"PRCFDA") ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
I +$P(^PRCA(430,PRCABN,7),U,1)'>0 S PRCFDA(430,PRCABN_",",71)=$P(^PRCA(430,PRCABN,0),U,3) D FILE^DIE(,"PRCFDA") ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
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:"")
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",!
S PRCA("STATUS")=$O(^PRCA(430.3,"AC",102,"")),PRCA("SDT")=DT D UPSTATS^PRCAUT2 Q ;end of UPBALN
ORAMT S PRCAK1=0,%=0
F PRCAK=0:0 S %=$O(^PRCA(430,PRCABN,2,%)) Q:'% S PRCAK1=PRCAK1+$P(^PRCA(430,PRCABN,2,%,0),U,2)
S $P(^PRCA(430,PRCABN,0),U,3)=PRCAK1 K PRCAK,PRCAK1,% Q
;
CAUSED ;edit caused by,principal balance and general ledger number.
I '$G(PRAUTOA) K PRCA("AUTO_AUDIT")
S DA=PRCABN,DR="[PRCA CAUSED BY]",DIE="^PRCA(430," D ^DIE
I $D(Y) D
. S PRCAOK=0
. I '$G(PRAUTOA) W *7,"YOU SHOULD MAKE AN ENTRY !" Q
. D SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(PRCABN)),SETERR^PRCAUDT("ERROR ENCOUNTERED STORING 'BILL RESULTING FROM'")
K DR
Q
;
THIRD ; Check for 3rd party info on AR bill
Q:$D(^PRCA(430,PRCABN,202))
; PRAUTOA is the flag for IB's call to audit-audit an electronic bill
N Z S Z="This bill does not have 3rd party information."
I $G(PRAUTOA) D SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(PRCABN)),SETERR^PRCAUDT(Z) Q
W !,Z,!
S %=2 W "Do you want to enter the data " D YN^DICN Q:(%<0)!(%=2)
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
S DIE="^PRCA(430,",DR="[PRCAE INSURANCE DATA]",DA=PRCABN D ^DIE K DR,DIE,DA Q
;
RESFROM ; Update the BILL RESULTING FROM field for a rate type in RATE TYPE file
; #399.3
N X,Y,DIR,RC1,RCDA,DIC,DTOUT,DUOUT
S RC1=0
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
. S RC1=1
. S DIR(0)="YA",DIR("A")="AUTO-AUDIT?: ",DIR("B")=$S($P($G(^DGCR(399.3,+RCDA,0)),U,11)'="":"YES",1:"NO")
. D ^DIR K DIR
. Q:$D(DUOUT)!$D(DTOUT)
. I Y=1 S DR=".11",DIE="^DGCR(399.3,",DA=RCDA D ^DIE Q
. S DR=".11///@",DIE="^DGCR(399.3,",DA=RCDA D ^DIE W ! Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAUDT1 3633 printed Dec 13, 2024@01:41:58 Page 2
PRCAUDT1 ;SF-ISC/YJK-SUBROUTINE AUDIT A NEW BILL/EDIT INCOMPLETE AR ;5/1/95 3:05 PM
V ;;4.5;Accounts Receivable;**1,173,371**;Mar 20, 1995;Build 29
+1 ;;Per VHA Directive 6402, this routine should not be modified.
+2 ;This audits a new bill and edits incomplete accounts receivables.
+3 ;
+4 ; DBIA for reference to file 399.3: DBIA4118
+5 ;
RETN SET DR="36"
SET DA=PRCABN
SET DIE="^PRCA(430,"
DO ^DIE
KILL DR,DIE,DA
+1 SET PRCA("STATUS")=$ORDER(^PRCA(430.3,"AC",220,""))
SET PRCA("SDT")=DT
SET PRCASV("STATUS")=1
DO UPSTATS^PRCAUT2
SET $PIECE(^PRCA(430,PRCABN,3),U,1)=DT
SET $PIECE(^(3),U,2)=DUZ
+2 ;end of RETN
WRITE !,"THE BILL HAS BEEN RETURNED",!
QUIT
+3 KILL DR
QUIT
WOBIL ;Check if the patient account has old written-off bills.
+1 if ('$DATA(PRCAT))!('$DATA(PRCABN))
QUIT
if "CP"'[PRCAT
QUIT
SET PRCA("DEBTOR")=$PIECE(^PRCA(430,PRCABN,0),U,9)
if PRCA("DEBTOR")=""
QUIT
SET PRCAWOB=$ORDER(^PRCA(430.3,"AC",109,0))
SET Z0=0
+2 FOR PRCAWO=0:0
SET Z0=$ORDER(^PRCA(430,"C",PRCA("DEBTOR"),Z0))
if +Z0'>0
QUIT
IF Z0'=PRCABN
DO WOBIL1
if $DATA(PRCA("WO"))
QUIT
+3 if $DATA(PRCA("WO"))
WRITE !,*7,"This debtor has had another account written-off",!
+4 KILL PRCAWO,PRCAWOB,PRCA("DEBTOR"),Z0,PRCA("WO")
QUIT
WOBIL1 IF $PIECE(^PRCA(430,Z0,0),U,8)=PRCAWOB
SET PRCA("WO")=1
QUIT
+1 QUIT
UPBALN IF $PIECE(^PRCA(430,PRCABN,0),U,3)=""
IF $DATA(^PRCA(430,PRCABN,2,0))
DO ORAMT
+1 ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
NEW PRCFDA
IF '$DATA(^PRCA(430,PRCABN,7))
SET PRCFDA(430,PRCABN_",",71)=$PIECE(^(0),U,3)
DO FILE^DIE(,"PRCFDA")
+2 ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
IF +$PIECE(^PRCA(430,PRCABN,7),U,1)'>0
SET PRCFDA(430,PRCABN_",",71)=$PIECE(^PRCA(430,PRCABN,0),U,3)
DO FILE^DIE(,"PRCFDA")
+3 SET $PIECE(^PRCA(430,PRCABN,0),U,4)=$SELECT($PIECE(^PRCA(430,PRCABN,0),U,2)>0:$PIECE(^PRCA(430.2,$PIECE(^(0),U,2),0),U,4),1:"")
+4 SET $PIECE(^PRCA(430,PRCABN,0),U,12)=$SELECT($DATA(PRCA("SITE")):PRCA("SITE"),1:"")
IF '$DATA(PRCA("SITE"))
if '$GET(PRAUTOA)
WRITE !!,"HELP AT UPBALN+4",!
+5 ;end of UPBALN
SET PRCA("STATUS")=$ORDER(^PRCA(430.3,"AC",102,""))
SET PRCA("SDT")=DT
DO UPSTATS^PRCAUT2
QUIT
ORAMT SET PRCAK1=0
SET %=0
+1 FOR PRCAK=0:0
SET %=$ORDER(^PRCA(430,PRCABN,2,%))
if '%
QUIT
SET PRCAK1=PRCAK1+$PIECE(^PRCA(430,PRCABN,2,%,0),U,2)
+2 SET $PIECE(^PRCA(430,PRCABN,0),U,3)=PRCAK1
KILL PRCAK,PRCAK1,%
QUIT
+3 ;
CAUSED ;edit caused by,principal balance and general ledger number.
+1 IF '$GET(PRAUTOA)
KILL PRCA("AUTO_AUDIT")
+2 SET DA=PRCABN
SET DR="[PRCA CAUSED BY]"
SET DIE="^PRCA(430,"
DO ^DIE
+3 IF $DATA(Y)
Begin DoDot:1
+4 SET PRCAOK=0
+5 IF '$GET(PRAUTOA)
WRITE *7,"YOU SHOULD MAKE AN ENTRY !"
QUIT
+6 DO SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(PRCABN))
DO SETERR^PRCAUDT("ERROR ENCOUNTERED STORING 'BILL RESULTING FROM'")
End DoDot:1
+7 KILL DR
+8 QUIT
+9 ;
THIRD ; Check for 3rd party info on AR bill
+1 if $DATA(^PRCA(430,PRCABN,202))
QUIT
+2 ; PRAUTOA is the flag for IB's call to audit-audit an electronic bill
+3 NEW Z
SET Z="This bill does not have 3rd party information."
+4 IF $GET(PRAUTOA)
DO SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(PRCABN))
DO SETERR^PRCAUDT(Z)
QUIT
+5 WRITE !,Z,!
+6 SET %=2
WRITE "Do you want to enter the data "
DO YN^DICN
if (%<0)!(%=2)
QUIT
+7 IF %=0
WRITE !,"You may enter 'INSURED NAME', 'ID NO', 'GROUP NAME' and 'GROUP NO' for this bill. Answer 'Y' (YES) or 'N' (NO)."
GOTO THIRD
+8 SET DIE="^PRCA(430,"
SET DR="[PRCAE INSURANCE DATA]"
SET DA=PRCABN
DO ^DIE
KILL DR,DIE,DA
QUIT
+9 ;
RESFROM ; Update the BILL RESULTING FROM field for a rate type in RATE TYPE file
+1 ; #399.3
+2 NEW X,Y,DIR,RC1,RCDA,DIC,DTOUT,DUOUT
+3 SET RC1=0
+4 ; IA 4118
FOR
SET DIC(0)="AEMQ"
SET DIC="^DGCR(399.3,"
WRITE !
DO ^DIC
if Y'>0
QUIT
SET RCDA=+Y
Begin DoDot:1
+5 SET RC1=1
+6 SET DIR(0)="YA"
SET DIR("A")="AUTO-AUDIT?: "
SET DIR("B")=$SELECT($PIECE($GET(^DGCR(399.3,+RCDA,0)),U,11)'="":"YES",1:"NO")
+7 DO ^DIR
KILL DIR
+8 if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+9 IF Y=1
SET DR=".11"
SET DIE="^DGCR(399.3,"
SET DA=RCDA
DO ^DIE
QUIT
+10 SET DR=".11///@"
SET DIE="^DGCR(399.3,"
SET DA=RCDA
DO ^DIE
WRITE !
QUIT
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+11 QUIT
+12 ;
