PRCAGDR ;WASH-ISC@ALTOONA,PA/CMS - BALANCE DISCREPANCY REPORT ;12/3/93  9:40 AM
V ;;4.5;Accounts Receivable;**78,198**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 N CHK,DAT,DEB,DIC,LN1,LN2,NAM,SSN,STD,PG,POP,Y,X,%ZIS
PAT ;select patient
 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
 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
 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"
 S PG=0 D HD
 I '$$EN^PRCAMRKC(DEB) W !!,"This patient's account is currently in balance!"
 E  W !!,"This account is out-of-balance!"
 D ST
 D ASK I CHK=1 D DEV
 G PAT
DEV W ! S IOP="Q",%ZIS="QN",%ZIS("B")="" D ^%ZIS G:POP OUT
 I '$D(IO("Q")) W !!,*7,"YOU MUST QUEUE THIS REPORT!!",! G DEV
 S ZTSAVE("DEB")="",ZTSAVE("NAM")="",ZTSAVE("SSN")="",ZTSAVE("STD")="",ZTRTN="EN^PRCAGDR",ZTDESC="AR DISCREPANCY REPORT" D ^%ZTLOAD G OUT
 Q
OUT D ^%ZISC
 Q
CONT ;Ask to Continue
 ;N Y
 ;W !! S DIR(0)="E" D ^DIR I Y'=1 S DTOUT=1 Q
 Q
HD ;PAGE HEADING
 N DIR,Y S PG=PG+1
 W @IOF,!!,?3,NAM,"(",$E(NAM,1),SSN,")   ACCOUNT BALANCE DISCREPANCY REPORT"
 N %,%H,%I,X,Y
 D NOW^%DTC S Y=% D DD^%DT
 W !,?3,"STATEMENT DAY: ",STD,?46,Y,"    PAGE ",PG,!,LN2
HDQ Q
ASK ;Ask print statement
 N DIR,X,Y
 W ! S DIR("A")="Print example of patient statement",DIR(0)="Y" D ^DIR S CHK=Y
 Q
EN ;Enter here to print statement from queue
 N BN,DAT,PAGE,X,Y S PG=0,PAGE=0,$P(LN1,"_",80)="",$P(LN2,"=",80)=""
 D HD,ST
 Q
ST ;Start here find bills
 NEW BBAL,BEG,CHK,END,LDT3,PBAL,PDAT,PEND,SITE,TBAL,X,Y
 I 'STD D 9^PRCAGDT Q
 K ^TMP("PRCAGT",$J) D SITE^PRCAGU
 D NOW^%DTC S END=%,CHK=1,PBAL=0,DAT=$E(DT,1,5)_$S($L(STD)=1:0_STD,1:STD)
 S LDT3=$$FPS^RCAMFN01(DAT,-3)
 S BEG=$$LST^RCFN01(DEB,2) I $P(BEG,".")'<$P(DAT,".") D 8^PRCAGDT(BEG) Q
 I BEG<1 S PDAT="",BEG=0,PBAL=0
 I BEG S PDAT=BEG,BEG=9999999.999999-BEG D PBAL^PRCAGU(DEB,.BEG,.PBAL)
 D EN^PRCAGT(DEB,BEG,.END)
 S TBAL=0 D TBAL^PRCAGT(DEB,.TBAL)
 S BBAL=0 D BBAL^PRCAGU(DEB,.BBAL)
 W !!,"Patient Statement Check:",!!
 S X=$$PRE^PRCAGU(DEB) S PEND=$P(X,U,2),X=+X
 I X,BBAL D 3^PRCAGDT Q
 I BBAL=0,PEND,-PEND=PBAL+TBAL D 2^PRCAGDT Q
 I BBAL'=(PBAL+TBAL) D 1^PRCAGDT(DEB,BBAL,.TBAL,PBAL,BEG) Q
 I BBAL=0,$G(SITE("ZERO")) D 4^PRCAGDT Q
 I BBAL'>0,'$D(^TMP("PRCAGT",$J,DEB)) D 5^PRCAGDT Q
 I BBAL<0,BBAL>-.99 D 6^PRCAGDT Q
 I BBAL'<0,'$$ACT^PRCAGT(DEB,LDT3) D 7^PRCAGDT Q
 I CHK=1 D OK^PRCAGDT
 K ^TMP("PRCAGT",$J)
 Q