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

IBCNERP2.m

Go to the documentation of this file. 
  1. IBCNERP2 ;DAOU/BHS - IBCNE eIV RESPONSE REPORT COMPILE ; 03-JUN-2002
  1.  ;;2.0;INTEGRATED BILLING;**184,271,416,528,659,702**;21-MAR-94;Build 53
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Input vars from IBCNERP1:
  1.  ;  IBCNERTN="IBCNERP1"
  1.  ;  IBCNESPC("BEGDT")=Start Dt for rpt
  1.  ;  IBCNESPC("ENDDT")=End Dt for rpt
  1.  ;  IBCNESPC("PYR")=Pyr IEN for rpt. If "", then show all.
  1.  ;  IBCNESPC("PAT")=Pt IEN for rpt. If "", then show all.
  1.  ;  IBCNESPC("TYPE")=A (All Responses) for date range OR M (Most Recent
  1.  ;   Responses) for date range (by unique Pyr/Pt pair)
  1.  ;  IBCNESPC("SORT")=1 (Pyr nm) OR 2 (Pt nm)
  1.  ;  IBCNESPC("TRCN")=Trace #^IEN, if non-null, all other params are null
  1.  ;  IBCNESPC("RFLAG")=Report Flag used to indicate which report is being
  1.  ;   run.  Response Report (0), Inactive Report (1), or Ambiguous
  1.  ;   Report (2).
  1.  ;  IBCNESPC("DTEXP")=Expiration date used in the inactive policy report
  1.  ;  IBOUT="R" for Report format or "E" for Excel format
  1.  ;
  1.  ; Output vars used by IBCNERP3:
  1.  ;  Structure of ^TMP based on eIV Response File (#365)
  1.  ;   IBCNERTN="IBCNERP1"
  1.  ;   SORT1=PyrNm (SORT=1) or PtNm(SORT=2)
  1.  ;   SORT2=PtNm (SORT=1) or PyrNm (SORT=2)
  1.  ;  ^TMP($J,IBCNERTN,SORT1,SORT2,CNT,0/1) based on ^IBCN(365,DA,0/1)
  1.  ;   CNT=Seq ct
  1.  ;  ^TMP($J,IBCNERTN,SORT1,SORT2,2,EBCT) based on ^IBCN(365,DA,2,EBCT,0)
  1.  ;   EBCT = Elig/Benefit multiple field IEN (ptr to 365.02)
  1.  ;  ^TMP($J,IBCNERTN,SORT1,SORT2,2,EBCT,NTCT) based on
  1.  ;   ^IBCN(365,DA,2,EB,0,NT,0) Notes for EB seg
  1.  ;   NTCT = Notes Ct may not equal Notes IEN (365.22) if ln must wrap
  1.  ;  ^TMP($J,IBCNERTN,SORT1,SORT2,3,CNCT) based on ^IBCN(365,DA,3,CNCT,0)
  1.  ;   CNCT = Contact Person multiple field IEN (ptr to 365.03)
  1.  ;  ^TMP($J,IBCNERTN,SORT1,SORT2,4,CT) based on ^IBCN(365,DA,4)
  1.  ;    CT=1 if len of text <=70, else ln is split
  1.  ;  ^TMP($J,IBCNERTN,SORT1,SORT2,5,CT) based on # lns of comments reqd
  1.  ;    CT=1 to display future retransmission date
  1.  ;
  1.  ; Must call at EN
  1.  Q
  1.  ;
  1.  ;
  1. EN(IBCNERTN,IBCNESPC,IBOUT) ; Entry
  1.  ; Init
  1.  N IBDT,IBBDT,IBPY,IBPYR,IBPT
  1.  N IBPAT,IBPTR,SORT1,SORT2,RPTDATA,IBTOT
  1.  N PYRIEN,PATIEN,IBTRC,IBTYP,IBCT,IBSRT,IBEXP,FRST,TQN,DONTINC,IPRF
  1.  ;
  1.  I '$D(ZTQUEUED),$G(IOST)["C-",$G(IBOUT)="R" W !!,"Compiling report data ..."
  1.  ;
  1.  ; Temp ct
  1.  S (IBTOT,IBCT)=0
  1.  ;
  1.  ; Kill scratch globals
  1.  K ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X")
  1.  ;
  1.  S IBTRC=$G(IBCNESPC("TRCN"))
  1.  ; Skip for TRACE#
  1.  I IBTRC'="" G TRCN
  1.  ;
  1.  S IBBDT=IBCNESPC("BEGDT")
  1.  S IBPY=$G(IBCNESPC("PYR"))
  1.  S IBPT=$G(IBCNESPC("PAT"))
  1.  S IBTYP=$G(IBCNESPC("TYPE"))
  1.  S IBSRT=$G(IBCNESPC("SORT"))
  1.  S IBEXP=$G(IBCNESPC("DTEXP"))
  1.  S IPRF=$G(IBCNESPC("RFLAG"))
  1.  ;
  1.  ; Loop thru the eIV Response File (#365) by Date/Time Response Rec X-Ref
  1.  ; S IBDT=$O(^IBCN(365,"AD",IBCNESPC("ENDDT")))
  1.  ; Initialize IBDT to end date 
  1.  S IBDT=IBCNESPC("ENDDT")_".999999"
  1.  F  S IBDT=$O(^IBCN(365,"AD",IBDT),-1) Q:IBDT=""!($P(IBDT,".",1)<IBBDT)  D  Q:$G(ZTSTOP)
  1.  . S PYRIEN=$S(IBPY="":0,1:$O(^IBCN(365,"AD",IBDT,IBPY),-1))
  1.  . F  S PYRIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN)) Q:'PYRIEN!((IBPY'="")&(PYRIEN'=IBPY))  D  Q:$G(ZTSTOP)
  1.  .. I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 Q
  1.  .. ; Pyr nm from Pyr File (#365.12)
  1.  .. S IBPYR=$P($G(^IBE(365.12,PYRIEN,0)),U)
  1.  .. I IBPYR="" Q
  1.  .. S PATIEN=$S(IBPT="":0,1:$O(^IBCN(365,"AD",IBDT,PYRIEN,IBPT),-1))
  1.  .. F  S PATIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN)) Q:'PATIEN!((IBPT'="")&(PATIEN'=IBPT))  D  Q:$G(ZTSTOP)
  1.  ... ; Pt nm from Pt File (#2)
  1.  ... S IBPAT=$P($G(^DPT(PATIEN,0)),U)
  1.  ... I IBPAT="" Q
  1.  ... S IBPTR=0
  1.  ... F  S IBPTR=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN,IBPTR)) Q:'IBPTR  D  Q:$G(ZTSTOP)
  1.  .... S IBTOT=IBTOT+1
  1.  .... ; Since non-positive identifications are no longer placed in the 
  1.  .... ; insurance buffer, two new reports were added to allow users to
  1.  .... ; view the responses.  One report (IPFR=1) shows only responses
  1.  .... ; of inactive policies.  The other (IPFR=2) shows ambiguous responses.
  1.  .... ; Any response that is not active nor inactive is considered 
  1.  .... ; ambiguous for the purposes of this report.
  1.  .... I IPRF D  Q:DONTINC
  1.  ..... N EBIC,NODE1,PCD
  1.  ..... S DONTINC=1
  1.  ..... S TQN=$P($G(^IBCN(365,IBPTR,0)),U,5) Q:TQN=""  ; TQ ien (#365.1)
  1.  ..... S NODE1=$G(^IBCN(365,IBPTR,1))
  1.  ..... ; IB*702/DTG start only accept verified and remove policy exp date
  1.  ..... ;I $P($G(^IBCN(365.1,TQN,0)),U,11)="V" Q     ; If verification quit
  1.  ..... I $P($G(^IBCN(365.1,TQN,0)),U,11)'="V" Q
  1.  ..... ; I IPRF=1,($P(NODE1,U,12)="")!($P(NODE1,U,12)<$G(IBEXP)) Q
  1.  ..... ; IB*702/DTG end only accept verified and remove policy exp date
  1.  ..... S FRST=$O(^IBCN(365,IBPTR,2,0))
  1.  ..... I FRST="" Q
  1.  ..... S PCD=$P($G(^IBCN(365,IBPTR,2,FRST,0)),U,6)
  1.  ..... I PCD]"",PCD'="eIV Eligibility Determination" Q
  1.  ..... S EBIC=$$GET1^DIQ(365.02,FRST_","_IBPTR_",","ELIGIBILITY/BENEFIT INFO:CODE")
  1.  ..... I PCD]"",IPRF=1,EBIC'=6 Q
  1.  ..... ; IB*702/DTG start ambiguous
  1.  ..... ;I PCD]"",IPRF=2,EBIC=6!(EBIC=1) Q
  1.  ..... I PCD]"",IPRF=2,EBIC'="V" Q
  1.  ..... ; IB*702/DTG end ambiguous
  1.  ..... I $P(NODE1,U,14)]"" Q  ; Error Condition
  1.  ..... I $P(NODE1,U,15)]"" Q  ; Error Action
  1.  ..... I $P($G(^IBCN(365,IBPTR,4)),U)]"" Q  ; Error Text
  1.  ..... S DONTINC=0
  1.  ....;
  1.  .... I $D(ZTQUEUED),IBTOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
  1.  .... ; Sort fields
  1.  .... S SORT1=$S(IBSRT=1:IBPYR,1:IBPAT)
  1.  .... S SORT2=$S(IBSRT=1:IBPAT,1:IBPYR)
  1.  .... ; Only check for Most Recent - Pyr/Pt pair
  1.  .... I IBTYP="M",$D(^TMP($J,IBCNERTN_"X",PYRIEN,PATIEN)) Q
  1.  .... ; Set temp ind.
  1.  .... I IBTYP="M" S ^TMP($J,IBCNERTN_"X",PYRIEN,PATIEN)=""
  1.  .... ; Update ct
  1.  .... S IBCT=IBCT+1
  1.  .... ; Sort data - build RPTDATA array
  1.  .... K RPTDATA
  1.  .... D GETDATA^IBCNERPE(IBPTR,.RPTDATA)
  1.  .... ; Merge data from RPTDATA to ^TMP
  1.  .... M ^TMP($J,IBCNERTN,SORT1,SORT2,IBCT)=RPTDATA
  1.  .... ;IB*2.0*659/TAZ - Store Response File IEN for later use
  1.  .... S ^TMP($J,IBCNERTN,SORT1,SORT2,IBCT,"RSPIENS")=IBPTR
  1.  ;
  1.  ; Purge index of duplicate Pyr/Pt combos
  1.  K ^TMP($J,IBCNERTN_"X")
  1.  ;
  1.  G EXIT
  1.  ;
  1. TRCN ; Trace # proc.
  1.  S IBPTR=$P(IBTRC,U,2)
  1.  I IBPTR="" G EXIT
  1.  ; Sort the data - build RPTDATA array
  1.  KILL RPTDATA
  1.  D GETDATA^IBCNERPE(IBPTR,.RPTDATA)
  1.  ; Default sort - one record
  1.  ; Pyr nm from Pyr File (#365.12)
  1.  S PYRIEN=$P(RPTDATA(0),U,3)
  1.  I PYRIEN="" G EXIT
  1.  S SORT1=$P($G(^IBE(365.12,PYRIEN,0)),U,1)
  1.  I SORT1="" G EXIT
  1.  ; Pt nm from Pt File (#2)
  1.  S PATIEN=$P(RPTDATA(0),U,2)
  1.  I PATIEN="" G EXIT
  1.  S SORT2=$P($G(^DPT(PATIEN,0)),U,1)
  1.  I SORT2="" G EXIT
  1.  ; Merge data- RPTDATA to ^TMP
  1.  M ^TMP($J,IBCNERTN,SORT1,SORT2,1)=RPTDATA
  1.  ;IB*2.0*659/TAZ - Store Response File IEN for later use
  1.  S ^TMP($J,IBCNERTN,SORT1,SORT2,1,"RSPIENS")=IBPTR
  1.  ;
  1. EXIT ;
  1.  Q
  1.  ;
  1. X12(FILE,CODE,FLD) ; Output based on File # and X12 code
  1.  I $G(FILE)=""!($G(CODE)="") Q ""
  1.  ; Quit w/o label if not defined in File Def.
  1.  Q $$LBL(365.02,$G(FLD))_$P($G(^IBE(FILE,CODE,0)),U,2)  ;
  1. LBL(FILE,FLD) ; Determine label from File Def.
  1.  N IBLBL
  1.  ;
  1.  I $G(FILE)=""!($G(FLD)="") Q ""
  1.  S IBLBL=$$GET1^DID(FILE,FLD,"","TITLE")
  1.  Q $S(IBLBL'="":IBLBL_": ",1:"")
  1.  ;