source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAGDR.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1PRCAGDR ;WASH-ISC@ALTOONA,PA/CMS - BALANCE DISCREPANCY REPORT ;12/3/93 9:40 AM
2V ;;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
5PAT ;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
15DEV 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
19OUT D ^%ZISC
20 Q
21CONT ;Ask to Continue
22 ;N Y
23 ;W !! S DIR(0)="E" D ^DIR I Y'=1 S DTOUT=1 Q
24 Q
25HD ;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
31HDQ Q
32ASK ;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
36EN ;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
40ST ;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
Note: See TracBrowser for help on using the repository browser.