source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCADR.m@ 724

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PRCADR ;SF-ISC/YJK-PRINT ADDRESS,TRANS.,BALANCE ;9/13/96 11:54 AM [ 02/24/97 12:17 PM ]
2V ;;4.5;Accounts Receivable;**21,45,108,141,241**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;print debtor's 3rd party address,transaction,balances.
5EN1 ;PRINT ADDRESS, SOCIAL SECURITY NUMBER AND DATE OF BIRTH.
6 N RCDMC,RCTOP,RCKAT
7 K PRCAGL D EN11 Q:'$D(PRCAGL) D WR1^PRCADR2
8 I $D(^PRCA(430,D0,8)),$P(^(8),U,7)["N" W !,"* UNABLE TO LOCATE *"
9 D END1 Q
10EN11 Q:'$D(D0) S Z0=$S($P(^PRCA(430,D0,0),U,9)'="":$P(^(0),U,9),1:"") Q:Z0=""
11EN12 S PRCADB=$P(^RCD(340,Z0,0),"^"),RCDMC=$D(^RCD(340,"DMC",1,Z0)),RCTOP=$D(^RCD(340,"TOP",Z0))
12 S X=$$DADD^RCAMADD(PRCADB) S $P(PRCAGL,"^",1,6)=$P(X,"^",1,6),$P(PRCAGL,"^",9)=$P(X,"^",7) K PRCADB
13 S Z1=$P(^RCD(340,Z0,0),";",1),Z2=$P($P(^(0),"^"),";",2),PRCASTE=$P(PRCAGL,U,5)
14 S (PRCASSN,PRCADOB)="" I '$D(^VA(200,Z1,0)),'$D(^DPT(Z1,0)) Q
15 S DFN=Z1 D DEM^VADPT I VAERR K VAERR Q
16 S PRCASSN=$S(Z2["VA(200":$P(^VA(200,Z1,1),U,9),1:"")
17 I Z2["DPT(" S DFN=Z1 D DEM^VADPT S PRCASSN=$P(VADM(2),"^",2)
18 S RCKAT="" I $$EMGRES^DGUTL(DFN)["K" S RCKAT=1
19 S PRCASSN=$S((PRCASSN["-")!($L(PRCASSN)>9):PRCASSN,1:$E(PRCASSN,1,3)_"-"_$E(PRCASSN,4,5)_"-"_$E(PRCASSN,6,9))
20 S PRCADOB=$S(Z2["VA(200":$P(^VA(200,Z1,1),U,3),Z2["DPT":$P(VADM(3),"^",1),1:"")
21 S PRCADOB=$$SLH^RCFN01(PRCADOB) K DFN,VAERR,VADM,Z1,Z2 Q
22END1 K %,PRCADOB,PRCASSN,PRCASTE,PRCAGL,Z1,Z2,Z0 Q
23EN2 ;prints all transaction type of AR in the Profile of AR.
24 Q:'$D(D0) S PRCAEN=0,PRCAK1=1 K PRCA("WROFF")
25 F I=0:0 S PRCAEN=$O(^PRCA(433,"C",D0,PRCAEN)) Q:'PRCAEN D WR2^PRCADR2 S PRCAK1=PRCAK1+1 I PRCAK1>7 D EN5 Q:$D(PRCA("HALT")) S PRCAK1=-5
26END2 K I,PRCAEN,PRCAK1,PRCAG,% Q ;end of EN2
27EN3 ;Print the balances and paid amount of Principal,Interest and Admin.
28PRBAL S (PRCAK("PB"),PRCAK("IB"),PRCAK("AB"),PRCAK("IP"),PRCAK("PP"),PRCAK("AP"),PRCAK("MF"),PRCAK("CC"))=0
29 I $D(^PRCA(430,D0,7)) D PRBAL1
30 S (PRCAL(1),PRCAL(2),PRCAL(3),PRCAL(4),PRCAL(5),PRCAL(6),PRCACODE)=""
31 I $D(^PRCA(430,D0,6)) S PRCAGL6=^(6),PRCAL(1)=$P(PRCAGL6,U,1),PRCAL(2)=$P(PRCAGL6,U,2),PRCAL(3)=$P(PRCAGL6,U,3),PRCAL(4)=$P(PRCAGL6,U,4),PRCACODE=$P(PRCAGL6,U,5),PRCAL(5)=$P(PRCAGL6,U,7),PRCAL(6)=$P(PRCAGL6,U,14)
32 S PRCACODE=$S(PRCACODE]"""":PRCACODE,1:"DC/DOJ")
33 S PRCALT=PRCAL(1) D LDATE S PRCAL(1)=PRCALT,PRCALT=PRCAL(2) D LDATE S PRCAL(2)=PRCALT,PRCALT=PRCAL(3) D LDATE S PRCAL(3)=PRCALT
34 S PRCALT=PRCAL(4) D LDATE S PRCAL(4)=PRCALT,PRCALT=PRCAL(5) D LDATE S PRCAL(5)=PRCALT,PRCALT=PRCAL(6) D LDATE S PRCAL(6)=PRCALT
35 D WR3^PRCADR2
36END3 K PRCAL,PRCACODE,PRCALT,PRCAGL6,PRCAGL7,PRCAK Q
37PRBAL1 S PRCAGL7=^PRCA(430,D0,7),PRCAK("PP")=$P(PRCAGL7,U,7),PRCAK("IP")=$P(PRCAGL7,U,8),PRCAK("AP")=$P(PRCAGL7,U,9)
38 S PRCAK("PB")=$P(PRCAGL7,U,1),PRCAK("IB")=$P(PRCAGL7,U,2),PRCAK("AB")=$P(PRCAGL7,U,3),PRCAK("MF")=$P(PRCAGL7,U,4),PRCAK("CC")=$P(PRCAGL7,U,5)
39 Q
40LDATE Q:PRCALT="" S PRCALT=$$SLH^RCFN01(PRCALT) Q
41EN4 ;Print 3rd party address information.
42 Q:'$D(D0) S Z0=$S($P(^PRCA(430,D0,0),U,9)'="":$P(^(0),U,9),1:"") Q:Z0="" S PRCADB=$P(^RCD(340,Z0,0),"^") S X=$$DADD^RCAMADD(PRCADB) S $P(PRCAGL,"^",1,6)=$P(X,"^",1,6),$P(PRCAGL,"^",9)=$P(X,"^",7) K PRCADB
43 W !,?12,$P(PRCAGL,U) F X=2,3,4 W:$P(PRCAGL,U,X)'="" !,?12,$P(PRCAGL,U,X)
44 I $P(PRCAGL,U,5)'="",$P(PRCAGL,U,5)'[" " W ", ",$P(PRCAGL,U,5)," ",$P(PRCAGL,U,6)
45 W " PHONE NO.: ",$P(PRCAGL,U,9)
46END4 K %,PRCAGL,Z0 Q
47EN5 K PRCA("HALT") Q:'$D(PRCAIO)
48 I $E(IOST,1,2)["C-" R !,?8,"ENTER '^' TO HALT: ",X:$S($D(DTIME):DTIME,1:999) I (X["^")!('$T) S PRCA("HALT")=1 Q
49 I $E(IOST,1,2)["C-",$D(IOF) W @IOF
50 Q
51 ;
52SVDT(D0) ;Called from the PRCA 3RD PROFILE print template
53 N X S X="IBRFN" X ^%ZOSF("TEST") G SVDTQ:'$T
54 S D0=$P($P($G(^PRCA(430,+D0,0)),"^"),"-",2)
55 S X=$$SVDT^IBRFN(D0)
56 Q X
57SVDTQ Q 0
Note: See TracBrowser for help on using the repository browser.