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