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

IBCNERPL.m

Go to the documentation of this file. 
  1. IBCNERPL ;IB/BAA/AWC - IBCN HL7 RESPONSE REPORT PRINT;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 IBCNERPJ and IBCNERPK:
  1.  ; IB*763/TAZ - Change IBCNERTN comment to reference proper routine.
  1.  ;   IBCNERTN = "IBCNERPJ"
  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.  ;   IBCNESPJ("PAT",ien) = patient iens for report, if IBCNESPJ("PAT")="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,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 CRT,DDATA,DLINE,EORMSG,IBD,IBPGC,IBPXT,MAXCNT,NONEMSG,NPROC,SSN,SSNLEN,SRT1,SRT2,TSTAMP
  1.  N TYPE,VDATE,WIDTH,X,Y,SENT,RECVD,STATION,DEFSTAT,DASHES,HD1,HD2,HD3
  1.  N DEFINST,HDR1,LOUT,N,SITE,VISN
  1.  S DEFINST=$P($G(^XTV(8989.3,1,"XUS")),U,17)
  1.  S STATION=$P($G(^DIC(4,DEFINST,99)),U)
  1.  I STATION="" S STATION=DEFINST
  1.  S VISN=$$VISN^IBATUTL(STATION)
  1.  S SITE=$$SITE^VASITE,SITE=$P(SITE,U,2)_" : "_$P(SITE,U,3)
  1.  S (IBPGC,IBPXT)=0
  1.  S NONEMSG="* * * N O  D A T A  F O U N D * * *"
  1.  S EORMSG="*** END OF REPORT ***"
  1.  S NPROC="Not Processed"
  1.  S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
  1.  S TYPE=$G(INCNESPJ("TYPE")) ; report type
  1.  ;
  1.  N IBPWIDTH S IBPWIDTH=$G(INCNESPJ("WIDTH")) S:IBPWIDTH="" IBPWIDTH=$S(TYPE="E":256,1:132)  ;IB*737/DTG get correct R margin
  1.  ;
  1.  S WIDTH=$S(TYPE="E":200,1:132)
  1.  S $P(DASHES,"-",WIDTH)=""
  1.  S HDR1=$$FMTE^XLFDT($G(INCNESPJ("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($G(INCNESPJ("ENDDT")),"5Z")
  1.  ; Determine IO parameters
  1.  S MAXCNT=IOSL-6,CRT=0
  1.  S:IOST["C-" MAXCNT=IOSL-3,CRT=1
  1.  ; print data
  1.  S SRT1=""
  1.  ; IB*737/DTG separate excel from report
  1.  ;D HEADER I $G(ZTSTOP)!IBPXT Q
  1.  ; If global does not exist - display No Data message
  1.  ;I '$D(^TMP($J,IBCNERTN)) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) G EXIT
  1.  ;
  1.  ;I TYPE="E" D  Q:$G(ZTSTOP)!IBPXT
  1.  I TYPE="E" D  Q:$G(ZTSTOP)!IBPXT  D LINE(EORMSG) I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL Q
  1.  . I '$D(ZTQUEUED),$G(IOST)["C-" W !
  1.  . D EHDR
  1.  . I '$D(^TMP($J,IBCNERTN)) D LINE(NONEMSG) Q
  1.  .; excel format
  1.  .F  S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1=""  D  Q:$G(ZTSTOP)!IBPXT
  1.  ..; D LINE("PYRNAME : "_SRT1)
  1.  ..S SRT2="" F  S SRT2=$O(^TMP($J,IBCNERTN,SRT1,SRT2)) Q:SRT2=""  D  Q:$G(ZTSTOP)!IBPXT
  1.  ...S N=0 F  S N=$O(^TMP($J,IBCNERTN,SRT1,SRT2,N)) Q:N=""  D  Q:$G(ZTSTOP)!IBPXT
  1.  ....S LOUT=^TMP($J,IBCNERTN,SRT1,SRT2,N)
  1.  ....;IB*737/DTG add 4 digit year and mm/dd
  1.  ....;S SENT=$$FMTE^XLFDT($P(LOUT,U,4),1),$P(LOUT,U,4)=SENT
  1.  ....;S RECVD=$$FMTE^XLFDT($P(LOUT,U,5),1),$P(LOUT,U,5)=RECVD
  1.  ....S SENT=$$FMTE^XLFDT($P(LOUT,U,4),5),$P(LOUT,U,4)=SENT
  1.  ....S RECVD=$$FMTE^XLFDT($P(LOUT,U,5),5),$P(LOUT,U,5)=RECVD
  1.  ....D LINE(LOUT)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;I TYPE="R" D  Q:$G(ZTSTOP)!IBPXT
  1.  I TYPE="R" D  Q:$G(ZTSTOP)!IBPXT  D EXIT ; IB*737/DTG print end of report
  1.  . D HEADER I $G(ZTSTOP)!IBPXT Q  ; IB*737/DTG separate header from excel
  1.  . I '$D(^TMP($J,IBCNERTN)) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) Q  ; IB*737/DTG seperate center of msg from excel
  1.  .; report format
  1.  .; IB*737/DTG correct quit on '^'
  1.  .;F  S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1=""!$G(ZTSTOP)!IBPXT  D
  1.  .F  S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1=""  D  Q:$G(ZTSTOP)!IBPXT
  1.  ..D LINE($$FO^IBCNEUT1($S(SRT1=0:NPROC,1:SRT1),85)_"Count = "_^TMP($J,IBCNERTN,SRT1)) Q:$G(ZTSTOP)!IBPXT
  1.  ..S SRT2="" F  S SRT2=$O(^TMP($J,IBCNERTN,SRT1,SRT2)) Q:SRT2=""  D  Q:$G(ZTSTOP)!IBPXT
  1.  ...S N=0 F  S N=$O(^TMP($J,IBCNERTN,SRT1,SRT2,N)) Q:N=""  D PRINT Q:$G(ZTSTOP)!IBPXT
  1.  Q
  1.  ;
  1. PRINT ; Get Print Info
  1.  ; ?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
  1.  S DDATA=$G(^TMP($J,IBCNERTN,SRT1,SRT2,N)),DLINE=""
  1.  ; IB*737/DTG truncate payer to 22, patient 21
  1.  ;S $E(DLINE,3,24)=$P(DDATA,U)  ;PAYER
  1.  S $E(DLINE,3,25)=$E($P(DDATA,U),1,23)  ;PAYER
  1.  ;S $E(DLINE,27,47)=$P(DDATA,U,2)  ;PATIENT
  1.  S $E(DLINE,27,47)=$E($P(DDATA,U,2),1,22)  ;PATIENT
  1.  S $E(DLINE,50,53)=$P(DDATA,U,3)  ;SSN
  1.  ;IB*737/DTG remove seconds add 4 digit year
  1.  ;S $E(DLINE,56,73)=$$FMTE^XLFDT($P(DDATA,U,4),2)  ;SENT
  1.  ;S $E(DLINE,76,93)=$$FMTE^XLFDT($P(DDATA,U,5),2)  ;RECEIVED
  1.  S IBD=$$FMTE^XLFDT($P(DDATA,U,4),5),IBD=$P(IBD,":",1,2),$E(DLINE,56,73)=IBD  ;SENT
  1.  S IBD=$$FMTE^XLFDT($P(DDATA,U,5),5),IBD=$P(IBD,":",1,2),$E(DLINE,76,93)=IBD  ;RECEIVED
  1.  S $E(DLINE,96,112)=$P(DDATA,U,6)  ;TRACE #
  1.  S $E(DLINE,115,132)=$P(DDATA,U,7)  ;BUFFER #
  1.  D LINE(DLINE)
  1.  Q
  1.  ;
  1. EXIT ;
  1.  D LINE($$FO^IBCNEUT1(EORMSG,$$CENTER(EORMSG),"R"))
  1.  I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
  1.  Q
  1.  ;
  1. EOL ; display "end of page" message and set exit flag
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
  1.  I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  I $D(DTOUT)!$D(DUOUT) S IBPXT=1
  1.  Q
  1.  ;
  1. EHDR ; print header for excel
  1.  ; IB*737/DTG new tag, header for excel only
  1.  ;
  1.  S IBPGC=IBPGC+1
  1.  W "HL7 Response Report"_U_TSTAMP,!
  1.  W ?1,HDR1,!,!
  1.  W ?1,$S($G(INCNESPJ("PYR"))="A":"All",1:"Selected")_" Payers",!
  1.  W "Payer Name"_U_"Patient Name"_U_"SSN"_U_"Dt Sent"_U_"Dt Rec'd"_U_"Trace #"_U_"Buffer #"
  1.  Q
  1.  ;
  1.  N HDR,OFFSET,SRT
  1.  ;
  1.  I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL I IBPXT Q
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 Q
  1.  S IBPGC=IBPGC+1
  1.  W @IOF,!,?1,"HL7 Response Report"
  1.  ; IB*737/DTG start manage right margin
  1.  ;S HDR=TSTAMP_"  Page: "_IBPGC,OFFSET=(WIDTH-$L(HDR))
  1.  S HDR=TSTAMP_"  Page: "_IBPGC
  1.  S OFFSET=(IBPWIDTH-$L(HDR))
  1.  W ?OFFSET,HDR
  1.  W !,?1,HDR1,!,!
  1.  W ?1,$S($G(INCNESPJ("PYR"))="A":"All",1:"Selected")_" Payers"
  1.  ;
  1.  ;I TYPE="R" W !,?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
  1.  W !,?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
  1.  W !,?1,DASHES
  1.  Q
  1.  ;
  1. LINE(LINE) ; Print line of data
  1.  ; IB*737/DTG handle Excel Header different than report
  1.  ; I $Y+1>MAXCNT D HEADER I $G(ZTSTOP)!IBPXT Q
  1.  I ($Y+1)#MAXCNT=0 D  I $G(ZTSTOP)!IBPXT Q
  1.  . I TYPE="R" D HEADER
  1.  . I TYPE="E",(CRT),(IBPGC>0),('$D(ZTQUEUED)) D EOL
  1.  W !,?1,LINE
  1.  Q
  1.  ;
  1. CENTER(LINE) ; return length of a centered line
  1.  ; LINE - line to center
  1.  N LENGTH,OFFSET
  1.  ; IB*737/DTG correct center based on report width base
  1.  ;S LENGTH=$L(LINE),OFFSET=IOM-$L(LINE)\2
  1.  S LENGTH=$L(LINE)
  1.  S OFFSET=(IBPWIDTH-LENGTH)\2
  1.  Q OFFSET+LENGTH