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

IBCNEDE2.m

Go to the documentation of this file.
  1. IBCNEDE2 ;DAOU/DAC - eIV Appointment Extract ;23-SEP-2015
  1. ;;2.0;INTEGRATED BILLING;**184,271,249,345,416,438,506,549,593,595,621,659,743,778**;21-MAR-94;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;IB*778/CKB - rewrote the eIV Appointment Extract from scratch, reusing the routine IBCNEDE2.
  1. ; Any modifications based on patches prior to 778 are no longer applicable for this
  1. ; routine, due to the rewrite.
  1. ;
  1. ;**Program Description**
  1. ; This program finds patients who have upcoming appointments within a
  1. ; specified date range. The date range is parameter driven.
  1. ; Periodically check for stop request as this is a background task.
  1. ;
  1. Q ; can't be called directly
  1. ;
  1. EN ; Loop through designated cross-references for updates
  1. N APTDT,CLNC,CNT,DFN,DTRANGE,ENDDT,EXCLTOC,EXCLTOP,FRESHDAY,IBCNETOT,IBFNDTQ,IBPQ,IBSDA,INREC,INSIEN,INSNAME
  1. N MAXCNT,MFLG,MFRESHDAY,NUM,OK,PATID,PAYERSTR,PIEN,PTINS,PYRAPP,QURYFLAG,SETSTR,SRVICEDT
  1. N SYMBOL,TQIEN,VDATE,ZTQUEUED,ZTSTOP,ZZ
  1. ;
  1. S SETSTR=$$SETTINGS^IBCNEDE7(2) ; Get setting for pre reg. extract
  1. I 'SETSTR Q ; Quit if extract is not active
  1. S DTRANGE=$P(SETSTR,U,2) ; Selection Criteria #1 - how far in the future do I look for appts
  1. S MAXCNT=$P(SETSTR,U,4) ; Max # of TQ entries to create & send to FSC
  1. S:MAXCNT="" MAXCNT=9999999999
  1. S FRESHDAY=$P($G(^IBE(350.9,1,51)),U,1) ; Freshness days span
  1. S MFRESHDAY=$$GET1^DIQ(350.9,"1,",51.32) ; Medicare Freshness days span
  1. S ENDDT=$$FMADD^XLFDT(DT,DTRANGE) ; End of appt. date selection range
  1. S CNT=0 ; Init. entries created in TQ and send to FSC
  1. S IBCNETOT=0 ; Initialize count for periodic TaskMan check
  1. S EXCLTOC=$$GETELST(355.2) ; Initialize excluded TYPEs OF COVERAGE
  1. S EXCLTOP=$$GETELST(355.1) ; Initialize excluded TYPEs OF PLAN
  1. ; Clean TMP globals
  1. K ^TMP($J,"SDAMA301"),^TMP($J,"IBCNEDE2DFN")
  1. ;
  1. ; Set up variables for scheduling call and call
  1. S IBSDA("FLDS")=8
  1. S IBSDA(1)=DT_";"_ENDDT
  1. S IBSDA(3)="R"
  1. S NUM=$$SDAPI^SDAMA301(.IBSDA) I NUM<1 D:NUM<0 ERRMSG G ENQ
  1. ;
  1. ;
  1. S CLNC=0 ; Init. clinic
  1. ; Loop through clinics returned
  1. F S CLNC=$O(^TMP($J,"SDAMA301",CLNC)) Q:'CLNC D Q:$G(ZTSTOP)
  1. . ;
  1. . ; Loop through patients returned
  1. . S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",CLNC,DFN)) Q:'DFN D Q:$G(ZTSTOP)
  1. .. ;
  1. .. S APTDT=DT ; Check for appointment date
  1. .. ;
  1. .. ; Loop through dates in range at clinic
  1. .. F S APTDT=$O(^TMP($J,"SDAMA301",CLNC,DFN,APTDT)) Q:('APTDT)!((APTDT\1)>ENDDT) D Q:$G(ZTSTOP)
  1. ... ;
  1. ... S SRVICEDT=APTDT\1 ;Set service date equal to appointment date
  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. ... I $P($G(^DPT(DFN,0)),U,21) Q ; Exclude if test patient
  1. ... ;
  1. ... ; Build temp array for allowed DFN's
  1. ... S ^TMP($J,"IBCNEDE2DFN",DFN,(+$G(SRVICEDT)))=""
  1. ;
  1. 100 ;
  1. ; Check the insurance for the selected DFNs based on future appointments
  1. S DFN=0
  1. F S DFN=$O(^TMP($J,"IBCNEDE2DFN",DFN)) Q:'DFN D
  1. . ;
  1. . K IBFNDTQ
  1. . K PTINS D ALL^IBCNEDE3(DFN,"PTINS")
  1. . I '$D(PTINS(0)) Q ; Patient has no insurance to be evaluated
  1. . ;
  1. . ; Find the service date that is closest to TODAY (DT), do not look for past dates.
  1. . S SRVICEDT=$O(^TMP($J,"IBCNEDE2DFN",DFN,(DT-1)))
  1. . I SRVICEDT="" Q ; No future appointments are found for the patient
  1. . ;
  1. . ;Loop through Patient policies and check MAXCNT
  1. . S INREC=0 F S INREC=$O(PTINS(INREC)) Q:('INREC)!(CNT'<MAXCNT) D
  1. .. N ADDTQ,FSCSEND,GIEN,GRPNAM,GRPNUM,PATID
  1. .. N SENDNOW,SUBID,TQENT,TQFOUND,XXGN
  1. .. S MFLG=0
  1. .. ; Repull Service Date for each Policy
  1. .. S SRVICEDT=$O(^TMP($J,"IBCNEDE2DFN",DFN,(DT-1)))
  1. .. ; Get Payer, Insurance and Group Plan info
  1. .. S INSIEN=$P($G(PTINS(INREC,0)),U,1)
  1. .. S INSNAME=$$GET1^DIQ(36,INSIEN_",",.01,"E")
  1. .. S GIEN=$$GET1^DIQ(2.312,INREC_","_DFN_",",.18,"I")
  1. .. S GRPNAM=$$GET1^DIQ(355.3,GIEN_",",2.01,"E")
  1. .. S GRPNUM=$$GET1^DIQ(355.3,GIEN_",",2.02,"E")
  1. .. S SUBID=$$GET1^DIQ(2.312,INREC_","_DFN_",",7.02,"E")
  1. .. S PATID=$$GET1^DIQ(2.312,INREC_","_DFN_",",5.01,"E")
  1. .. ; Remove any non-alpha numeric characters
  1. .. I SUBID'="" S SUBID=$$STRIP^IBCNEDE3(SUBID)
  1. .. I PATID'="" S PATID=$$STRIP^IBCNEDE3(PATID)
  1. .. ;
  1. .. ; Type of Plan
  1. .. S ZZ=$$GET1^DIQ(355.3,GIEN_",",.09,"I")
  1. .. Q:EXCLTOP[("^"_ZZ_"^") ; Excluded Types of Plan
  1. .. ;
  1. .. ; Type of Coverage
  1. .. S ZZ=$$GET1^DIQ(36,INSIEN_",",.13,"I")
  1. .. Q:EXCLTOC[("^"_ZZ_"^") ; Excluded Type of Coverage
  1. .. ;
  1. .. ; OKFRESH properly identifies the policies to exclude when verified
  1. .. ; within the "freshness days" for Medicare and non-Medicare policies (MFLG)
  1. .. I '$$OKFRESH(INREC,FRESHDAY,MFRESHDAY,.MFLG) Q
  1. .. ;
  1. .. ; $$INSERROR, when passing in "I", gets Insurance company and Payer info and performs the following checks:
  1. .. ; - Insurance company must be active, linked to a eIV payer AND not marked for deletion
  1. .. ; - Insurance company name must not contain "MEDICAID"
  1. .. ; - Payer must be Nationally and Locally enabled for eIV AND not deactivated
  1. .. ; - Payer must have a VA National ID
  1. .. S IBPQ=0
  1. .. S PAYERSTR=$$INSERROR^IBCNEUT3("I",INSIEN)
  1. .. S SYMBOL=+PAYERSTR ; error symbol
  1. .. S PIEN=$P(PAYERSTR,U,2) ; Payer IEN
  1. .. ;
  1. .. I +PIEN D
  1. ... ; Determine Payer App IEN
  1. ... S PYRAPP=$$PYRAPP^IBCNEUT5("EIV",PIEN)
  1. ... ; If Payer requires a Subscriber ID and the policy does not have one on file, drop to buffer
  1. ... I $$GET1^DIQ(365.121,PYRAPP_","_PIEN_",",4.02,"I") I SUBID="" S IBPQ=1
  1. .. ;
  1. .. ; If Payer IEN is not defined or Payer is Nationally Inactive, drop to buffer
  1. .. I ('+PIEN)!('$$PYRACTV^IBCNEDE7(PIEN)) S IBPQ=1
  1. .. ;
  1. .. ; Drop to the Buffer and quit, had an issue with Insurance Co or Payer or Policy
  1. .. I (SYMBOL)!(IBPQ=1) D Q
  1. ... I '$$BFEXIST^IBCNEDE3(DFN,INSNAME,SUBID,GRPNUM) D PT^IBCNEBF(DFN,INREC,SYMBOL,"",1)
  1. .. ;
  1. .. ; If MEDICARE (MFLG) and GRPNUM="PART A" or "PART B", check for the existence in array IBFNDTQ
  1. .. ; Only allow ONE occurrence in the TQ for Medicare Part A and Medicare Part B, never both
  1. .. I MFLG&((GRPNUM="PART A")!(GRPNUM="PART B")) I $D(IBFNDTQ(PIEN,$S(SUBID="":" ",1:SUBID),"PART A"))!$D(IBFNDTQ(PIEN,$S(SUBID="":" ",1:SUBID),"PART B")) Q
  1. .. ;
  1. .. ; Check for the existence in array IBFNDTQ, DO NOT continue
  1. .. I $D(IBFNDTQ(PIEN,$S(SUBID="":" ",1:SUBID),$S(GRPNUM="":" ",1:GRPNUM))) Q
  1. .. ;
  1. .. ; Update service date based on Payers allowed date range
  1. .. D UPDSD^IBCNEDE3(PIEN,PYRAPP,.SRVICEDT)
  1. .. ;
  1. .. ; Initialize variables for TQUPDSV and TQCHKS
  1. .. S ADDTQ=1,(FSCSEND,TQFOUND)=0,TQENT=""
  1. .. ;
  1. .. ; Update service dates for inquiry to be transmitted
  1. .. ; sets TQFOUND, FSCSEND and TQENT
  1. .. D TQUPDSV^IBCNEDE3(DFN,PIEN,SRVICEDT,SUBID,GRPNUM)
  1. .. ; Check to see if a new entry can be added to the TQ file
  1. .. ; sets ADDTQ
  1. .. D TQCHKS^IBCNEDE3(DFN,PIEN,SRVICEDT,SUBID,GRPNUM,$S(MFLG:MFRESHDAY,1:FRESHDAY))
  1. .. ;
  1. .. ; to handle Medicare Part A and Medicare Part B, only allow one occurrence
  1. .. I ADDTQ&'TQFOUND&MFLG&((GRPNUM="PART A")!(GRPNUM="PART B")) D
  1. ... S XXGN=$S(GRPNUM="PART A":"PART B",1:"PART A")
  1. ... D TQUPDSV^IBCNEDE3(DFN,PIEN,SRVICEDT,SUBID,XXGN)
  1. ... D TQCHKS^IBCNEDE3(DFN,PIEN,SRVICEDT,SUBID,XXGN,$S(MFLG:MFRESHDAY,1:FRESHDAY))
  1. .. ;
  1. .. ; If a valid entry was found in the TQ file (TQFOUND=1) AND the send to FSC now flag
  1. .. ; (FSCSEND) is set to '1', transmit to FSC and increment counter
  1. .. ; DO NOT create a new entry if TQFOUND is true
  1. .. I TQFOUND D Q
  1. ... I FSCSEND,TQENT I CNT'>MAXCNT D XMIT1^IBCNEDEP(TQENT) S CNT=CNT+1 ; Increment counter of entries sent to FSC
  1. .. ; If ADDTQ is set to '0', DO NOT create a new entry (safety valve)
  1. .. I 'ADDTQ Q
  1. .. ;
  1. .. ; Determine if the Subscriber ID should be included/saved to the TQ
  1. .. ; The policy has a subscriber ID on file - include subscriber ID
  1. .. S QURYFLAG="V"
  1. .. I SUBID'="" D SET(SUBID,INREC,PATID)
  1. .. ; If the policy does NOT have subscriber ID on file - don't include subscriber ID
  1. .. I SUBID="" D SET("",INREC,PATID)
  1. .. ; Set local array of patient's added to the TQ file
  1. .. S IBFNDTQ(PIEN,$S(SUBID="":" ",1:SUBID),$S(GRPNUM="":" ",1:GRPNUM))=1
  1. ;
  1. ENQ ;
  1. K ^TMP($J,"SDAMA301")
  1. K ^TMP($J,"IBCNEDE2DFN")
  1. Q
  1. ;========================================================================
  1. GETELST(FILE) ; Returns a '^' delimited list of IENs Type of Plans or Type of
  1. ; coverages to be excluded with leading and trailing '^'s
  1. ;Input:
  1. ; FILE = 355.1 - Type of Plans
  1. ; = 355.2 - Type of Coverages
  1. ;Returns:
  1. ; EXCLIST - '^' delimited list of IENs for Type of Plans or Type of Coverages
  1. ; to be excluded (ie., ^10^6^22^)
  1. ;
  1. N EXCLIST,IEN,LINE,TYPE
  1. S EXCLIST=""
  1. I FILE="355.1" F LINE=1:1 S TYPE=$P($T(TOP+LINE),";;",2) Q:TYPE="" D
  1. . I '$D(^IBE(FILE,"B",TYPE)) Q
  1. . N IEN S IEN=$O(^IBE(FILE,"B",TYPE,""))
  1. . S EXCLIST=$S(EXCLIST="":IEN,1:EXCLIST_"^"_IEN)
  1. ;
  1. I FILE="355.2" F LINE=1:1 S TYPE=$P($T(TOC+LINE),";;",2) Q:TYPE="" D
  1. . I '$D(^IBE(FILE,"B",TYPE)) Q
  1. . N IEN S IEN=$O(^IBE(FILE,"B",TYPE,""))
  1. . S EXCLIST=$S(EXCLIST="":IEN,1:EXCLIST_"^"_IEN)
  1. ;
  1. Q "^"_EXCLIST_"^"
  1. ;----------------------------------
  1. TOP ; Type of Plans (#355.1) to exclude
  1. ;;AUTOMOBILE
  1. ;;MEDICAID
  1. ;;MEDI-CAL
  1. ;;TORT FEASOR
  1. ;;WORKERS' COMPENSATION INSURANCE
  1. ;;VA SPECIAL CLASS
  1. ;;ACCIDENT AND HEALTH INSURANCE
  1. ;;AVIATION TRIP INSURANCE
  1. ;;CATASTROPHIC INSURANCE
  1. ;;COINSURANCE
  1. ;;INCOME PROTECTION (INDEMNITY)
  1. ;;MEDICARE/MEDICAID (MEDI-CAL)
  1. ;;QUALIFIED IMPAIRMENT INSURANCE
  1. ;;SPECIAL CLASS INSURANCE
  1. ;;SPECIAL RISK INSURANCE
  1. ;----------------------------------
  1. TOC ; Type of Coverages (#355.2) to exclude
  1. ;;MEDICAID
  1. ;;MEDI-CAL
  1. ;;TORT/FEASOR
  1. ;;WORKERS' COMPENSATION
  1. ;;VA SPECIAL CLASS
  1. ;;DISABILITY INCOME INSURANCE
  1. ;;INDEMNITY
  1. ;;SUBSTANCE ABUSE ONLY
  1. ;----------------------------------
  1. OKFRESH(INREC,FRESHDAY,MFRESHDAY,MFLG) ; Identify those policies to exclude when
  1. ; verified within the "freshness days" for Medicare and non-Medicare policies.
  1. ; INPUT:
  1. ; INREC - IEN to current Insurance Plan
  1. ; FRESHDAY - Freshness Days Span
  1. ; MFRESHDAY - Medicare Freshness Days Span
  1. ; MFLG - Used to determine if the insurance plan is a Medicare Plan - 1=MEDICARE, 0=non-MEDICARE
  1. ; OUTPUT:
  1. ; OK = 0 - Exclude Policy
  1. ; = 1 - Include Policy
  1. N GIEN,IIEN,OK,VDATE
  1. S MFLG=0,OK=1,VDATE=$P($G(PTINS(INREC,1)),U,3)
  1. S IIEN=$P($G(PTINS(INREC,0)),U,1) ; Insurance ien
  1. ; Is the Insurance company PAYER (#36,3.1) the same as MEDICARE PAYER (#350.9,51.25)
  1. I $$GET1^DIQ(36,IIEN_",",3.1)=$$GET1^DIQ(350.9,"1,",51.25) S MFLG=1 ;Medicare Part A and Part B Policies
  1. ; Determine if Type of Plan (#355.3,.09) for the Group Plan is MEDICARE ADVANTAGE
  1. I 'MFLG D
  1. . S GIEN=+$P($G(PTINS(INREC,0)),U,18) ; Group Plan ien
  1. . I GIEN,$$GET1^DIQ(355.3,GIEN_",",.09)="MEDICARE ADVANTAGE" S MFLG=1 ;Medicare Part C
  1. I $$GET1^DIQ(36,IIEN_",",.01)="MEDICARE PART D (WNR)" S MFLG=1 ;Medicare Part D (WNR)
  1. ;
  1. I VDATE'="",'MFLG,SRVICEDT'>$$FMADD^XLFDT(VDATE,FRESHDAY) S OK=0 ;Non-Medicare Policy outside of Freshness Day span
  1. I VDATE'="",MFLG,SRVICEDT'>$$FMADD^XLFDT(VDATE,MFRESHDAY) S OK=0 ;Medicare Policy outside of Medicare Freshness Day span
  1. Q OK
  1. ;----------------------------------
  1. SET(SID,INR,PATID) ; Set data in TQ and send to FSC
  1. ;
  1. N DATA1,DATA2,DATA5,ORIG
  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. ; 10/2023: FRESHDT is no longer being included in DATA1
  1. S DATA1=DFN_U_PIEN_U_1_U_""_U_SID ; SETTQ 1st parameter
  1. S $P(DATA1,U,8)=PATID
  1. ;
  1. ; The hardcoded '2' in the 1st piece of DATA2 is the value to tell
  1. ; the file 365.1 that it is the appointment extract.
  1. S DATA2=2_U_QURYFLAG_U_SRVICEDT_U_INR ; SETTQ 2nd parameter
  1. ;
  1. S ORIG=U_$S(GRPNUM=" ":"",1:GRPNUM)_U_$S(GRPNAM=" ":"",1:GRPNAM)
  1. ;
  1. S DATA5=$$FIND1^DIC(355.12,,,"eIV","C") ; Set to IEN of "eIV" Source of Information
  1. ;
  1. S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,ORIG,,DATA5) ; Sets entry into the TQ
  1. ; Send entry to FSC
  1. I TQIEN I CNT'>MAXCNT D XMIT1^IBCNEDEP(TQIEN) S CNT=CNT+1 ; Increment the counter of entries sent to FSC
  1. Q
  1. ;----------------------------------
  1. ERRMSG ; Send a message indicating an extract error has occurred
  1. N MGRP,XMSUB,MSG,IBX,IBM
  1. ;
  1. ; Set to IB site parameter MAILGROUP
  1. S MGRP=$$MGRP^IBCNEUT5()
  1. ;
  1. S XMSUB="eIV Problem: Appointment Extract"
  1. S MSG(1)="On "_$$FMTE^XLFDT(DT)_" the Appointment Extract for eIV encountered one or more"
  1. S MSG(2)="errors while attempting to get Appointment data from the scheduling"
  1. S MSG(3)="package."
  1. S MSG(4)=""
  1. S MSG(5)="Error(s) encountered: "
  1. S MSG(6)=""
  1. S MSG(7)=" Error Code Error Message"
  1. S MSG(8)=" ---------- -------------"
  1. S IBM=8,IBX=0 F S IBX=$O(^TMP($J,"SDAMA301",IBX)) Q:IBX="" S IBM=IBM+1,MSG(IBM)=" "_$$LJ^XLFSTR(IBX,13)_$G(^TMP($J,"SDAMA301",IBX))
  1. S IBM=IBM+1,MSG(IBM)=""
  1. S IBM=IBM+1,MSG(IBM)="As a result of this error the extract was not done. The extract"
  1. S IBM=IBM+1,MSG(IBM)="will be attempted again the next night automatically. If you"
  1. S IBM=IBM+1,MSG(IBM)="continue to receive error messages you should contact your IRM"
  1. S IBM=IBM+1,MSG(IBM)="and possibly call the Help Desk for assistance."
  1. ;
  1. D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
  1. Q