Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEDE5

IBCNEDE5.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q    ; no direct calls allowed
  1.  ; IB*2.0*621 - Removed tag "SIDCHK2"
  1.  ;
  1. SIDCHK(PIEN,DFN,BSID,SIDARRAY,FRESHDT) ; Checks the flag setting of
  1.  ; '270 REQUIRES SUB ID' (#365.121,4.02). The function returns a "^"
  1.  ; delimited string.  The first value is between 1 and 5 telling the
  1.  ; calling program what action(s) it should perform. The 2nd piece
  1.  ; indicates the Subcriber ID that the calling program should use for
  1.  ; setting the Subscriber IDs in the eIV Transmission Queue file (#365.1).
  1.  ; The calling program is to address the blank Sub IDs.
  1.  ;
  1.  ; PIEN - Payer's IEN (file 365.12)
  1.  ; DFN - Patient's IEN (file 2)
  1.  ; INREC - Insurance IEN of Patients record (subfile 2.312)
  1.  ; BSID - Subscriber ID from buffer file (file 355.33 field 60.04)
  1.  ; SIDARRAY - Array of active subscribers
  1.  ; FRESHDT - Freshness Date - used for checking verified date
  1.  ;
  1.  ; Logic to follow:
  1.  ;
  1.  ; Id. Req.| Sub ID|Action|
  1.  ;  Sub ID | found |  #   | Create
  1.  ; ________|_______|______|________
  1.  ; YES        YES     1     1 Verification TQ entry w/ Sub ID
  1.  ; YES        NO      3     new buffer entry or modify existing saying manual verification required
  1.  ; NO         NO      4     1 Ver. TQ entry w/ blank Sub ID
  1.  ;
  1.  ; * Note: The insurance record found with the proper PIEN will only be
  1.  ;         picked up if the insurance policy is active, and if the insurance
  1.  ;         policy hasn't been verified within the Freshness period.
  1.  ;
  1.  N SIDACT,SID,APPIEN,SIDREQ    ;dw/IB*668 removed SIDSTR
  1.  N INSSTR,INSSTR1,INSSTR7,SYMBOL,EXP,SUBID,SUBIDS,SIDCNT,INREC,MVER,VFLG,MCRTQ
  1.  ;
  1.  S FRESHDT=$G(FRESHDT),VFLG=0
  1.  ;
  1.  ; if the subscriber ID from the buffer extract exists, this is the only entry
  1.  I $G(BSID)'="" D  G SIDCHKX
  1.  . S SID=BSID,(SIDACT,SIDCNT)=1
  1.  . S SIDARRAY($$STRIP(SID,,DFN)_"_")=""
  1.  . Q
  1.  ;
  1.  ;IB*668/TAZ - Changed Payer Application from IIV to EIV
  1.  S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
  1.  ; dw/IB*2.0*668 location of field moved for variable SIDSTR
  1.  ; S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0))
  1.  ; S SIDREQ=$P(SIDSTR,U,8)
  1.  S SIDREQ=$$GET1^DIQ(365.121,APPIEN_","_PIEN_",",4.02,"I")
  1.  ;
  1.  S INSSTR="",SIDCNT=0,INREC=$O(^DPT(DFN,.312,0)),MCRTQ=0 S:'INREC INREC=1
  1.  ;
  1.  I $D(BSID),BSID="" G SIDC1
  1.  ;
  1.  I $G(^DPT(DFN,.312,INREC,0)) F  D  Q:'INREC
  1.  . S INSSTR=$G(^DPT(DFN,.312,INREC,0))
  1.  . S INSSTR1=$G(^DPT(DFN,.312,INREC,1))
  1.  . S INSSTR7=$G(^DPT(DFN,.312,INREC,7))    ; IB*2.0*497 (vd)
  1.  . S SYMBOL=$$INSERROR^IBCNEUT3("I",+INSSTR)
  1.  . I $P(SYMBOL,U)="" D            ; no eIV related error w/ ins. company
  1.  .. N MCRPYR
  1.  .. I PIEN'=$P(SYMBOL,U,2) Q      ; wrong payer ien
  1.  .. ;
  1.  .. S MCRPYR=0                                           ; Medicare payer flag
  1.  .. I PIEN=+$P($G(^IBE(350.9,1,51)),U,25) S MCRPYR=1     ; this is the Medicare payer
  1.  .. I MCRPYR,MCRTQ Q      ; the Medicare payer is already in the array
  1.  .. ;
  1.  .. S SUBID=$P(INSSTR7,U,2)                ; IB*2.0*497 (vd)
  1.  .. I SUBID="" Q                           ; missing Subscriber ID
  1.  .. I $P(INSSTR,U,8)>DT Q                  ; future effective date
  1.  .. S EXP=$P(INSSTR,U,4) I EXP,EXP<DT Q    ; expired
  1.  .. S MVER=$P(INSSTR1,U,3)                 ; last verified date
  1.  .. I MVER'="",FRESHDT'="",MVER>FRESHDT S VFLG=1 Q     ; verified recently
  1.  .. S SUBIDS=$$STRIP(SUBID,,DFN)
  1.  .. I $D(SIDARRAY(SUBIDS_"_"_INREC)) Q            ; already in the array
  1.  .. S SIDARRAY(SUBIDS_"_"_INREC)="",SIDCNT=SIDCNT+1
  1.  .. I MCRPYR S MCRTQ=1     ; flag indicating Medicare payer is in the array
  1.  .. Q
  1.  . ;
  1.  . S INREC=$O(^DPT(DFN,.312,INREC))
  1.  . Q
  1.  ;
  1.  I SIDCNT S SIDACT=1 G SIDCHKX
  1.  I 'SIDCNT,VFLG S SIDACT=1 G SIDCHKX
  1. SIDC1 ;
  1.  S SIDACT=$S(SIDREQ:3,1:4)
  1.  ;
  1. SIDCHKX ; EXIT POINT
  1.  ;
  1.  Q SIDACT_U_SIDCNT
  1.  ;
  1. SSN(DFN) ; Get Patient SSN and update SIDARRAY, if needed
  1.  S SSN=$$GETSSN(DFN)
  1.  N SSNS
  1.  S SSNS=$$STRIP(SSN,1,DFN)
  1.  I $P($O(SIDARRAY(SSNS_"_")),"_")=SSNS Q
  1.  I SSNS'="",'$D(SIDARRAY(SSNS_"_")) S SIDARRAY(SSNS_"_")="",SIDCNT=SIDCNT+1
  1.  Q
  1.  ;
  1. GETSSN(DFN) ; Get Patient SSN
  1.  Q:'$G(DFN) ""
  1.  Q $P($G(^DPT(DFN,0)),U,9)
  1.  ;
  1. STRIP(ID,SS,DFN) ; Strip dashes and spaces if ssn
  1.  ;         ID can be ssn or subid
  1.  ;         if SS, ssn is being passed
  1.  N SSN,IDS,IDB
  1.  S SS=$G(SS)
  1.  ; If a ssn is passed, strip dashes and spaces
  1.  I SS Q $TR(ID,"- ")
  1.  ; If not ssn format, do not strip
  1.  S IDB=$TR(ID," ")
  1.  I IDB'?3N1"-"2N1"-"4N,IDB'?9N Q ID
  1.  ; Compare w/SSN - if it matches, strip dashes and spaces
  1.  S IDS=$TR(ID,"- ")
  1.  S SSN=$TR($$GETSSN(DFN),"- ")
  1.  I SSN=IDS Q IDS
  1.  Q ID
  1.  ;