source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCCPCPS1.m@ 660

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

initial load of WorldVistAEHR
File size: 6.8 KB
RevLine 
[613]1RCCPCPS1 ;WISC/RFJ-build description for patient statement ;08 Aug 2001
2 ;;4.5;Accounts Receivable;**34,48,104,170,176,192**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7TRANDESC(RCTRANDA,RCWIDTH) ; build the description array for a transaction
8 ;
9 ; initialize
10 N DESCRIPT,RCBILLDA,RCCATEG,RCCATTXT,RCDATA0,RCDATA1,RCDATA3,RCLINE,TRANTYPE,X
11 I '$G(RCWIDTH) S RCWIDTH=50 ; Default max. width is 50 characters
12 K RCDESC
13 S RCLINE=1,RCDESC(1)=""
14 ;
15 S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
16 S RCDATA0=^PRCA(430,RCBILLDA,0)
17 S RCCATEG=+$P(RCDATA0,"^",2),RCCATTXT=$P($G(^PRCA(430.2,RCCATEG,0)),"^")
18 S RCDATA1=^PRCA(433,RCTRANDA,1)
19 S TRANTYPE=$P(RCDATA1,"^",2)
20 ;
21 ; build the first line description
22 ; if transaction type is an increase or decrease, set description
23 I TRANTYPE=1!(TRANTYPE=35) D
24 . ; if c means test, set description to category for c means test
25 . I RCCATEG=18 S DESCRIPT=$S($P(RCDATA0,"^",16):$P(^PRCA(430.2,$P(RCDATA0,"^",16),0),"^"),1:RCCATTXT) Q
26 . ; otherwise, set to category name
27 . S DESCRIPT=RCCATTXT
28 ;
29 ; if the bill category is a rx-copay and it is an increase adjustment
30 ; then set the description to copay
31 I RCCATEG=22!(RCCATEG=23),TRANTYPE=1 S DESCRIPT="COPAY"
32 ;
33 ; if the bill category is adult day health care, remove health
34 I RCCATEG=33 S DESCRIPT="ADULT DAY CARE"
35 ;
36 ; if the bill category is respite or geriatric eval,
37 ; take the 2nd piece removing institutional
38 I RCCATEG=35!(RCCATEG=36)!(RCCATEG=37)!(RCCATEG=38) S DESCRIPT=$P(RCCATTXT,"-")_$S(RCCATEG=35!(RCCATEG=37):" IN",1:" OUT")_"PATIENT"
39 ;
40 ; if it is a comment transaction
41 I TRANTYPE=45 S DESCRIPT="COMMENT: "_$P($G(^PRCA(433,RCTRANDA,5)),"^",2)
42 ;
43 ; prepayment bill (1=increase, 35=decrease, otherwise refund)
44 I RCCATEG=26 S DESCRIPT=$S(TRANTYPE=1:"OVERPAYMENT CREDIT",TRANTYPE=35:"OVERPAYMENT CREDIT DECREASE",1:"OVERPAYMENT REFUND")
45 ;
46 ; if the first line description not set (like payments), set it
47 ; to the type of transaction
48 I $G(DESCRIPT)="" S DESCRIPT=$P($G(^PRCA(430.3,+$P(RCDATA1,"^",2),0)),"^")
49 ;
50 ; if the transaction date is different from the process date,
51 ; show it with the description
52 I $P(RCDATA1,"^"),$P($P(RCDATA1,"^"),".")'=$P($P(RCDATA1,"^",9),".") S DESCRIPT=DESCRIPT_" ("_$$DATE($P($P(RCDATA1,"^"),"."))_")"
53 ;
54 ; set the first description line
55 D SETDESC(DESCRIPT)
56 ;
57 ; if it is a payment transaction, show amount paid interest, admin, other
58 I TRANTYPE=2!(TRANTYPE=34) D
59 . S RCDATA3=$G(^PRCA(433,RCTRANDA,3))
60 . ; if not interest, admin, or other, quit
61 . I '$P(RCDATA3,"^",2),'$P(RCDATA3,"^",3),'$P(RCDATA3,"^",4),'$P(RCDATA3,"^",5) Q
62 . ;
63 . S DESCRIPT=" (Int:"_$J(+$P(RCDATA3,"^",2),1,2)_" Adm:"_$J(+$P(RCDATA3,"^",3),1,2)
64 . ; calculate other
65 . S X=$P(RCDATA1,"^",5)-$P(RCDATA3,"^")-$P(RCDATA3,"^",2)-$P(RCDATA3,"^",3)
66 . S DESCRIPT=DESCRIPT_$S(X:" Other:"_$J(X,1,2)_")",1:")")
67 . D SETDESC(DESCRIPT)
68 ;
69 ; if it is a admin cost or interest charge, total the amounts
70 I TRANTYPE=13!(TRANTYPE=12) D Q
71 . S X=$G(^PRCA(433,RCTRANDA,2)) I X="" Q
72 . S RCTOTAL("INT")=$G(RCTOTAL("INT"))+$P(X,"^",7)
73 . S RCTOTAL("ADM")=$G(RCTOTAL("ADM"))+$P(X,"^",8)
74 . S RCTOTAL("OTH")=$G(RCTOTAL("OTH"))+($P(RCDATA1,"^",5)-$P(X,"^",7)-$P(X,"^",8))
75 ;
76 ; if not an increase adjustment, quit
77 I TRANTYPE'=1 Q
78 ;
79 ; increase to c means test, ltc or rx-copay, get data from ib
80 I RCCATEG=18!(RCCATEG=22)!(RCCATEG=23)!((RCCATEG>32)&(RCCATEG<40)) D
81 . S X="IBRFN1" X ^%ZOSF("TEST") I '$T Q
82 . K ^TMP("IBRFN1",$J)
83 . D STMT^IBRFN1(RCTRANDA)
84 . D IBDATA
85 Q
86 ;
87 ;
88 ; Returns RCDESC(1..n) array of Bill Description
89BILLDESC(RCBILLDA,RCWIDTH) ;
90 ; initialize
91 N DESCRIPT,RCCATEG,RCCATTXT,RCDATA0,RCLINE,X
92 I '$G(RCWIDTH) S RCWIDTH=50 ; Default max. width is 50 characters
93 K RCDESC
94 S RCLINE=1,RCDESC(1)=""
95 ;
96 S RCDATA0=^PRCA(430,RCBILLDA,0)
97 S RCCATEG=+$P(RCDATA0,"^",2),RCCATTXT=$P($G(^PRCA(430.2,RCCATEG,0)),"^")
98 ;
99 ; if category=c means test, set the description and quit
100 I RCCATEG=18 S DESCRIPT=$S($P(RCDATA0,"^",16):$P(^PRCA(430.2,$P(RCDATA0,"^",16),0),"^"),1:RCCATTXT) D SETDESC(DESCRIPT) Q
101 ;
102 ; set the category description
103 D SETDESC(RCCATTXT)
104 ;
105 ; if category not champva subsitence and not tricare patient, quit
106 I RCCATEG'=27,RCCATEG'=31 Q
107 ;
108 ; build description for champva subsistence and tricare patient bills
109 ; get data from ib
110 S X="IBRFN1" X ^%ZOSF("TEST") I '$T Q
111 K ^TMP("IBRFN1",$J)
112 D STMTB^IBRFN1($P(RCDATA0,"^"))
113 D IBDATA
114 Q
115 ;
116 ;
117IBDATA ; get data from IB for description
118 N IBDATA,IBJ
119 ;
120 ; show IB data
121 S IBJ=0 F S IBJ=$O(^TMP("IBRFN1",$J,IBJ)) Q:'IBJ S IBDATA=^TMP("IBRFN1",$J,IBJ) D
122 . ;
123 . ; if no drug or bill date returned from IB, then it is outpatient
124 . I $P(IBDATA,"^",3)="" D:$P(IBDATA,"^",2) SETDESC("VISIT DATE: "_$$DATE($P(IBDATA,"^",2))) Q
125 . ;
126 . ; if no drug quantity returned from ib, then it is inpatient
127 . I '$P(IBDATA,"^",6) D Q
128 . . I $P(IBDATA,"^",2) D SETDESC(" ADMISSION DATE: "_$$DATE($P(IBDATA,"^",2)))
129 . . I $P(IBDATA,"^",3) D SETDESC(" BEGINNING DATE OF BILLING CYCLE: "_$$DATE($P(IBDATA,"^",3)))
130 . . I $P(IBDATA,"^",4) D SETDESC(" ENDING DATE OF BILLING CYCLE: "_$$DATE($P(IBDATA,"^",4)))
131 . . I $P(IBDATA,"^",5) D SETDESC(" DISCHARGE DATE: "_$$DATE($P(IBDATA,"^",5)))
132 . ;
133 . ; pharmacy
134 . D:$P(IBDATA,"^",2) SETDESC("RX:"_$P(IBDATA,"^",2))
135 . D:$P(IBDATA,"^",7) SETDESC("FD:"_$$DATE($P(IBDATA,"^",7)))
136 . ;
137 . ; if not patient statement detail, quit
138 . I $$DET^RCFN01($P(RCDATA0,"^",9))'=2 Q
139 . ;
140 . ; return pharmacy detail
141 . I $P(IBDATA,"^",3)'="" D SETDESC(" DRUG:"_$TR($P(IBDATA,"^",3),"|~"))
142 . I $P(IBDATA,"^",4) D SETDESC(" DAYS:"_$P(IBDATA,"^",4))
143 . I $P(IBDATA,"^",6) D SETDESC(" QTY:"_$P(IBDATA,"^",6))
144 . I $P(IBDATA,"^",5)'="" D SETDESC(" PHY:"_$P(IBDATA,"^",5))
145 . I $P(IBDATA,"^",8) D SETDESC(" CHG:$"_$J($P(IBDATA,"^",8),0,2))
146 ;
147 K ^TMP("IBRFN1",$J)
148 Q
149 ;
150 ;
151 ; Add line to the description, not longer than RCWIDTH
152 ; Input: RCLINE,RCWIDTH
153 ; Output: RCDESC
154SETDESC(DESCRIPT) N LENGTH
155 ; calculate the length of the description
156 S LENGTH=$L(RCDESC(RCLINE))+$L(DESCRIPT)
157 I RCDESC(RCLINE)'="" S LENGTH=LENGTH+1
158 ;
159 ; the description line cannot go over RCWIDTH characters
160 I LENGTH<RCWIDTH S RCDESC(RCLINE)=RCDESC(RCLINE)_$S(RCDESC(RCLINE)="":"",1:" ")_DESCRIPT Q
161 ;
162 ; Description line to add is over RCWIDTH
163 ; The given string will be splitted _only_ if the limit is more than 44 characters.
164 I $L(DESCRIPT)>RCWIDTH D Q
165 . I RCDESC(RCLINE)'="" S RCLINE=RCLINE+1
166 . S RCDESC(RCLINE)=$E(DESCRIPT,1,RCWIDTH)
167 . S RCLINE=RCLINE+1
168 . S RCDESC(RCLINE)=$E(DESCRIPT,RCWIDTH+1,2*RCWIDTH)
169 ;
170 ; over RCWIDTH characters, start new line
171 I RCDESC(RCLINE)'="" S RCLINE=RCLINE+1
172 S RCDESC(RCLINE)=DESCRIPT
173 Q
174 ;
175DATE(FMDT) ; format date mm/dd/yyyy
176 I 'FMDT Q ""
177 Q $E(FMDT,4,5)_"/"_$E(FMDT,6,7)_"/"_(1700+$E(FMDT,1,3))
Note: See TracBrowser for help on using the repository browser.