| 1 | PRCAGDR ;WASH-ISC@ALTOONA,PA/CMS - BALANCE DISCREPANCY REPORT ;12/3/93 9:40 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**78,198**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | N CHK,DAT,DEB,DIC,LN1,LN2,NAM,SSN,STD,PG,POP,Y,X,%ZIS
|
|---|
| 5 | PAT ;select patient
|
|---|
| 6 | N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
|
|---|
| 7 | W ! S DIC="^DPT(",DIC(0)="AENMQ",DIC("A")="Select Patient: " D ^DIC G:Y<1 OUT S DEB=$O(^RCD(340,"B",+Y_";DPT(",0)) I 'DEB W *7," No AR Information exists!" G PAT
|
|---|
| 8 | S $P(LN1,"_",80)="",$P(LN2,"=",80)="",NAM=$$NAM^RCFN01(DEB),SSN=$E($$SSN^RCFN01(DEB),6,9),STD=$$PST^RCAMFN01(DEB) S:STD<1 STD="UNKNOWN"
|
|---|
| 9 | S PG=0 D HD
|
|---|
| 10 | I '$$EN^PRCAMRKC(DEB) W !!,"This patient's account is currently in balance!"
|
|---|
| 11 | E W !!,"This account is out-of-balance!"
|
|---|
| 12 | D ST
|
|---|
| 13 | D ASK I CHK=1 D DEV
|
|---|
| 14 | G PAT
|
|---|
| 15 | DEV W ! S IOP="Q",%ZIS="QN",%ZIS("B")="" D ^%ZIS G:POP OUT
|
|---|
| 16 | I '$D(IO("Q")) W !!,*7,"YOU MUST QUEUE THIS REPORT!!",! G DEV
|
|---|
| 17 | S ZTSAVE("DEB")="",ZTSAVE("NAM")="",ZTSAVE("SSN")="",ZTSAVE("STD")="",ZTRTN="EN^PRCAGDR",ZTDESC="AR DISCREPANCY REPORT" D ^%ZTLOAD G OUT
|
|---|
| 18 | Q
|
|---|
| 19 | OUT D ^%ZISC
|
|---|
| 20 | Q
|
|---|
| 21 | CONT ;Ask to Continue
|
|---|
| 22 | ;N Y
|
|---|
| 23 | ;W !! S DIR(0)="E" D ^DIR I Y'=1 S DTOUT=1 Q
|
|---|
| 24 | Q
|
|---|
| 25 | HD ;PAGE HEADING
|
|---|
| 26 | N DIR,Y S PG=PG+1
|
|---|
| 27 | W @IOF,!!,?3,NAM,"(",$E(NAM,1),SSN,") ACCOUNT BALANCE DISCREPANCY REPORT"
|
|---|
| 28 | N %,%H,%I,X,Y
|
|---|
| 29 | D NOW^%DTC S Y=% D DD^%DT
|
|---|
| 30 | W !,?3,"STATEMENT DAY: ",STD,?46,Y," PAGE ",PG,!,LN2
|
|---|
| 31 | HDQ Q
|
|---|
| 32 | ASK ;Ask print statement
|
|---|
| 33 | N DIR,X,Y
|
|---|
| 34 | W ! S DIR("A")="Print example of patient statement",DIR(0)="Y" D ^DIR S CHK=Y
|
|---|
| 35 | Q
|
|---|
| 36 | EN ;Enter here to print statement from queue
|
|---|
| 37 | N BN,DAT,PAGE,X,Y S PG=0,PAGE=0,$P(LN1,"_",80)="",$P(LN2,"=",80)=""
|
|---|
| 38 | D HD,ST
|
|---|
| 39 | Q
|
|---|
| 40 | ST ;Start here find bills
|
|---|
| 41 | NEW BBAL,BEG,CHK,END,LDT3,PBAL,PDAT,PEND,SITE,TBAL,X,Y
|
|---|
| 42 | I 'STD D 9^PRCAGDT Q
|
|---|
| 43 | K ^TMP("PRCAGT",$J) D SITE^PRCAGU
|
|---|
| 44 | D NOW^%DTC S END=%,CHK=1,PBAL=0,DAT=$E(DT,1,5)_$S($L(STD)=1:0_STD,1:STD)
|
|---|
| 45 | S LDT3=$$FPS^RCAMFN01(DAT,-3)
|
|---|
| 46 | S BEG=$$LST^RCFN01(DEB,2) I $P(BEG,".")'<$P(DAT,".") D 8^PRCAGDT(BEG) Q
|
|---|
| 47 | I BEG<1 S PDAT="",BEG=0,PBAL=0
|
|---|
| 48 | I BEG S PDAT=BEG,BEG=9999999.999999-BEG D PBAL^PRCAGU(DEB,.BEG,.PBAL)
|
|---|
| 49 | D EN^PRCAGT(DEB,BEG,.END)
|
|---|
| 50 | S TBAL=0 D TBAL^PRCAGT(DEB,.TBAL)
|
|---|
| 51 | S BBAL=0 D BBAL^PRCAGU(DEB,.BBAL)
|
|---|
| 52 | W !!,"Patient Statement Check:",!!
|
|---|
| 53 | S X=$$PRE^PRCAGU(DEB) S PEND=$P(X,U,2),X=+X
|
|---|
| 54 | I X,BBAL D 3^PRCAGDT Q
|
|---|
| 55 | I BBAL=0,PEND,-PEND=PBAL+TBAL D 2^PRCAGDT Q
|
|---|
| 56 | I BBAL'=(PBAL+TBAL) D 1^PRCAGDT(DEB,BBAL,.TBAL,PBAL,BEG) Q
|
|---|
| 57 | I BBAL=0,$G(SITE("ZERO")) D 4^PRCAGDT Q
|
|---|
| 58 | I BBAL'>0,'$D(^TMP("PRCAGT",$J,DEB)) D 5^PRCAGDT Q
|
|---|
| 59 | I BBAL<0,BBAL>-.99 D 6^PRCAGDT Q
|
|---|
| 60 | I BBAL'<0,'$$ACT^PRCAGT(DEB,LDT3) D 7^PRCAGDT Q
|
|---|
| 61 | I CHK=1 D OK^PRCAGDT
|
|---|
| 62 | K ^TMP("PRCAGT",$J)
|
|---|
| 63 | Q
|
|---|
