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

IBCNEDE1.m

Go to the documentation of this file. 
  1. IBCNEDE1 ;DAOU/DAC - eIV INSURANCE BUFFER EXTRACT ;04-JUN-2002
  1.  ;;2.0;INTEGRATED BILLING;**184,271,416,438,435,467,497,528,549,601,664,668**;21-MAR-94;Build 28
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;**Program Description**
  1.  ; This routine loops through the insurance buffer and 
  1.  ; creates eIV transaction queue entries when appropriate.
  1.  ; Periodically check for stop request for background task
  1.  ;
  1.  ;/vd-IB*2*668 - Removed the SSVI logic introduced with IB*2*528 in its entirety within VistA.
  1.  ;
  1.  Q   ; no direct calls allowed
  1.  ;
  1. EN ; Loop through designated cross-references for updates
  1.  ; Insurance Buffer Extract
  1.  ;
  1.  ;/vd-IB*2*664 - Added the variable EHRSRC
  1.  N TODAYSDT,FRESHDAY,LOOPDT,IEN,OVRFRESH,FRESHDT
  1.  N DFN,PDOD,SRVICEDT,VERIFDDT,PAYERSTR,PAYERID,SYMBOL,PAYRNAME
  1.  N PIEN,PNIEN,TQIEN,TRIEN,TRSRVCDT,TQCRTDT,TRANSNO,DISYS
  1.  N ORIGINSR,ORGRPSTR,ORGRPNUM,ORGRPNAM,ORGSUBCR
  1.  N MAXCNT,CNT,ISYMBOLM,DATA1,DATA2,ORIG,SETSTR,ISYMBOL,IBCNETOT
  1.  N SIDDATA,SID,SIDACT,BSID,FDA,PASSBUF,SIDCNT,SIDARRAY
  1.  N TQDT,TQIENS,TQOK,STATIEN,PATID,MCAREFLG,INSNAME,PREL,EHRSRC,SOURCE,AMCMS
  1.  ;
  1.  S SETSTR=$$SETTINGS^IBCNEDE7(1) ; Returns buffer extract settings
  1.  I 'SETSTR Q                    ; Quit if extract is not active
  1.  S MAXCNT=$P(SETSTR,U,4)        ; Max # TQ entries that may be created
  1.  S:MAXCNT="" MAXCNT=9999999999
  1.  ;
  1.  S EHRSRC=$O(^IBE(355.12,"C","ELECTRONIC HEALTH RECORD",""))  ;vd/IB*2*664 -  Used to identify EHR buffer entries.
  1.  S AMCMS=$O(^IBE(355.12,"C","ADV MED COST MGMT SOLUTION","")) ;IB*668/DW - AMCMS entries.
  1.  ;
  1.  S FRESHDAY=$P($G(^IBE(350.9,1,51)),U,1) ; System freshness days
  1.  ;
  1.  S CNT=0       ; Initialize count of TQ entries created
  1.  S IBCNETOT=0  ; Initialize count for periodic TaskMan check
  1.  ;
  1.  S LOOPDT="" ; Date used to loop through the IB global
  1.  F  S LOOPDT=$O(^IBA(355.33,"AEST","E",LOOPDT)) Q:LOOPDT=""!(CNT=MAXCNT)  D  Q:$G(ZTSTOP)
  1.  . S IEN=""
  1.  . F  S IEN=$O(^IBA(355.33,"AEST","E",LOOPDT,IEN)) Q:IEN=""!(CNT=MAXCNT)  D  Q:$G(ZTSTOP)
  1.  .. ;
  1.  .. S SOURCE=$$GET1^DIQ(355.33,IEN_",",.03,"I") ;IB*668/DW set variable SOURCE
  1.  .. I (SOURCE=EHRSRC)!(SOURCE=AMCMS) Q   ;IB*664/VD & IB*668/DW - Skip buffer entry
  1.  .. ;
  1.  .. ; Update count for periodic check
  1.  .. S IBCNETOT=IBCNETOT+1
  1.  .. ; Check for request to stop background job, periodically
  1.  .. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
  1.  .. ;
  1.  .. ; Get symbol, if symbol'=" " OR "!" then quit
  1.  .. S ISYMBOL=$$SYMBOL^IBCNBLL(IEN) ; Insurance buffer symbol
  1.  .. I (ISYMBOL'=" ")&(ISYMBOL'="!") Q
  1.  .. ; Don't extract ePharmacy buffer entries - IB*2*435
  1.  .. I +$P($G(^IBA(355.33,IEN,0)),U,17) Q
  1.  .. ;
  1.  .. ; Get the eIV STATUS IEN and quit for response related errors
  1.  .. S STATIEN=+$P($G(^IBA(355.33,IEN,0)),U,12)
  1.  .. I ",11,12,15,"[(","_STATIEN_",") Q  ; Prevent update for response errors
  1.  .. ;
  1.  .. S OVRFRESH=$P($G(^IBA(355.33,IEN,0)),U,13) ; Freshness OvrRd flag
  1.  .. S DFN=$P($G(^IBA(355.33,IEN,60)),U,1) ; Patient DFN
  1.  .. Q:DFN=""
  1.  .. I $P($G(^DPT(DFN,0)),U,21) Q           ; Exclude if test patient
  1.  .. ;
  1.  .. S PDOD=$P($G(^DPT(DFN,.35)),U,1)\1     ; Patient's date of death
  1.  .. S SRVICEDT=+$P($G(^IBA(355.33,IEN,0)),U,18)
  1.  .. S:'SRVICEDT SRVICEDT=DT                         ; Service Date
  1.  .. ;
  1.  .. ; IB*2.0*549 Removed following line
  1.  .. ;I PDOD,PDOD<SRVICEDT S SRVICEDT=PDOD
  1.  .. S FRESHDT=$$FMADD^XLFDT(SRVICEDT,-FRESHDAY)
  1.  .. S PAYERSTR=$$INSERROR^IBCNEUT3("B",IEN)          ; Payer String
  1.  .. S PAYERID=$P(PAYERSTR,U,3),PIEN=$P(PAYERSTR,U,2) ; Payer ID
  1.  .. S SYMBOL=+PAYERSTR                               ; Payer Symbol
  1.  .. I '$$PYRACTV^IBCNEDE7(PIEN) Q          ; Payer is not nationally active
  1.  .. ;
  1.  .. ; If payer symbol is returned set symbol in Ins. Buffer and quit
  1.  .. I SYMBOL D BUFF^IBCNEUT2(IEN,SYMBOL) Q
  1.  .. ;
  1.  .. D CLEAR^IBCNEUT4(IEN)                ; remove any existing symbol
  1.  .. ;
  1.  .. ; If no payer ID or no payer IEN is returned quit
  1.  .. I (PAYERID="")!('PIEN) Q
  1.  .. ;
  1.  .. ; Update service date and freshness date based on payer's allowed
  1.  .. ;  date range
  1.  .. D UPDDTS^IBCNEDE6(PIEN,.SRVICEDT,.FRESHDT)
  1.  .. ;
  1.  .. ; Update service dates for inquiries to be transmitted
  1.  .. D TQUPDSV^IBCNEUT5(DFN,PIEN,SRVICEDT)
  1.  .. ;
  1.  .. ; allow only one MEDICARE transmission per patient
  1.  .. S INSNAME=$P($G(^IBA(355.33,IEN,20)),U)
  1.  .. I INSNAME["MEDICARE",$G(MCAREFLG(DFN)) Q
  1.  .. ;
  1.  .. ; set pat. relationship to "self" if it's blank
  1.  .. D SETREL(IEN)
  1.  .. ;
  1.  .. ; make sure that service type codes are set
  1.  .. I '+$G(^IBA(355.33,IEN,80)) D SETSTC^IBCNERTQ(IEN)
  1.  .. ;
  1.  .. ; If freshness override flag is set, file to TQ and quit
  1.  .. I OVRFRESH=1 D  Q
  1.  ... NEW DIE,X,Y,DISYS
  1.  ... S FDA(355.33,IEN_",",.13)="" D FILE^DIE("","FDA") K FDA
  1.  ... S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ
  1.  .. ; Check the existing TQ entries to confirm that this buffer IEN is
  1.  .. ; not included
  1.  .. S (TQDT,TQIENS)="",TQOK=1
  1.  .. F  S TQDT=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT)) Q:'TQDT!'TQOK  D
  1.  ... F  S TQIENS=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT,TQIENS)) Q:'TQIENS!'TQOK  D
  1.  ....    I $P($G(^IBCN(365.1,TQIENS,0)),U,5)=IEN S TQOK=0 Q
  1.  .. I TQOK S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ
  1.  Q
  1. TQ ; Determine how many entries to create in the TQ file and set entries
  1.  ;
  1.  K SIDARRAY
  1.  S BSID=$P($G(^IBA(355.33,IEN,90)),U,3)   ; Subscriber ID from buffer (IB*2.0*497 - vd)
  1.  S PATID=$P($G(^IBA(355.33,IEN,62)),U)    ; Patient ID from buffer
  1.  S PREL=$P($G(^IBA(355.33,IEN,60)),U,14)  ; Pat. relationship from buffer
  1.  S SIDDATA=$$SIDCHK^IBCNEDE5(PIEN,DFN,BSID,.SIDARRAY,FRESHDT) ;determine rules to follow
  1.  S SIDACT=$P(SIDDATA,U,1)
  1.  S SIDCNT=$P(SIDDATA,U,2)                 ;Pull cnt of SIDs - shd be 1
  1.  ;
  1.  I SIDACT=3 D BUFF^IBCNEUT2(IEN,18) Q   ; update buffer w/ bang & quit - no subscriber id
  1.  I PREL'=18 D  Q
  1.  .I PATID="" D BUFF^IBCNEUT2(IEN,23) Q  ; update buffer w/ bang & quit - no patient id
  1.  .D SET(IEN,OVRFRESH,1,"") ; set TQ entry
  1.  .Q
  1.  I CNT+SIDCNT>MAXCNT Q
  1.  S SID=""
  1.  F  S SID=$O(SIDARRAY(SID)) Q:SID=""  D:$P(SID,"_")'="" SET(IEN,OVRFRESH,1,$P(SID,"_"))    ; set TQ w/ 'Pass Buffer' flag
  1.  I SIDACT=4 D SET(IEN,OVRFRESH,1,"")       ; set TQ w/ 'Pass Buffer' flag w/ blank subscriber ID
  1.  Q
  1.  ;
  1. RET ; Record Retrieval - Insurance Buffer
  1.  ;
  1.  S ORIGINSR=$P($G(^IBA(355.33,IEN,20)),U,1) ;Original ins. co.
  1.  S ORGRPSTR=$G(^IBA(355.33,IEN,90)) ; Original group string (IB*2.0*497 - vd)
  1.  S ORGRPNUM=$P(ORGRPSTR,U,2) ;Original group number (IB*2.0*497 - vd)
  1.  S ORGRPNAM=$P(ORGRPSTR,U,1) ;Original group name (IB*2.0*497 - vd)
  1.  S ORGSUBCR=$P(ORGRPSTR,U,3) ; Original subscriber (IB*2.0*497 - vd)
  1.  ;
  1.  Q
  1.  ;
  1. SET(BUFFIEN,OVRFRESH,PASSBUF,SID1) ; Set data and check if set already
  1.  N DATA5
  1.  D RET
  1.  ;
  1.  ; The hard coded '1' in the 3rd piece of DATA1 sets the Transmission
  1.  ; status of file 365.1 to "Ready to Transmit"
  1.  S DATA1=DFN_U_PIEN_U_1_U_$G(BUFFIEN)_U_SID1_U_FRESHDT_U_PASSBUF ; SETTQ parameter 1
  1.  S $P(DATA1,U,8)=PATID     ; IB*2*416
  1.  ;
  1.  ;The hardcoded '1' in the 1st piece of DATA2 is the value to tell
  1.  ; the file 365.1 that it is the buffer extract.
  1.  S DATA2=1_U_"V"_U_SRVICEDT_U_"" ; SETTQ parameter 2
  1.  ;
  1.  S ORIG=ORIGINSR_U_ORGRPNUM_U_ORGRPNAM_U_ORGSUBCR ; SETTQ parameter 3
  1.  ;
  1.  S DATA5=$$GET1^DIQ(355.33,BUFFIEN_",",.03,"I") ; IB*2*601/DM copy SOI IEN to TQ
  1.  S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,ORIG,$G(OVRFRESH),DATA5) ; File TQ entry
  1.  I TQIEN'="" S CNT=CNT+1 ; If filed increment count
  1.  ;
  1.  Q
  1.  ;
  1. SETREL(IEN) ; set pat. relationship to "self"
  1.  N DA,DIE,DR,X,Y
  1.  I $P($G(^IBA(355.33,IEN,60)),U,14)="" S DIE="^IBA(355.33,",DA=IEN,DR="60.14///SELF" D ^DIE
  1.  Q