IBCNEDE5 ;DAOU/DAC - eIV DATA EXTRACTS ;15-OCT-2002
;;2.0;INTEGRATED BILLING;**184,271,416,497,549,621,668**;21-MAR-94;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
Q ; no direct calls allowed
; IB*2.0*621 - Removed tag "SIDCHK2"
;
SIDCHK(PIEN,DFN,BSID,SIDARRAY,FRESHDT) ; Checks the flag setting of
; '270 REQUIRES SUB ID' (#365.121,4.02). The function returns a "^"
; delimited string. The first value is between 1 and 5 telling the
; calling program what action(s) it should perform. The 2nd piece
; indicates the Subcriber ID that the calling program should use for
; setting the Subscriber IDs in the eIV Transmission Queue file (#365.1).
; The calling program is to address the blank Sub IDs.
;
; PIEN - Payer's IEN (file 365.12)
; DFN - Patient's IEN (file 2)
; INREC - Insurance IEN of Patients record (subfile 2.312)
; BSID - Subscriber ID from buffer file (file 355.33 field 60.04)
; SIDARRAY - Array of active subscribers
; FRESHDT - Freshness Date - used for checking verified date
;
; Logic to follow:
;
; Id. Req.| Sub ID|Action|
; Sub ID | found | # | Create
; ________|_______|______|________
; YES YES 1 1 Verification TQ entry w/ Sub ID
; YES NO 3 new buffer entry or modify existing saying manual verification required
; NO NO 4 1 Ver. TQ entry w/ blank Sub ID
;
; * Note: The insurance record found with the proper PIEN will only be
; picked up if the insurance policy is active, and if the insurance
; policy hasn't been verified within the Freshness period.
;
N SIDACT,SID,APPIEN,SIDREQ ;dw/IB*668 removed SIDSTR
N INSSTR,INSSTR1,INSSTR7,SYMBOL,EXP,SUBID,SUBIDS,SIDCNT,INREC,MVER,VFLG,MCRTQ
;
S FRESHDT=$G(FRESHDT),VFLG=0
;
; if the subscriber ID from the buffer extract exists, this is the only entry
I $G(BSID)'="" D G SIDCHKX
. S SID=BSID,(SIDACT,SIDCNT)=1
. S SIDARRAY($$STRIP(SID,,DFN)_"_")=""
. Q
;
;IB*668/TAZ - Changed Payer Application from IIV to EIV
S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
; dw/IB*2.0*668 location of field moved for variable SIDSTR
; S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0))
; S SIDREQ=$P(SIDSTR,U,8)
S SIDREQ=$$GET1^DIQ(365.121,APPIEN_","_PIEN_",",4.02,"I")
;
S INSSTR="",SIDCNT=0,INREC=$O(^DPT(DFN,.312,0)),MCRTQ=0 S:'INREC INREC=1
;
I $D(BSID),BSID="" G SIDC1
;
I $G(^DPT(DFN,.312,INREC,0)) F D Q:'INREC
. S INSSTR=$G(^DPT(DFN,.312,INREC,0))
. S INSSTR1=$G(^DPT(DFN,.312,INREC,1))
. S INSSTR7=$G(^DPT(DFN,.312,INREC,7)) ; IB*2.0*497 (vd)
. S SYMBOL=$$INSERROR^IBCNEUT3("I",+INSSTR)
. I $P(SYMBOL,U)="" D ; no eIV related error w/ ins. company
.. N MCRPYR
.. I PIEN'=$P(SYMBOL,U,2) Q ; wrong payer ien
.. ;
.. S MCRPYR=0 ; Medicare payer flag
.. I PIEN=+$P($G(^IBE(350.9,1,51)),U,25) S MCRPYR=1 ; this is the Medicare payer
.. I MCRPYR,MCRTQ Q ; the Medicare payer is already in the array
.. ;
.. S SUBID=$P(INSSTR7,U,2) ; IB*2.0*497 (vd)
.. I SUBID="" Q ; missing Subscriber ID
.. I $P(INSSTR,U,8)>DT Q ; future effective date
.. S EXP=$P(INSSTR,U,4) I EXP,EXP<DT Q ; expired
.. S MVER=$P(INSSTR1,U,3) ; last verified date
.. I MVER'="",FRESHDT'="",MVER>FRESHDT S VFLG=1 Q ; verified recently
.. S SUBIDS=$$STRIP(SUBID,,DFN)
.. I $D(SIDARRAY(SUBIDS_"_"_INREC)) Q ; already in the array
.. S SIDARRAY(SUBIDS_"_"_INREC)="",SIDCNT=SIDCNT+1
.. I MCRPYR S MCRTQ=1 ; flag indicating Medicare payer is in the array
.. Q
. ;
. S INREC=$O(^DPT(DFN,.312,INREC))
. Q
;
I SIDCNT S SIDACT=1 G SIDCHKX
I 'SIDCNT,VFLG S SIDACT=1 G SIDCHKX
SIDC1 ;
S SIDACT=$S(SIDREQ:3,1:4)
;
SIDCHKX ; EXIT POINT
;
Q SIDACT_U_SIDCNT
;
SSN(DFN) ; Get Patient SSN and update SIDARRAY, if needed
S SSN=$$GETSSN(DFN)
N SSNS
S SSNS=$$STRIP(SSN,1,DFN)
I $P($O(SIDARRAY(SSNS_"_")),"_")=SSNS Q
I SSNS'="",'$D(SIDARRAY(SSNS_"_")) S SIDARRAY(SSNS_"_")="",SIDCNT=SIDCNT+1
Q
;
GETSSN(DFN) ; Get Patient SSN
Q:'$G(DFN) ""
Q $P($G(^DPT(DFN,0)),U,9)
;
STRIP(ID,SS,DFN) ; Strip dashes and spaces if ssn
; ID can be ssn or subid
; if SS, ssn is being passed
N SSN,IDS,IDB
S SS=$G(SS)
; If a ssn is passed, strip dashes and spaces
I SS Q $TR(ID,"- ")
; If not ssn format, do not strip
S IDB=$TR(ID," ")
I IDB'?3N1"-"2N1"-"4N,IDB'?9N Q ID
; Compare w/SSN - if it matches, strip dashes and spaces
S IDS=$TR(ID,"- ")
S SSN=$TR($$GETSSN(DFN),"- ")
I SSN=IDS Q IDS
Q ID
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEDE5 4695 printed Apr 09, 2024@21:06:58 Page 2
IBCNEDE5 ;DAOU/DAC - eIV DATA EXTRACTS ;15-OCT-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,416,497,549,621,668**;21-MAR-94;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; no direct calls allowed
QUIT
+5 ; IB*2.0*621 - Removed tag "SIDCHK2"
+6 ;
SIDCHK(PIEN,DFN,BSID,SIDARRAY,FRESHDT) ; Checks the flag setting of
+1 ; '270 REQUIRES SUB ID' (#365.121,4.02). The function returns a "^"
+2 ; delimited string. The first value is between 1 and 5 telling the
+3 ; calling program what action(s) it should perform. The 2nd piece
+4 ; indicates the Subcriber ID that the calling program should use for
+5 ; setting the Subscriber IDs in the eIV Transmission Queue file (#365.1).
+6 ; The calling program is to address the blank Sub IDs.
+7 ;
+8 ; PIEN - Payer's IEN (file 365.12)
+9 ; DFN - Patient's IEN (file 2)
+10 ; INREC - Insurance IEN of Patients record (subfile 2.312)
+11 ; BSID - Subscriber ID from buffer file (file 355.33 field 60.04)
+12 ; SIDARRAY - Array of active subscribers
+13 ; FRESHDT - Freshness Date - used for checking verified date
+14 ;
+15 ; Logic to follow:
+16 ;
+17 ; Id. Req.| Sub ID|Action|
+18 ; Sub ID | found | # | Create
+19 ; ________|_______|______|________
+20 ; YES YES 1 1 Verification TQ entry w/ Sub ID
+21 ; YES NO 3 new buffer entry or modify existing saying manual verification required
+22 ; NO NO 4 1 Ver. TQ entry w/ blank Sub ID
+23 ;
+24 ; * Note: The insurance record found with the proper PIEN will only be
+25 ; picked up if the insurance policy is active, and if the insurance
+26 ; policy hasn't been verified within the Freshness period.
+27 ;
+28 ;dw/IB*668 removed SIDSTR
NEW SIDACT,SID,APPIEN,SIDREQ
+29 NEW INSSTR,INSSTR1,INSSTR7,SYMBOL,EXP,SUBID,SUBIDS,SIDCNT,INREC,MVER,VFLG,MCRTQ
+30 ;
+31 SET FRESHDT=$GET(FRESHDT)
SET VFLG=0
+32 ;
+33 ; if the subscriber ID from the buffer extract exists, this is the only entry
+34 IF $GET(BSID)'=""
Begin DoDot:1
+35 SET SID=BSID
SET (SIDACT,SIDCNT)=1
+36 SET SIDARRAY($$STRIP(SID,,DFN)_"_")=""
+37 QUIT
End DoDot:1
GOTO SIDCHKX
+38 ;
+39 ;IB*668/TAZ - Changed Payer Application from IIV to EIV
+40 SET APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+41 ; dw/IB*2.0*668 location of field moved for variable SIDSTR
+42 ; S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0))
+43 ; S SIDREQ=$P(SIDSTR,U,8)
+44 SET SIDREQ=$$GET1^DIQ(365.121,APPIEN_","_PIEN_",",4.02,"I")
+45 ;
+46 SET INSSTR=""
SET SIDCNT=0
SET INREC=$ORDER(^DPT(DFN,.312,0))
SET MCRTQ=0
if 'INREC
SET INREC=1
+47 ;
+48 IF $DATA(BSID)
IF BSID=""
GOTO SIDC1
+49 ;
+50 IF $GET(^DPT(DFN,.312,INREC,0))
FOR
Begin DoDot:1
+51 SET INSSTR=$GET(^DPT(DFN,.312,INREC,0))
+52 SET INSSTR1=$GET(^DPT(DFN,.312,INREC,1))
+53 ; IB*2.0*497 (vd)
SET INSSTR7=$GET(^DPT(DFN,.312,INREC,7))
+54 SET SYMBOL=$$INSERROR^IBCNEUT3("I",+INSSTR)
+55 ; no eIV related error w/ ins. company
IF $PIECE(SYMBOL,U)=""
Begin DoDot:2
+56 NEW MCRPYR
+57 ; wrong payer ien
IF PIEN'=$PIECE(SYMBOL,U,2)
QUIT
+58 ;
+59 ; Medicare payer flag
SET MCRPYR=0
+60 ; this is the Medicare payer
IF PIEN=+$PIECE($GET(^IBE(350.9,1,51)),U,25)
SET MCRPYR=1
+61 ; the Medicare payer is already in the array
IF MCRPYR
IF MCRTQ
QUIT
+62 ;
+63 ; IB*2.0*497 (vd)
SET SUBID=$PIECE(INSSTR7,U,2)
+64 ; missing Subscriber ID
IF SUBID=""
QUIT
+65 ; future effective date
IF $PIECE(INSSTR,U,8)>DT
QUIT
+66 ; expired
SET EXP=$PIECE(INSSTR,U,4)
IF EXP
IF EXP<DT
QUIT
+67 ; last verified date
SET MVER=$PIECE(INSSTR1,U,3)
+68 ; verified recently
IF MVER'=""
IF FRESHDT'=""
IF MVER>FRESHDT
SET VFLG=1
QUIT
+69 SET SUBIDS=$$STRIP(SUBID,,DFN)
+70 ; already in the array
IF $DATA(SIDARRAY(SUBIDS_"_"_INREC))
QUIT
+71 SET SIDARRAY(SUBIDS_"_"_INREC)=""
SET SIDCNT=SIDCNT+1
+72 ; flag indicating Medicare payer is in the array
IF MCRPYR
SET MCRTQ=1
+73 QUIT
End DoDot:2
+74 ;
+75 SET INREC=$ORDER(^DPT(DFN,.312,INREC))
+76 QUIT
End DoDot:1
if 'INREC
QUIT
+77 ;
+78 IF SIDCNT
SET SIDACT=1
GOTO SIDCHKX
+79 IF 'SIDCNT
IF VFLG
SET SIDACT=1
GOTO SIDCHKX
SIDC1 ;
+1 SET SIDACT=$SELECT(SIDREQ:3,1:4)
+2 ;
SIDCHKX ; EXIT POINT
+1 ;
+2 QUIT SIDACT_U_SIDCNT
+3 ;
SSN(DFN) ; Get Patient SSN and update SIDARRAY, if needed
+1 SET SSN=$$GETSSN(DFN)
+2 NEW SSNS
+3 SET SSNS=$$STRIP(SSN,1,DFN)
+4 IF $PIECE($ORDER(SIDARRAY(SSNS_"_")),"_")=SSNS
QUIT
+5 IF SSNS'=""
IF '$DATA(SIDARRAY(SSNS_"_"))
SET SIDARRAY(SSNS_"_")=""
SET SIDCNT=SIDCNT+1
+6 QUIT
+7 ;
GETSSN(DFN) ; Get Patient SSN
+1 if '$GET(DFN)
QUIT ""
+2 QUIT $PIECE($GET(^DPT(DFN,0)),U,9)
+3 ;
STRIP(ID,SS,DFN) ; Strip dashes and spaces if ssn
+1 ; ID can be ssn or subid
+2 ; if SS, ssn is being passed
+3 NEW SSN,IDS,IDB
+4 SET SS=$GET(SS)
+5 ; If a ssn is passed, strip dashes and spaces
+6 IF SS
QUIT $TRANSLATE(ID,"- ")
+7 ; If not ssn format, do not strip
+8 SET IDB=$TRANSLATE(ID," ")
+9 IF IDB'?3N1"-"2N1"-"4N
IF IDB'?9N
QUIT ID
+10 ; Compare w/SSN - if it matches, strip dashes and spaces
+11 SET IDS=$TRANSLATE(ID,"- ")
+12 SET SSN=$TRANSLATE($$GETSSN(DFN),"- ")
+13 IF SSN=IDS
QUIT IDS
+14 QUIT ID
+15 ;
