| 1 | IBCNEDE6 ;DAOU/DAC - IIV DATA EXTRACTS ;15-OCT-2002
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184,271,345**;21-MAR-94;Build 28
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q ; no direct calls allowed
|
|---|
| 6 | ;
|
|---|
| 7 | INAC(IBCNCNT,MAXNUM,IBDDI,SRVICEDT,FDAYS,APPTFLG) ;Get Inactive Insurances
|
|---|
| 8 | ; DAOU/BHS - 10/15/2002 - Replaced VRFDT w/ FDAYS (fresh days value)
|
|---|
| 9 | ; APPTFLG - Appt extract flag ONLY set from IBCNEDE2 - optional 0/1
|
|---|
| 10 | ;
|
|---|
| 11 | NEW IDATA,INCP,IEN,TQIEN,INS,INACT,DATA1,DATA2,FRESHDT
|
|---|
| 12 | NEW PAYER,PAYERID,RESULT,FOUND,SIDARRAY,SIDACT,SIDCNT,SID,INREC
|
|---|
| 13 | ;
|
|---|
| 14 | ; Need FOUND to avoid the creation of a no payer inquiry the day after
|
|---|
| 15 | ; the original inquiry for pre-reg (appt) extract and no insurance
|
|---|
| 16 | ; extract was created.
|
|---|
| 17 | S FOUND=0 ; set flag to 1 if potential inquiry was found
|
|---|
| 18 | ;
|
|---|
| 19 | S APPTFLG=$G(APPTFLG)
|
|---|
| 20 | S IDATA=$G(^IBE(350.9,1,51))
|
|---|
| 21 | S INACT=$P(IDATA,U,8)
|
|---|
| 22 | S FRESHDT=$$FMADD^XLFDT(SRVICEDT,-FDAYS)
|
|---|
| 23 | ;
|
|---|
| 24 | ; If the search for inactive insurances is 'No', quit
|
|---|
| 25 | I 'INACT G INACX
|
|---|
| 26 | ;
|
|---|
| 27 | S INCP="" F S INCP=$O(IBDDI(INCP)) Q:INCP="" D Q:IBCNCNT'<MAXNUM
|
|---|
| 28 | . S IEN="" F S IEN=$O(^DPT(DFN,.312,"B",INCP,IEN)) Q:IEN="" D
|
|---|
| 29 | .. S INS=$P(^DPT(DFN,.312,IEN,0),U)
|
|---|
| 30 | .. ;
|
|---|
| 31 | .. ;Check for Medicare/Medicaid
|
|---|
| 32 | .. I $$EXCLUDE^IBCNEUT4($P($G(^DIC(36,INS,0)),U)) Q
|
|---|
| 33 | .. ;
|
|---|
| 34 | .. ; Check for insurance company payer, etc.
|
|---|
| 35 | .. S RESULT=$$INSERROR^IBCNEUT3("I",INS)
|
|---|
| 36 | .. I $P(RESULT,U)'="" Q
|
|---|
| 37 | .. ;
|
|---|
| 38 | .. S PAYER=$P(RESULT,U,2),PAYERID=$P(RESULT,U,3)
|
|---|
| 39 | .. I ('PAYER)!(PAYERID="") Q
|
|---|
| 40 | .. ;
|
|---|
| 41 | .. S FOUND=1 ; potential inquiry
|
|---|
| 42 | .. ;
|
|---|
| 43 | .. ; Update service date based on payer's allowed range
|
|---|
| 44 | .. D UPDDTS(PAYER,.SRVICEDT,.FRESHDT)
|
|---|
| 45 | .. ; update service dates for inquiries to be transmitted
|
|---|
| 46 | .. D TQUPDSV^IBCNEUT5(DFN,PAYER,SRVICEDT)
|
|---|
| 47 | .. ; check for outstanding/current entries in File 356.1
|
|---|
| 48 | .. I '$$ADDTQ^IBCNEUT5(DFN,PAYER,SRVICEDT,FDAYS) Q
|
|---|
| 49 | .. ;
|
|---|
| 50 | .. ; Call function to set IIV TRANSMISSION QUEUE file #365.1
|
|---|
| 51 | .. ;
|
|---|
| 52 | .. K SIDARRAY
|
|---|
| 53 | .. S SIDACT=$$SIDCHK2^IBCNEDE5(DFN,PAYER,.SIDARRAY,FRESHDT)
|
|---|
| 54 | .. S SIDCNT=$P(SIDACT,U,2),SIDACT=$P(SIDACT,U)
|
|---|
| 55 | .. ; Add to SIDCNT to compensate for a TQ entry w/ blank Sub ID
|
|---|
| 56 | .. I SIDACT=5!(SIDACT=6)!(SIDACT=7)!(SIDACT=8) S SIDCNT=SIDCNT+1
|
|---|
| 57 | .. I IBCNCNT+SIDCNT>MAXNUM S IBCNCNT=MAXNUM Q ; see if TQ entries will exceed MAXNUM
|
|---|
| 58 | .. S SID="" F S SID=$O(SIDARRAY(SID)) Q:SID="" D
|
|---|
| 59 | ... S INREC=$P(SID,"_",2) ; which patient ins rec ID is from
|
|---|
| 60 | ... D INACSET($P(SID,"_"),INREC)
|
|---|
| 61 | ... ;
|
|---|
| 62 | .. ; Create TQ entry w/ blank Sub ID
|
|---|
| 63 | .. I (SIDACT=5)!(SIDACT=6)!(SIDACT=7)!(SIDACT=8) S SID="" D INACSET("","")
|
|---|
| 64 | K SIDARRAY
|
|---|
| 65 | INACX ;
|
|---|
| 66 | Q FOUND
|
|---|
| 67 | ;
|
|---|
| 68 | INACSET(SID,INREC) ; INAC. SET
|
|---|
| 69 | ; The hard coded '1' in the 3rd piece of DATA1 sets the Transmission
|
|---|
| 70 | ; status of file 365.1 to "Ready to Transmit"
|
|---|
| 71 | N FRESH
|
|---|
| 72 | S FRESH=$$FMADD^XLFDT(SRVICEDT,-FDAYS)
|
|---|
| 73 | S DATA1=DFN_U_PAYER_U_1_U_""_U_SID_U_FRESH
|
|---|
| 74 | ;
|
|---|
| 75 | ; The hardcoded 1st piece of DATA2 tells file 365.1 which extract
|
|---|
| 76 | ; it is.
|
|---|
| 77 | I APPTFLG S DATA2=2 ; appt extract IBCNEDE2
|
|---|
| 78 | I 'APPTFLG S DATA2=4 ; no ins extract IBCNEDE4
|
|---|
| 79 | S DATA2=DATA2_U_"I"_U_SRVICEDT_U_$G(INREC)
|
|---|
| 80 | ;
|
|---|
| 81 | S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2)
|
|---|
| 82 | I TQIEN'="" S IBCNCNT=IBCNCNT+1
|
|---|
| 83 | ;
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | UPDDTS(PIEN,SVDT,FRDT) ; Update service date and freshness date per payer
|
|---|
| 87 | ; date parameters FUTURE SERVICE DAYS (365.121,.14) and PAST SERVICE
|
|---|
| 88 | ; DAYS (365.121,.15)
|
|---|
| 89 | ; Output:
|
|---|
| 90 | ; SVDT - passed by reference - updates service date
|
|---|
| 91 | ; FRDT - passed by reference - updates freshness date - except for
|
|---|
| 92 | ; INAC where it is optional
|
|---|
| 93 | N FDAYS,PDAYS,DIFF,AIEN,DATA,OSVDT,EDTFLG
|
|---|
| 94 | ;
|
|---|
| 95 | ; Init vars - save original service date to calc diff
|
|---|
| 96 | S (FDAYS,PDAYS,EDTFLG)=0,OSVDT=SVDT
|
|---|
| 97 | ; Determine Payer App IEN
|
|---|
| 98 | S AIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
|
|---|
| 99 | I AIEN="" Q ; Quit without changing if app is not defined
|
|---|
| 100 | S DATA=$G(^IBE(365.12,PIEN,1,AIEN,0))
|
|---|
| 101 | I DATA="" Q ; Quit without changing if node is not defined
|
|---|
| 102 | S FDAYS=$P(DATA,U,14),PDAYS=$P(DATA,U,15)
|
|---|
| 103 | ; DAOU/WCW - Overriding this to allow service date of only today
|
|---|
| 104 | ; for the time being - setting params to 0
|
|---|
| 105 | S FDAYS=0,PDAYS=0
|
|---|
| 106 | ; Process past service days if not null
|
|---|
| 107 | I PDAYS'="" D
|
|---|
| 108 | . ; If zero, reset to today
|
|---|
| 109 | . I PDAYS=0 S SVDT=$$DT^XLFDT,EDTFLG=1
|
|---|
| 110 | . ; If non-zero and service date is earlier than the allowed
|
|---|
| 111 | . ; payer service date range, reset service date to earliest allowed
|
|---|
| 112 | . ; date for the payer
|
|---|
| 113 | . I PDAYS,SVDT<$$FMADD^XLFDT($$DT^XLFDT,-PDAYS+1) D
|
|---|
| 114 | . . S SVDT=$$FMADD^XLFDT($$DT^XLFDT,-PDAYS+1),EDTFLG=1
|
|---|
| 115 | ; Process future service days if not edited and if not null
|
|---|
| 116 | I EDTFLG=0,FDAYS'="" D
|
|---|
| 117 | . ; If zero, reset to today
|
|---|
| 118 | . I FDAYS=0 S SVDT=$$DT^XLFDT,EDTFLG=1
|
|---|
| 119 | . ; If non-zero and service date is later than the allowed
|
|---|
| 120 | . ; payer service date range, reset service date to latest allowed
|
|---|
| 121 | . ; date for the payer
|
|---|
| 122 | . I FDAYS,SVDT>$$FMADD^XLFDT($$DT^XLFDT,FDAYS-1) D
|
|---|
| 123 | . . S SVDT=$$FMADD^XLFDT($$DT^XLFDT,FDAYS-1),EDTFLG=1
|
|---|
| 124 | ;
|
|---|
| 125 | ; Determine if difference exists
|
|---|
| 126 | I EDTFLG,$G(FRDT)'="" S FRDT=$$FMADD^XLFDT(FRDT,$$FMDIFF^XLFDT(SVDT,OSVDT))
|
|---|
| 127 | ;
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | BLANKTQ(SRVICEDT,FRESHDT,YDAYS,IBCNCNT) ;
|
|---|
| 131 | ; This tag is only called from PROCESS^IBCNEDE4
|
|---|
| 132 | ; No new records were created in file 365.1 for this DFN.
|
|---|
| 133 | ; Need to check if an inquiry for any payer exists for this DFN within
|
|---|
| 134 | ; the freshness period. If it doesn't exist create a new blank inquiry
|
|---|
| 135 | ;
|
|---|
| 136 | ; Input
|
|---|
| 137 | ; SRVICEDT - Service Date
|
|---|
| 138 | ; FRESHDT - Freshness Date
|
|---|
| 139 | ; YDAYS -
|
|---|
| 140 | ; IBCNCNT - updated - Counter for the extract
|
|---|
| 141 | ;
|
|---|
| 142 | I $$TFL^IBCNEDE6(DFN)=0 Q
|
|---|
| 143 | ;
|
|---|
| 144 | N PAYER,DATA1,DATA2,TQIEN
|
|---|
| 145 | ;
|
|---|
| 146 | S PAYER=$$FIND1^DIC(365.12,,"X","~NO PAYER")
|
|---|
| 147 | ;
|
|---|
| 148 | ; Update service date and freshness date based on payer allowed
|
|---|
| 149 | ; date range
|
|---|
| 150 | D UPDDTS^IBCNEDE6(PAYER,.SRVICEDT,.FRESHDT)
|
|---|
| 151 | ;
|
|---|
| 152 | ; Update service dates for inquiries to be transmitted
|
|---|
| 153 | D TQUPDSV^IBCNEUT5(DFN,PAYER,SRVICEDT)
|
|---|
| 154 | ;
|
|---|
| 155 | ; Are we allowed to add it to the TQ file
|
|---|
| 156 | I '$$ADDTQ^IBCNEUT5(DFN,PAYER,SRVICEDT,YDAYS,1) G BLANKXT
|
|---|
| 157 | ;
|
|---|
| 158 | ; The hard coded '1' in the 3rd piece of DATA1 sets the Transmission
|
|---|
| 159 | ; status of file 365.1 to "Ready to Transmit"
|
|---|
| 160 | S DATA1=DFN_U_PAYER_U_1_U_""_U_""_U_FRESHDT
|
|---|
| 161 | ;
|
|---|
| 162 | ; The hardcoded '4' in the 1st piece of DATA2 is the value to tell
|
|---|
| 163 | ; the file 365.1 that it is the no active insurance extract.
|
|---|
| 164 | S DATA2=4_U_"I"_U_SRVICEDT
|
|---|
| 165 | ;
|
|---|
| 166 | S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2),PAYER=""
|
|---|
| 167 | I TQIEN'="" S IBCNCNT=IBCNCNT+1
|
|---|
| 168 | ;
|
|---|
| 169 | BLANKXT ;
|
|---|
| 170 | Q
|
|---|
| 171 | ;
|
|---|
| 172 | TFL(DFN) ; Examines treating facility list,
|
|---|
| 173 | ; value returned is 1 if patient has visited at least one other site
|
|---|
| 174 | N IBC,IBZ,IBS
|
|---|
| 175 | D TFL^VAFCTFU1(.IBZ,DFN) Q:-$G(IBZ(1))=1 0
|
|---|
| 176 | S IBS=+$P($$SITE^VASITE,"^",3),(IBZ,IBC)=0
|
|---|
| 177 | ; Look for remote facilities of type VAMC:
|
|---|
| 178 | F S IBZ=$O(IBZ(IBZ)) Q:IBZ<1 I +IBZ(IBZ)>0,+IBZ(IBZ)'=IBS,$P(IBZ(IBZ),U,5)="VAMC" S IBC=1 Q
|
|---|
| 179 | Q IBC
|
|---|
