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

IBCNERPK.m

Go to the documentation of this file. 
  1. IBCNERPK ;IB/BAA/AWC - IBCN HL7 RESPONSE REPORT COMPILE;25 Feb 2015
  1.  ;;2.0;INTEGRATED BILLING;**528,737,763**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; variables from IBCNERPL:
  1.  ; IB*763/TAZ - Change IBCNERTN comment to reference proper routine.
  1.  ;   IBCNERTN = "IBCNERPJ" (current routine name for queueing the 
  1.  ;                          COMPILE process)
  1.  ;   INCNESPJ("BEGDT") = start date for date range
  1.  ;   INCNESPJ("ENDDT") = end date for date range
  1.  ;   INCNESPJ("PYR",ien) = payer iens for report, if INCNESPJ("PYR")="A", then include all
  1.  ;   INCNESPJ("TYPE") = report type: "R" - Report, "E" - Excel
  1.  ;
  1.  ; Output :
  1.  ;
  1.  ;   Detailed report:
  1.  ;     ^TMP($J,IBCNERTN,Payer Name)=Count 
  1.  ;     ^TMP($J,IBCNERTN,Payer Name,Patient Name,N)=Payer Name ^ Patient Name ^ Date sent  
  1.  ;                      ^ Date Received ^ Trace number ^ Buffer Number
  1.  ;
  1.  Q
  1.  ;
  1. EN(IBCNERTN,INCNESPJ) ; Entry point
  1.  N ALLPYR,ALLPAT,DATE,BDATE,EDATE,RPDATA,RTYPE,SORT,BUSER,CRBUF,TRACE
  1.  S BUSER=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
  1.  S ALLPYR=$S($G(INCNESPJ("PYR"))="A":1,1:0)
  1.  S ALLPAT=$S($G(INCNESPJ("PAT"))="A":1,1:0)
  1.  S BDATE=$G(INCNESPJ("BEGDT"))
  1.  S EDATE=$G(INCNESPJ("ENDDT"))
  1.  I EDATE'="",$P(EDATE,".",2)="" S EDATE=$$FMADD^XLFDT(EDATE,0,23,59,59)
  1.  S RTYPE=$G(INCNESPJ("TYPE"))
  1.  I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
  1.  ; Kill scratch global
  1.  S DATE=$O(^IBCN(365,"AD",BDATE),-1)
  1.  F  S DATE=$O(^IBCN(365,"AD",DATE)) Q:'DATE!(DATE>EDATE)  D PAYERS(DATE,ALLPYR)
  1.  D EN^IBCNERPL(IBCNERTN,.INCNESPJ)
  1.  ;
  1.  I $D(ZTQUEUED) K ^TMP($J,IBCNERTN)  ;IB*737/DTG clear tmp file if queued report
  1.  Q
  1.  ;
  1. PAYERS(DATE,ALLPYR) ; loop through payers
  1.  N PYR
  1.  S PYR=0
  1.  I 'ALLPYR F  S PYR=$O(INCNESPJ("PYR",PYR)) Q:'PYR  D:$O(^IBCN(365,"AD",DATE,PYR,"")) PATIENTS(DATE,PYR,ALLPAT)
  1.  I ALLPYR F  S PYR=$O(^IBCN(365,"AD",DATE,PYR)) Q:'PYR  D PATIENTS(DATE,PYR,ALLPAT)
  1.  Q
  1.  ;
  1. PATIENTS(DATE,PYR,ALLPAT) ; loop through patients
  1.  N PAT
  1.  S PAT=0
  1.  I 'ALLPAT F  S PAT=$O(INCNESPJ("PAT",PAT)) Q:'PAT  D:$O(^IBCN(365,"AD",DATE,PYR,PAT,"")) GETDATA(DATE,PYR,PAT)
  1.  I ALLPAT F  S PAT=$O(^IBCN(365,"AD",DATE,PYR,PAT)) Q:'PAT  D GETDATA(DATE,PYR,PAT)
  1.  Q
  1.  ;
  1. GETDATA(DATE,PYR,PAT) ; loop through responses and compile report
  1.  N RDATE,SDATE,IENS2,INS,NOW,PATNAME,PYRNAME,RIEN,BUFFER,SSN,TOTMES,TQ,VDATE,CNT
  1.  ;
  1.  S NOW=$$NOW^XLFDT
  1.  S RIEN="",CNT=0
  1.  F  S RIEN=$O(^IBCN(365,"AD",DATE,PYR,PAT,RIEN)) Q:'RIEN  D
  1.  .;S BUFFER=$P(^IBCN(365,RIEN,0),U,4)
  1.  .S BUFFER=$P($G(^IBCN(365,RIEN,0)),U,4)  ; IB*737/DTG prevent undefined error from invalid index entry
  1.  .I BUFFER="" Q
  1.  .S CRBUF=$P($G(^IBA(355.33,BUFFER,0)),U,2)
  1.  .;I CRBUF'=BUSER Q
  1.  .S IENS2=PAT_","
  1.  .S RDATE=$P(^IBCN(365,RIEN,0),U,7) I RDATE=""!(RDATE<BDATE)!(RDATE>EDATE) Q
  1.  .S SDATE=$P(^IBCN(365,RIEN,0),U,8),TRACE=$P(^IBCN(365,RIEN,0),U,9)
  1.  .S PYRNAME=$P(^IBE(365.12,PYR,0),U),PATNAME=$$GET1^DIQ(2,IENS2,.01,"E")
  1.  .S SSN=$$GET1^DIQ(2,IENS2,.09,"I"),SSN=$E(SSN,6,9)
  1.  . ;IB*737/DTG correction of count, item display and re-ordered actions
  1.  .;S CNT=CNT+1
  1.  .S ^TMP($J,IBCNERTN,PYRNAME)=$G(^TMP($J,IBCNERTN,PYRNAME))+1
  1.  .S ^TMP($J,IBCNERTN)=$G(^TMP($J,IBCNERTN))+1
  1.  .S CNT=$G(^TMP($J,IBCNERTN,PYRNAME))
  1.  .S ^TMP($J,IBCNERTN,PYRNAME,PATNAME,CNT)=PYRNAME_U_PATNAME_U_SSN_U_SDATE_U_RDATE_U_TRACE_U_BUFFER
  1.  .Q
  1.  Q