| 1 | RCCPCPS1 ;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 | ;
|
|---|
| 7 | TRANDESC(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
|
|---|
| 89 | BILLDESC(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 | ;
|
|---|
| 117 | IBDATA ; 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
|
|---|
| 154 | SETDESC(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 | ;
|
|---|
| 175 | DATE(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))
|
|---|
