source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCADR1.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1PRCADR1 ;SF-ISC/YJK-PRINT ADDRESS,APPROPR.CDS ;8/16/96 1:02 PM
2V ;;4.5;Accounts Receivable;**49,138**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;print debtor's /vendor address,multiple appropriations,list of other bills.
5EN1 ;print the appropriation,pat ref #. (multiple) and amount.
6 W !,"ORIGINAL AMOUNT: ",$J($P(^PRCA(430,D0,0),U,3),0,2)
7 I $P($G(^PRCA(430,D0,13)),"^") W !,"MEDICARE CONTRACTUAL ADJUSTMENT: ",$J($P($G(^PRCA(430,D0,13)),"^"),0,2)
8 I $P($G(^PRCA(430,D0,13)),"^",2) W !,"UNREIMBURSED MEDICARE EXPENSE: ",$J($P($G(^PRCA(430,D0,13)),"^",2),0,2)
9 W !!,"FISCAL YEAR",?15,"APPROP. CODE",?38,"PAT REFERENCE #",?63,"AMOUNT"
10 W !,"-----------",?15,"------------",?38,"---------------",?63,"------"
11 S PRCAFN=0 F PRCAE1=0:0 S PRCAFN=$O(^PRCA(430,D0,2,PRCAFN)) Q:PRCAFN'>0 D WRPAT
12END1 K PRCAE1,PRCAFN Q ;end of EN1
13WRPAT Q:'$D(^PRCA(430,D0,2,PRCAFN,0)) S PRCAFY=$P(^(0),U,1),PRCAMT=$P(^(0),U,2)
14 S PRCAPAT="" I $P(^PRCA(430,D0,2,PRCAFN,0),U,3)'="" S PRCAPAT=$S($D(^PRC(442,$P(^(0),U,3),0)):$P(^(0),U,1),1:"")
15 S PRCAPPR=$P($G(^PRCA(430,D0,11)),U,17)
16 W !,?5,PRCAFY,?18,$E(PRCAPPR,1,10),?40,PRCAPAT,?60,$J(PRCAMT,9,2)
17 K PRCAPAT,PRCAPPR,PRCAFY,PRCAMT Q
18EN2 ;PRINT DEBTOR'S ADDRESS - VENDOR
19 Q:'$D(D0) S PRCADBPT=$S($P(^PRCA(430,D0,0),U,9)'="":$P(^(0),U,9),1:"") G:PRCADBPT="" END2 S PRCADB=$P(^RCD(340,PRCADBPT,0),"^") N X S X=$$DADD^RCAMADD(PRCADB) S $P(PRCAGL,"^",1,6)=$P(X,"^",1,6),$P(PRCAGL,"^",9)=$P(X,"^",7) K PRCADB
20 S PRCASTE=$P(PRCAGL,U,5),PRCALN=$S($D(PRCALN):PRCALN,1:0)
21WR W:PRCALN<1 ! W !,?PRCALN,$P(PRCAGL,U,1)
22 F I=2,3,4 W:$P(PRCAGL,U,I)'="" !,?PRCALN,$P(PRCAGL,U,I)
23 I PRCASTE'="",PRCASTE'[" " W ", ",PRCASTE," ",$P(PRCAGL,U,6)
24 W " PHONE NO.:",$P(PRCAGL,U,9)
25END2 K %,PRCASTE,PRCAGL,PRCADBPT,PRCALN Q
26 ;
27EN4 ;Print the debtor's other bills.
28 D PRCOMM^PRCAUT3 Q:'$D(D0) S PRCAT1=$P(^PRCA(430,D0,0),U,2) G:PRCAT1="" END4 S PRCAT1=$P(^PRCA(430.2,PRCAT1,0),U,6) G:PRCAT1["T" END4
29 S PRCADBPT=$S($P(^PRCA(430,D0,0),U,9)'="":$P(^(0),U,9),1:"")
30 G:PRCADBPT="" END4 S X=$P(^RCD(340,PRCADBPT,0),"^",3)
31 W !,"Statement date: " N %DT,Y S %DT="F",X=$S($E(DT,6,7)>X:$S($E(DT,4,5)+1>12:1,1:$E(DT,4,5)+1),1:$E(DT,4,5))_"-"_$P(^RCD(340,PRCADBPT,0),"^",3) D ^%DT X ^DD("DD") W $S($L(Y)>4:Y,1:"N/A")
32 S PRCABNT="",PRCACT=0 W !,"OTHER BILLS:",!?2
33 F I=0:0 S PRCABNT=$O(^PRCA(430,"C",PRCADBPT,PRCABNT)) Q:PRCABNT="" I PRCABNT'=D0,$D(^PRCA(430,PRCABNT,0)) S PRCACT=PRCACT+1,X="" D:$Y+5>IOSL&($E(IOST)="C") Q:X["^" D EN41
34 .W *7 R X:DTIME I '$T S X="^" Q
35 .W @IOF,!?2
36 .Q
37END4 K PRCAT1,PRCADBPT,PRCABNT,I,PRCACT Q ;end of EN4
38EN41 S PRCAT11=$P(^PRCA(430,PRCABNT,0),U,2) G:PRCAT11="" END41 S PRCAT11=^PRCA(430.2,PRCAT11,0)
39 S PRCABTY=" ("_$E(PRCAT11,1,4)_"/"_$S($D(^PRCA(430.3,+$P(^PRCA(430,PRCABNT,0),"^",8),0)):$E($P(^(0),"^"),1,4),1:"")_") " W $P(^PRCA(430,PRCABNT,0),U,1),PRCABTY W:'(PRCACT#3) !?2
40END41 K PRCABTY,PRCAT11 Q ;end of EN41
41EN5 ;Print interest/admin rate date and rate.
42 Q:'$D(PRCABN) S (PRCA("INTD"),PRCA("INTR"),PRCA("ADMD"),PRCA("ADMR"))=""
43 S PRCAIDT=X,X=$$INT^RCMSFN01($P(^PRCA(430,PRCABN,0),"^",10)),PRCA("INTR")=+X
44 S Y=$P(X,"^",2) X ^DD("DD") S PRCA("INTD")=Y
45EN51 ;
46 S X=$$ADM^RCMSFN01($P(^PRCA(430,PRCABN,0),"^",10)),PRCA("ADMR")=+X,Y=$P(X,"^",2) X ^DD("DD") S PRCA("ADMD")=Y
47W5 W !!,"INTEREST EFFECTIVE RATE DATE: ",PRCA("INTD"),?45,"ANNUAL INTEREST RATE: ",PRCA("INTR")
48 W !,"ADMIN EFFECTIVE RATE DATE: ",PRCA("ADMD"),?45,"MONTHLY ADMIN RATE: ",PRCA("ADMR")
49 S X=$S($D(PRCAIDT):PRCAIDT,1:"") K PRCA("INTD"),PRCA("ADMR"),PRCA("ADMD"),PRCA("INTR"),PRCAIDT Q
50PATNM ;write a patient name for the 3rd party
51 Q:('$D(PRCAT))!('$D(PRCABN)) Q:PRCAT'["T"
52 S DFN=$P(^PRCA(430,PRCABN,0),U,7) I DFN D DEM^VADPT
53 W !,"PATIENT: ",$S($D(VADM):VADM(1),1:""),?45,"SSN: ",$S($D(VADM):$P(VADM(2),U,2),1:""),! K DFN,VADM,VAERR Q ;end of PATNM
54EN6 ;Insurance insured's information
55 Q:('$D(PRCAT))!('$D(PRCABN)) Q:PRCAT'["T" S Z=$S($D(^PRCA(430,PRCABN,202)):^(202),1:"")
56 W !!,"INSURED'S NAME",?28,"ID NO.",?45,"GROUP NAME",?62,"GROUP NO."
57 W !,?2,$P(Z,U,1),?29,$P(Z,U,4),?46,$P(Z,U,5),?63,$P(Z,U,6)
58 S %=^PRCA(430,PRCABN,0) W:$P(%,U,19)>0 !!,"SECONDARY INSURANCE CARRIER: ",$S($D(^DIC(36,+$P(%,U,19),0)):$P(^(0),U,1),1:"")
59 W:$P(%,U,20)>0 !,"TERTIARY INSURANCE CARRIER: ",$S($D(^DIC(36,+$P(%,U,20),0)):$P(^(0),U,1),1:"") K %,Z Q
Note: See TracBrowser for help on using the repository browser.