| 1 | BPSSCRU5 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
|
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;USER SCREEN
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | DATETIME(Y) ;EP - convert fileman date.time to printable
|
|---|
| 8 | X ^DD("DD")
|
|---|
| 9 | Q Y
|
|---|
| 10 | ;
|
|---|
| 11 | ;create a history of claims and responses in #9002313.57 file
|
|---|
| 12 | ;record for the specified transaction in #9002313.59 file
|
|---|
| 13 | ;input:
|
|---|
| 14 | ; BP59 - ptr to #9002313.59
|
|---|
| 15 | ; BPHIST - array to return results
|
|---|
| 16 | ;output:
|
|---|
| 17 | ; Array in BPHIST with the format:
|
|---|
| 18 | ; BPHIST(type,timedate,PointerToResponseClaimFile)=PointerTo#9002313.57
|
|---|
| 19 | ; where:
|
|---|
| 20 | ; type "C" - BPS CLAIM file, "R" - BPS RESPONSE file
|
|---|
| 21 | ; PointerToResponseClaimFile - pointer to 9002313.03 or 9002313.02
|
|---|
| 22 | MKHIST(BP59,BPHIST) ;
|
|---|
| 23 | N BP57,BPLSTCLM,BPLSTRSP,BPDAT57,BP1,BPSSTDT
|
|---|
| 24 | S BP57=0
|
|---|
| 25 | N BPSARR02
|
|---|
| 26 | N BPSARR03
|
|---|
| 27 | ; -- process BPS LOG OF TRANSACTIONS file
|
|---|
| 28 | F S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D
|
|---|
| 29 | . ;claim transmissions
|
|---|
| 30 | . S BPDAT57(0)=$G(^BPSTL(BP57,0))
|
|---|
| 31 | . S BPSSTDT=+$P(BPDAT57(0),U,11) ;start time
|
|---|
| 32 | . S BPLSTCLM=+$P(BPDAT57(0),U,4) ;claim
|
|---|
| 33 | . I BPLSTCLM>0 D
|
|---|
| 34 | . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on
|
|---|
| 35 | . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on
|
|---|
| 36 | . . ;old BPS CLAIMS recs don't have dates, so use START TIME from .57 file but
|
|---|
| 37 | . . ;only at the very first time (using $D for this)
|
|---|
| 38 | . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
|
|---|
| 39 | . . I BP1 S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"C"
|
|---|
| 40 | . S BPLSTRSP=+$P(BPDAT57(0),U,5) ;response
|
|---|
| 41 | . I BPLSTRSP>0 D
|
|---|
| 42 | . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on
|
|---|
| 43 | . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
|
|---|
| 44 | . . I BP1 S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"C"
|
|---|
| 45 | . ;reversal transmissions
|
|---|
| 46 | . S BPDAT57(4)=$G(^BPSTL(BP57,4))
|
|---|
| 47 | . S BPLSTCLM=+$P(BPDAT57(4),U,1) ;reversal
|
|---|
| 48 | . I BPLSTCLM>0 D
|
|---|
| 49 | . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on
|
|---|
| 50 | . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on
|
|---|
| 51 | . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
|
|---|
| 52 | . . I BP1 S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"R"
|
|---|
| 53 | . S BPLSTRSP=+$P(BPDAT57(4),U,2) ;reversal response
|
|---|
| 54 | . I BPLSTRSP>0 D
|
|---|
| 55 | . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on
|
|---|
| 56 | . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
|
|---|
| 57 | . . I BP1 S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"R"
|
|---|
| 58 | ;--------
|
|---|
| 59 | ;sorting: pairs (send/respond) in reversed chronological order
|
|---|
| 60 | N BPCLDT1,BPCLIEN,BPRSDT1,BPRSIEN,BPCLDT2
|
|---|
| 61 | S BPCLDT1=0
|
|---|
| 62 | F S BPCLDT1=$O(BPHIST("C",BPCLDT1)) Q:BPCLDT1="" D
|
|---|
| 63 | . S BPCLIEN=$O(BPHIST("C",BPCLDT1,0)) Q:BPCLIEN="" D
|
|---|
| 64 | . . S BPCLDT2=+$O(BPHIST("C",BPCLDT1))
|
|---|
| 65 | . . I BPCLDT2=0 S BPCLDT2=9999999
|
|---|
| 66 | . . S BPRSDT1=BPCLDT1
|
|---|
| 67 | . . F S BPRSDT1=$O(BPHIST("R",BPRSDT1)) Q:BPRSDT1=""!(BPRSDT1>BPCLDT2) D
|
|---|
| 68 | . . . S BPRSIEN=$O(BPHIST("R",BPRSDT1,0)) Q:BPRSIEN="" D
|
|---|
| 69 | . . . . S BPHIST("C",BPCLDT1,BPCLIEN,"R",BPRSIEN)=BPHIST("R",BPRSDT1,BPRSIEN)
|
|---|
| 70 | ;
|
|---|
| 71 | Q
|
|---|
| 72 | ;returns text for the transaction code in file #9002313.02 -- BPS CLAIMS FILE
|
|---|
| 73 | TRTYPE(BPTRCD) ;
|
|---|
| 74 | I BPTRCD="E1" Q "Eligibility Verification"
|
|---|
| 75 | I BPTRCD="B1" Q "REQUEST" ;"Billing"
|
|---|
| 76 | I BPTRCD="B2" Q "REVERSAL" ; "Reversal"
|
|---|
| 77 | I BPTRCD="B3" Q "Rebill"
|
|---|
| 78 | I BPTRCD="P1" Q "P.A. Request & Billing"
|
|---|
| 79 | I BPTRCD="P2" Q "P.A. Reversal"
|
|---|
| 80 | I BPTRCD="P3" Q "P.A. Inquiry"
|
|---|
| 81 | I BPTRCD="P4" Q "P.A. Request Only"
|
|---|
| 82 | I BPTRCD="N1" Q "Information Reporting"
|
|---|
| 83 | I BPTRCD="N2" Q "Information Reporting Reversal"
|
|---|
| 84 | I BPTRCD="N3" Q "Information Reporting Rebill"
|
|---|
| 85 | I BPTRCD="C1" Q "Controlled Substance Reporting"
|
|---|
| 86 | I BPTRCD="C2" Q "Controlled Substance Reporting Reversal"
|
|---|
| 87 | I BPTRCD="C3" Q "Controlled Substance Reporting Rebill"
|
|---|
| 88 | Q ""
|
|---|
| 89 | ;
|
|---|
| 90 | ;get NDC for LOG
|
|---|
| 91 | ;BPIEN02 - IEN in #9002313.02 file
|
|---|
| 92 | LNDC(BPIEN02) ;
|
|---|
| 93 | N BPDAT02,BPNDC
|
|---|
| 94 | S BPDAT02(400)=$G(^BPSC(BPIEN02,400,1,400))
|
|---|
| 95 | S BPNDC=$E($P(BPDAT02(400),U,7),3,99)
|
|---|
| 96 | S BPNDC=$E(BPNDC,1,5)_"-"_$E(BPNDC,6,9)_"-"_$E(BPNDC,10,11)
|
|---|
| 97 | Q BPNDC
|
|---|
| 98 | ;prepares array of reject codes
|
|---|
| 99 | ; BPIEN03 - IEN in #9002313.03 file
|
|---|
| 100 | ; BPRCODES - array to return results
|
|---|
| 101 | REJCODES(BPIEN03,BPRCODES) ;
|
|---|
| 102 | N BPA,BPR
|
|---|
| 103 | S BPA=0
|
|---|
| 104 | F S BPA=$O(^BPSR(BPIEN03,1000,1,511,BPA)) Q:'BPA D
|
|---|
| 105 | . S BPR=$P(^BPSR(BPIEN03,1000,1,511,BPA,0),U)
|
|---|
| 106 | . I BPR'="" S BPRCODES(BPR)=""
|
|---|
| 107 | Q
|
|---|
| 108 | ;status of the response
|
|---|
| 109 | RESPSTAT(BPIEN03) ;
|
|---|
| 110 | N BP1
|
|---|
| 111 | S BP1=$P($G(^BPSR(BPIEN03,1000,1,110)),U,2)
|
|---|
| 112 | Q:BP1="A" "Approved"
|
|---|
| 113 | Q:BP1="C" "Captured"
|
|---|
| 114 | Q:BP1="D" "Duplicate of Paid"
|
|---|
| 115 | Q:BP1="F" "PA Deferred"
|
|---|
| 116 | Q:BP1="P" "Paid"
|
|---|
| 117 | Q:BP1="Q" "Duplicate of Capture"
|
|---|
| 118 | Q:BP1="R" "Rejected"
|
|---|
| 119 | Q:BP1="S" "Duplicate of Approved"
|
|---|
| 120 | Q ""
|
|---|
| 121 | ;
|
|---|
| 122 | ;Electronic payer - ptr to #9002313.92
|
|---|
| 123 | ;BPIEN02 - ptr in #9002313.02
|
|---|
| 124 | PYRIEN(BPIEN02) ;
|
|---|
| 125 | Q $P($G(^BPSF(9002313.92,+$P($G(^BPSC(BPIEN02,0)),U,2),0)),U)
|
|---|
| 126 | ;
|
|---|
| 127 | ;BPIEN02 - ptr in #9002313.02
|
|---|
| 128 | B2PYRIEN(BPIEN02,BP57) ;
|
|---|
| 129 | N BPX,BPX2
|
|---|
| 130 | S BPX=$G(^BPSF(9002313.92,+$$PYRIEN(BPIEN02),"REVERSAL"))
|
|---|
| 131 | I $L(BPX)=0 D
|
|---|
| 132 | . S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,3)
|
|---|
| 133 | . S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U)
|
|---|
| 134 | Q BPX
|
|---|
| 135 | ;
|
|---|
| 136 | ;B3 payer sheet
|
|---|
| 137 | B3PYRIEN(BPIEN02,BP59,BP57) ;
|
|---|
| 138 | N BPX,BPX2
|
|---|
| 139 | S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,4)
|
|---|
| 140 | S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U)
|
|---|
| 141 | Q BPX
|
|---|
| 142 | ;
|
|---|
| 143 | ;
|
|---|
| 144 | ;BPLN= line to use in SETLINE
|
|---|
| 145 | ;BPX - long string to display
|
|---|
| 146 | ;BPMLEN - max length
|
|---|
| 147 | ;BPPREFX - prefix string
|
|---|
| 148 | ;BPMARG - left margin
|
|---|
| 149 | WRAPLN(BPLN,BPX,BPMLEN,BPPREFX,BPMARG) ;
|
|---|
| 150 | N BPQ,BPLEN,BPXX
|
|---|
| 151 | S BPQ=0
|
|---|
| 152 | S BPLEN=BPMLEN-$L(BPPREFX)
|
|---|
| 153 | S BPXX=$E(BPX,1,BPLEN)
|
|---|
| 154 | D SETLINE^BPSSCRLG(.BPLN,BPPREFX_BPXX)
|
|---|
| 155 | S BPX=$E(BPX,BPLEN+1,9999)
|
|---|
| 156 | I $L(BPX)<1 Q
|
|---|
| 157 | S BPLEN=BPMLEN-BPMARG
|
|---|
| 158 | F D Q:BPQ=1
|
|---|
| 159 | . S BPXX=$E(BPX,1,BPLEN)
|
|---|
| 160 | . D SETLINE^BPSSCRLG(.BPLN,$$SPACES(BPMARG)_BPXX)
|
|---|
| 161 | . S BPX=$E(BPX,BPLEN+1,9999)
|
|---|
| 162 | . I $L(BPX)<1 S BPQ=1
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | ;to prepare spaces
|
|---|
| 166 | SPACES(BPN) ;
|
|---|
| 167 | N BPX
|
|---|
| 168 | S $P(BPX," ",BPN+1)=""
|
|---|
| 169 | Q BPX
|
|---|
| 170 | ;
|
|---|
| 171 | ;BPN= line counter (index)
|
|---|
| 172 | ;BPARR - array for lines
|
|---|
| 173 | ;BPX - long string to display
|
|---|
| 174 | ;BPMLEN - mas length
|
|---|
| 175 | ;BPPREFX - prefix string
|
|---|
| 176 | ;BPMARG - left margin
|
|---|
| 177 | WRAPLN2(BPN,BPARR,BPX,BPMLEN,BPPREFX,BPMARG) ;
|
|---|
| 178 | N BPQ,BPLEN,BPXX
|
|---|
| 179 | S BPQ=0
|
|---|
| 180 | S BPLEN=BPMLEN-$L(BPPREFX)
|
|---|
| 181 | S BPXX=$E(BPX,1,BPLEN)
|
|---|
| 182 | D SETLN(.BPN,.BPARR,BPPREFX_BPXX)
|
|---|
| 183 | S BPX=$E(BPX,BPLEN+1,9999)
|
|---|
| 184 | I $L(BPX)<1 Q
|
|---|
| 185 | S BPLEN=BPMLEN-BPMARG
|
|---|
| 186 | F D Q:BPQ=1
|
|---|
| 187 | . S BPXX=$E(BPX,1,BPLEN)
|
|---|
| 188 | . D SETLN(.BPN,.BPARR,$$SPACES(BPMARG)_BPXX)
|
|---|
| 189 | . S BPX=$E(BPX,BPLEN+1,9999)
|
|---|
| 190 | . I $L(BPX)<1 S BPQ=1
|
|---|
| 191 | Q
|
|---|
| 192 | ;
|
|---|
| 193 | ;
|
|---|
| 194 | SETLN(BPN,BPARR,BPTXT) ;
|
|---|
| 195 | S BPN=BPN+1,BPARR(BPN)=BPTXT
|
|---|
| 196 | Q
|
|---|
| 197 | ;---
|
|---|
| 198 | ;check 2nd insurance
|
|---|
| 199 | ;if there then ask user and print message
|
|---|
| 200 | CH2NDINS(BP59,BPPATNAM,BPINSNAM,BPRXINFO) ;
|
|---|
| 201 | N BPRETV
|
|---|
| 202 | S BPRETV=$$NEXTINS^BPSSCRCL(BP59,BPINSNAM)
|
|---|
| 203 | Q:+BPRETV=0
|
|---|
| 204 | D PRN(BPPATNAM,BPRETV,.BPRXINFO,"S")
|
|---|
| 205 | W !!
|
|---|
| 206 | I $$YESNO^BPSSCRRS("Do you want to print the information (above) concerning additional insurance? (Y/N)")'=1 Q
|
|---|
| 207 | D PRN(BPPATNAM,BPRETV,.BPRXINFO,"P")
|
|---|
| 208 | Q
|
|---|
| 209 | ;
|
|---|
| 210 | ;BPPRNFL
|
|---|
| 211 | ; S- print to screen
|
|---|
| 212 | PRN(BPPATNAM,BPRETV,BPRXINFO,BPPRNFL) ;
|
|---|
| 213 | I BPPRNFL="S" W @IOF D MS2NDINS Q
|
|---|
| 214 | D PRINT("MS2NDINS^BPSSCRU5","BPS 2ND INSURANCE INFO","BP*")
|
|---|
| 215 | W !!
|
|---|
| 216 | Q
|
|---|
| 217 | ;
|
|---|
| 218 | MS2NDINS ;
|
|---|
| 219 | N Y,Z
|
|---|
| 220 | W !,"This patient HAS additional insurance with Rx Coverage that may be"
|
|---|
| 221 | W !,"used to bill this claim. The system WILL change the CT entry to a"
|
|---|
| 222 | W !,"NON-BILLABLE Episode. If appropriate, please go to Claims Tracking"
|
|---|
| 223 | W !,"to manually create a bill to the additional payer listed below."
|
|---|
| 224 | W !!,"Patient: ",?18,BPPATNAM
|
|---|
| 225 | S Y=$P(BPRETV,U,4)\1 D DD^%DT
|
|---|
| 226 | W !,"Date of service: ",?18,Y
|
|---|
| 227 | W !,"Insurance: ",?18,$P(BPRETV,U,2)
|
|---|
| 228 | W !,"Group number: ",?18,$P(BPRETV,U,3)
|
|---|
| 229 | S Z=0 F S Z=$O(BPRXINFO(Z)) Q:+Z=0 W !,BPRXINFO(Z)
|
|---|
| 230 | Q
|
|---|
| 231 | ;
|
|---|
| 232 | ;Prints report
|
|---|
| 233 | ;propmpts user to choose device (including queuing)
|
|---|
| 234 | ;TXTSRC - name of the report's entry point
|
|---|
| 235 | ;DESCR - description for the Task Manager
|
|---|
| 236 | ;SAVEVARS - mask for vars that need to be available in the report
|
|---|
| 237 | ; (exmpl: "BP*")
|
|---|
| 238 | PRINT(TXTSRC,DESCR,SAVEVARS) ;
|
|---|
| 239 | N Y,QUITVAR,SCRFLAG
|
|---|
| 240 | S (QUITVAR,SCRFLAG)=0
|
|---|
| 241 | D DEVICE Q:QUITVAR
|
|---|
| 242 | D @TXTSRC
|
|---|
| 243 | D ^%ZISC
|
|---|
| 244 | I QUITVAR W !,"Cancelled"
|
|---|
| 245 | Q
|
|---|
| 246 | ;
|
|---|
| 247 | DEVICE ;
|
|---|
| 248 | N DIR,DIRUT,POP
|
|---|
| 249 | N ZTRTN,ZTIO,ZTSAVE,ZTDESC,%ZIS
|
|---|
| 250 | K IO("Q") S %ZIS="QM"
|
|---|
| 251 | W ! D ^%ZIS
|
|---|
| 252 | I POP S QUITVAR=1 Q
|
|---|
| 253 | S SCRFLAG=$S($E($G(IOST),1,2)="C-":1,1:0)
|
|---|
| 254 | I $D(IO("Q")) D S QUITVAR=1
|
|---|
| 255 | . S ZTRTN=TXTSRC
|
|---|
| 256 | . S ZTIO=ION
|
|---|
| 257 | . S ZTSAVE(SAVEVARS)=""
|
|---|
| 258 | . S ZTDESC=DESCR
|
|---|
| 259 | . D ^%ZTLOAD
|
|---|
| 260 | . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
|
|---|
| 261 | . D HOME^%ZIS
|
|---|
| 262 | U IO
|
|---|
| 263 | Q
|
|---|
| 264 | ;
|
|---|
