IBCNERPL ;IB/BAA/AWC - IBCN HL7 RESPONSE REPORT PRINT;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 IBCNERPJ and IBCNERPK:
; IB*763/TAZ - Change IBCNERTN comment to reference proper routine.
; IBCNERTN = "IBCNERPJ"
; 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
; IBCNESPJ("PAT",ien) = patient iens for report, if IBCNESPJ("PAT")="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,N)=Payer Name ^ Patient Name ^ Date sent
; ^ Date Received ^ Trace number ^ Buffer Number
;
Q
;
EN(IBCNERTN,INCNESPJ) ; Entry point
N CRT,DDATA,DLINE,EORMSG,IBD,IBPGC,IBPXT,MAXCNT,NONEMSG,NPROC,SSN,SSNLEN,SRT1,SRT2,TSTAMP
N TYPE,VDATE,WIDTH,X,Y,SENT,RECVD,STATION,DEFSTAT,DASHES,HD1,HD2,HD3
N DEFINST,HDR1,LOUT,N,SITE,VISN
S DEFINST=$P($G(^XTV(8989.3,1,"XUS")),U,17)
S STATION=$P($G(^DIC(4,DEFINST,99)),U)
I STATION="" S STATION=DEFINST
S VISN=$$VISN^IBATUTL(STATION)
S SITE=$$SITE^VASITE,SITE=$P(SITE,U,2)_" : "_$P(SITE,U,3)
S (IBPGC,IBPXT)=0
S NONEMSG="* * * N O D A T A F O U N D * * *"
S EORMSG="*** END OF REPORT ***"
S NPROC="Not Processed"
S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
S TYPE=$G(INCNESPJ("TYPE")) ; report type
;
N IBPWIDTH S IBPWIDTH=$G(INCNESPJ("WIDTH")) S:IBPWIDTH="" IBPWIDTH=$S(TYPE="E":256,1:132) ;IB*737/DTG get correct R margin
;
S WIDTH=$S(TYPE="E":200,1:132)
S $P(DASHES,"-",WIDTH)=""
S HDR1=$$FMTE^XLFDT($G(INCNESPJ("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($G(INCNESPJ("ENDDT")),"5Z")
; Determine IO parameters
S MAXCNT=IOSL-6,CRT=0
S:IOST["C-" MAXCNT=IOSL-3,CRT=1
; print data
S SRT1=""
; IB*737/DTG separate excel from report
;D HEADER I $G(ZTSTOP)!IBPXT Q
; If global does not exist - display No Data message
;I '$D(^TMP($J,IBCNERTN)) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) G EXIT
;
;I TYPE="E" D Q:$G(ZTSTOP)!IBPXT
I TYPE="E" D Q:$G(ZTSTOP)!IBPXT D LINE(EORMSG) I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL Q
. I '$D(ZTQUEUED),$G(IOST)["C-" W !
. D EHDR
. I '$D(^TMP($J,IBCNERTN)) D LINE(NONEMSG) Q
.; excel format
.F S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1="" D Q:$G(ZTSTOP)!IBPXT
..; D LINE("PYRNAME : "_SRT1)
..S SRT2="" F S SRT2=$O(^TMP($J,IBCNERTN,SRT1,SRT2)) Q:SRT2="" D Q:$G(ZTSTOP)!IBPXT
...S N=0 F S N=$O(^TMP($J,IBCNERTN,SRT1,SRT2,N)) Q:N="" D Q:$G(ZTSTOP)!IBPXT
....S LOUT=^TMP($J,IBCNERTN,SRT1,SRT2,N)
....;IB*737/DTG add 4 digit year and mm/dd
....;S SENT=$$FMTE^XLFDT($P(LOUT,U,4),1),$P(LOUT,U,4)=SENT
....;S RECVD=$$FMTE^XLFDT($P(LOUT,U,5),1),$P(LOUT,U,5)=RECVD
....S SENT=$$FMTE^XLFDT($P(LOUT,U,4),5),$P(LOUT,U,4)=SENT
....S RECVD=$$FMTE^XLFDT($P(LOUT,U,5),5),$P(LOUT,U,5)=RECVD
....D LINE(LOUT)
...Q
..Q
.Q
;
;I TYPE="R" D Q:$G(ZTSTOP)!IBPXT
I TYPE="R" D Q:$G(ZTSTOP)!IBPXT D EXIT ; IB*737/DTG print end of report
. D HEADER I $G(ZTSTOP)!IBPXT Q ; IB*737/DTG separate header from excel
. I '$D(^TMP($J,IBCNERTN)) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) Q ; IB*737/DTG seperate center of msg from excel
.; report format
.; IB*737/DTG correct quit on '^'
.;F S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1=""!$G(ZTSTOP)!IBPXT D
.F S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1="" D Q:$G(ZTSTOP)!IBPXT
..D LINE($$FO^IBCNEUT1($S(SRT1=0:NPROC,1:SRT1),85)_"Count = "_^TMP($J,IBCNERTN,SRT1)) Q:$G(ZTSTOP)!IBPXT
..S SRT2="" F S SRT2=$O(^TMP($J,IBCNERTN,SRT1,SRT2)) Q:SRT2="" D Q:$G(ZTSTOP)!IBPXT
...S N=0 F S N=$O(^TMP($J,IBCNERTN,SRT1,SRT2,N)) Q:N="" D PRINT Q:$G(ZTSTOP)!IBPXT
Q
;
PRINT ; Get Print Info
; ?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
S DDATA=$G(^TMP($J,IBCNERTN,SRT1,SRT2,N)),DLINE=""
; IB*737/DTG truncate payer to 22, patient 21
;S $E(DLINE,3,24)=$P(DDATA,U) ;PAYER
S $E(DLINE,3,25)=$E($P(DDATA,U),1,23) ;PAYER
;S $E(DLINE,27,47)=$P(DDATA,U,2) ;PATIENT
S $E(DLINE,27,47)=$E($P(DDATA,U,2),1,22) ;PATIENT
S $E(DLINE,50,53)=$P(DDATA,U,3) ;SSN
;IB*737/DTG remove seconds add 4 digit year
;S $E(DLINE,56,73)=$$FMTE^XLFDT($P(DDATA,U,4),2) ;SENT
;S $E(DLINE,76,93)=$$FMTE^XLFDT($P(DDATA,U,5),2) ;RECEIVED
S IBD=$$FMTE^XLFDT($P(DDATA,U,4),5),IBD=$P(IBD,":",1,2),$E(DLINE,56,73)=IBD ;SENT
S IBD=$$FMTE^XLFDT($P(DDATA,U,5),5),IBD=$P(IBD,":",1,2),$E(DLINE,76,93)=IBD ;RECEIVED
S $E(DLINE,96,112)=$P(DDATA,U,6) ;TRACE #
S $E(DLINE,115,132)=$P(DDATA,U,7) ;BUFFER #
D LINE(DLINE)
Q
;
EXIT ;
D LINE($$FO^IBCNEUT1(EORMSG,$$CENTER(EORMSG),"R"))
I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
Q
;
EOL ; display "end of page" message and set exit flag
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
S DIR(0)="E" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S IBPXT=1
Q
;
EHDR ; print header for excel
; IB*737/DTG new tag, header for excel only
;
S IBPGC=IBPGC+1
W "HL7 Response Report"_U_TSTAMP,!
W ?1,HDR1,!,!
W ?1,$S($G(INCNESPJ("PYR"))="A":"All",1:"Selected")_" Payers",!
W "Payer Name"_U_"Patient Name"_U_"SSN"_U_"Dt Sent"_U_"Dt Rec'd"_U_"Trace #"_U_"Buffer #"
Q
;
N HDR,OFFSET,SRT
;
I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL I IBPXT Q
I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 Q
S IBPGC=IBPGC+1
W @IOF,!,?1,"HL7 Response Report"
; IB*737/DTG start manage right margin
;S HDR=TSTAMP_" Page: "_IBPGC,OFFSET=(WIDTH-$L(HDR))
S HDR=TSTAMP_" Page: "_IBPGC
S OFFSET=(IBPWIDTH-$L(HDR))
W ?OFFSET,HDR
W !,?1,HDR1,!,!
W ?1,$S($G(INCNESPJ("PYR"))="A":"All",1:"Selected")_" Payers"
;
;I TYPE="R" W !,?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
W !,?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
W !,?1,DASHES
Q
;
LINE(LINE) ; Print line of data
; IB*737/DTG handle Excel Header different than report
; I $Y+1>MAXCNT D HEADER I $G(ZTSTOP)!IBPXT Q
I ($Y+1)#MAXCNT=0 D I $G(ZTSTOP)!IBPXT Q
. I TYPE="R" D HEADER
. I TYPE="E",(CRT),(IBPGC>0),('$D(ZTQUEUED)) D EOL
W !,?1,LINE
Q
;
CENTER(LINE) ; return length of a centered line
; LINE - line to center
N LENGTH,OFFSET
; IB*737/DTG correct center based on report width base
;S LENGTH=$L(LINE),OFFSET=IOM-$L(LINE)\2
S LENGTH=$L(LINE)
S OFFSET=(IBPWIDTH-LENGTH)\2
Q OFFSET+LENGTH
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERPL 6754 printed Dec 13, 2024@02:15:17 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; variables from IBCNERPJ and IBCNERPK:
+5 ; IB*763/TAZ - Change IBCNERTN comment to reference proper routine.
+6 ; IBCNERTN = "IBCNERPJ"
+7 ; INCNESPJ("BEGDT") = start date for date range
+8 ; INCNESPJ("ENDDT") = end date for date range
+9 ; INCNESPJ("PYR",ien) = payer iens for report, if INCNESPJ("PYR")="A", then include all
+10 ; IBCNESPJ("PAT",ien) = patient iens for report, if IBCNESPJ("PAT")="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,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 CRT,DDATA,DLINE,EORMSG,IBD,IBPGC,IBPXT,MAXCNT,NONEMSG,NPROC,SSN,SSNLEN,SRT1,SRT2,TSTAMP
+2 NEW TYPE,VDATE,WIDTH,X,Y,SENT,RECVD,STATION,DEFSTAT,DASHES,HD1,HD2,HD3
+3 NEW DEFINST,HDR1,LOUT,N,SITE,VISN
+4 SET DEFINST=$PIECE($GET(^XTV(8989.3,1,"XUS")),U,17)
+5 SET STATION=$PIECE($GET(^DIC(4,DEFINST,99)),U)
+6 IF STATION=""
SET STATION=DEFINST
+7 SET VISN=$$VISN^IBATUTL(STATION)
+8 SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,U,2)_" : "_$PIECE(SITE,U,3)
+9 SET (IBPGC,IBPXT)=0
+10 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+11 SET EORMSG="*** END OF REPORT ***"
+12 SET NPROC="Not Processed"
+13 ; time of report
SET TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1)
+14 ; report type
SET TYPE=$GET(INCNESPJ("TYPE"))
+15 ;
+16 ;IB*737/DTG get correct R margin
NEW IBPWIDTH
SET IBPWIDTH=$GET(INCNESPJ("WIDTH"))
if IBPWIDTH=""
SET IBPWIDTH=$SELECT(TYPE="E":256,1:132)
+17 ;
+18 SET WIDTH=$SELECT(TYPE="E":200,1:132)
+19 SET $PIECE(DASHES,"-",WIDTH)=""
+20 SET HDR1=$$FMTE^XLFDT($GET(INCNESPJ("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($GET(INCNESPJ("ENDDT")),"5Z")
+21 ; Determine IO parameters
+22 SET MAXCNT=IOSL-6
SET CRT=0
+23 if IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
+24 ; print data
+25 SET SRT1=""
+26 ; IB*737/DTG separate excel from report
+27 ;D HEADER I $G(ZTSTOP)!IBPXT Q
+28 ; If global does not exist - display No Data message
+29 ;I '$D(^TMP($J,IBCNERTN)) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) G EXIT
+30 ;
+31 ;I TYPE="E" D Q:$G(ZTSTOP)!IBPXT
+32 IF TYPE="E"
Begin DoDot:1
+33 IF '$DATA(ZTQUEUED)
IF $GET(IOST)["C-"
WRITE !
+34 DO EHDR
+35 IF '$DATA(^TMP($JOB,IBCNERTN))
DO LINE(NONEMSG)
QUIT
+36 ; excel format
+37 FOR
SET SRT1=$ORDER(^TMP($JOB,IBCNERTN,SRT1))
if SRT1=""
QUIT
Begin DoDot:2
+38 ; D LINE("PYRNAME : "_SRT1)
+39 SET SRT2=""
FOR
SET SRT2=$ORDER(^TMP($JOB,IBCNERTN,SRT1,SRT2))
if SRT2=""
QUIT
Begin DoDot:3
+40 SET N=0
FOR
SET N=$ORDER(^TMP($JOB,IBCNERTN,SRT1,SRT2,N))
if N=""
QUIT
Begin DoDot:4
+41 SET LOUT=^TMP($JOB,IBCNERTN,SRT1,SRT2,N)
+42 ;IB*737/DTG add 4 digit year and mm/dd
+43 ;S SENT=$$FMTE^XLFDT($P(LOUT,U,4),1),$P(LOUT,U,4)=SENT
+44 ;S RECVD=$$FMTE^XLFDT($P(LOUT,U,5),1),$P(LOUT,U,5)=RECVD
+45 SET SENT=$$FMTE^XLFDT($PIECE(LOUT,U,4),5)
SET $PIECE(LOUT,U,4)=SENT
+46 SET RECVD=$$FMTE^XLFDT($PIECE(LOUT,U,5),5)
SET $PIECE(LOUT,U,5)=RECVD
+47 DO LINE(LOUT)
End DoDot:4
if $GET(ZTSTOP)!IBPXT
QUIT
+48 QUIT
End DoDot:3
if $GET(ZTSTOP)!IBPXT
QUIT
+49 QUIT
End DoDot:2
if $GET(ZTSTOP)!IBPXT
QUIT
+50 QUIT
End DoDot:1
if $GET(ZTSTOP)!IBPXT
QUIT
DO LINE(EORMSG)
IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
QUIT
+51 ;
+52 ;I TYPE="R" D Q:$G(ZTSTOP)!IBPXT
+53 ; IB*737/DTG print end of report
IF TYPE="R"
Begin DoDot:1
+54 ; IB*737/DTG separate header from excel
DO HEADER
IF $GET(ZTSTOP)!IBPXT
QUIT
+55 ; IB*737/DTG seperate center of msg from excel
IF '$DATA(^TMP($JOB,IBCNERTN))
DO LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R"))
QUIT
+56 ; report format
+57 ; IB*737/DTG correct quit on '^'
+58 ;F S SRT1=$O(^TMP($J,IBCNERTN,SRT1)) Q:SRT1=""!$G(ZTSTOP)!IBPXT D
+59 FOR
SET SRT1=$ORDER(^TMP($JOB,IBCNERTN,SRT1))
if SRT1=""
QUIT
Begin DoDot:2
+60 DO LINE($$FO^IBCNEUT1($SELECT(SRT1=0:NPROC,1:SRT1),85)_"Count = "_^TMP($JOB,IBCNERTN,SRT1))
if $GET(ZTSTOP)!IBPXT
QUIT
+61 SET SRT2=""
FOR
SET SRT2=$ORDER(^TMP($JOB,IBCNERTN,SRT1,SRT2))
if SRT2=""
QUIT
Begin DoDot:3
+62 SET N=0
FOR
SET N=$ORDER(^TMP($JOB,IBCNERTN,SRT1,SRT2,N))
if N=""
QUIT
DO PRINT
if $GET(ZTSTOP)!IBPXT
QUIT
End DoDot:3
if $GET(ZTSTOP)!IBPXT
QUIT
End DoDot:2
if $GET(ZTSTOP)!IBPXT
QUIT
End DoDot:1
if $GET(ZTSTOP)!IBPXT
QUIT
DO EXIT
+63 QUIT
+64 ;
PRINT ; Get Print Info
+1 ; ?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
+2 SET DDATA=$GET(^TMP($JOB,IBCNERTN,SRT1,SRT2,N))
SET DLINE=""
+3 ; IB*737/DTG truncate payer to 22, patient 21
+4 ;S $E(DLINE,3,24)=$P(DDATA,U) ;PAYER
+5 ;PAYER
SET $EXTRACT(DLINE,3,25)=$EXTRACT($PIECE(DDATA,U),1,23)
+6 ;S $E(DLINE,27,47)=$P(DDATA,U,2) ;PATIENT
+7 ;PATIENT
SET $EXTRACT(DLINE,27,47)=$EXTRACT($PIECE(DDATA,U,2),1,22)
+8 ;SSN
SET $EXTRACT(DLINE,50,53)=$PIECE(DDATA,U,3)
+9 ;IB*737/DTG remove seconds add 4 digit year
+10 ;S $E(DLINE,56,73)=$$FMTE^XLFDT($P(DDATA,U,4),2) ;SENT
+11 ;S $E(DLINE,76,93)=$$FMTE^XLFDT($P(DDATA,U,5),2) ;RECEIVED
+12 ;SENT
SET IBD=$$FMTE^XLFDT($PIECE(DDATA,U,4),5)
SET IBD=$PIECE(IBD,":",1,2)
SET $EXTRACT(DLINE,56,73)=IBD
+13 ;RECEIVED
SET IBD=$$FMTE^XLFDT($PIECE(DDATA,U,5),5)
SET IBD=$PIECE(IBD,":",1,2)
SET $EXTRACT(DLINE,76,93)=IBD
+14 ;TRACE #
SET $EXTRACT(DLINE,96,112)=$PIECE(DDATA,U,6)
+15 ;BUFFER #
SET $EXTRACT(DLINE,115,132)=$PIECE(DDATA,U,7)
+16 DO LINE(DLINE)
+17 QUIT
+18 ;
EXIT ;
+1 DO LINE($$FO^IBCNEUT1(EORMSG,$$CENTER(EORMSG),"R"))
+2 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
+3 QUIT
+4 ;
EOL ; display "end of page" message and set exit flag
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
+2 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBPXT=1
+5 QUIT
+6 ;
EHDR ; print header for excel
+1 ; IB*737/DTG new tag, header for excel only
+2 ;
+3 SET IBPGC=IBPGC+1
+4 WRITE "HL7 Response Report"_U_TSTAMP,!
+5 WRITE ?1,HDR1,!,!
+6 WRITE ?1,$SELECT($GET(INCNESPJ("PYR"))="A":"All",1:"Selected")_" Payers",!
+7 WRITE "Payer Name"_U_"Patient Name"_U_"SSN"_U_"Dt Sent"_U_"Dt Rec'd"_U_"Trace #"_U_"Buffer #"
+8 QUIT
+9 ;
+1 NEW HDR,OFFSET,SRT
+2 ;
+3 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
IF IBPXT
QUIT
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET (ZTSTOP,IBPXT)=1
QUIT
+5 SET IBPGC=IBPGC+1
+6 WRITE @IOF,!,?1,"HL7 Response Report"
+7 ; IB*737/DTG start manage right margin
+8 ;S HDR=TSTAMP_" Page: "_IBPGC,OFFSET=(WIDTH-$L(HDR))
+9 SET HDR=TSTAMP_" Page: "_IBPGC
+10 SET OFFSET=(IBPWIDTH-$LENGTH(HDR))
+11 WRITE ?OFFSET,HDR
+12 WRITE !,?1,HDR1,!,!
+13 WRITE ?1,$SELECT($GET(INCNESPJ("PYR"))="A":"All",1:"Selected")_" Payers"
+14 ;
+15 ;I TYPE="R" W !,?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
+16 WRITE !,?3,"Payer Name",?27,"Patient Name",?50,"SSN",?56,"Dt Sent",?76,"Dt Rec'd",?96,"Trace #",?115,"Buffer #"
+17 WRITE !,?1,DASHES
+18 QUIT
+19 ;
LINE(LINE) ; Print line of data
+1 ; IB*737/DTG handle Excel Header different than report
+2 ; I $Y+1>MAXCNT D HEADER I $G(ZTSTOP)!IBPXT Q
+3 IF ($Y+1)#MAXCNT=0
Begin DoDot:1
+4 IF TYPE="R"
DO HEADER
+5 IF TYPE="E"
IF (CRT)
IF (IBPGC>0)
IF ('$DATA(ZTQUEUED))
DO EOL
End DoDot:1
IF $GET(ZTSTOP)!IBPXT
QUIT
+6 WRITE !,?1,LINE
+7 QUIT
+8 ;
CENTER(LINE) ; return length of a centered line
+1 ; LINE - line to center
+2 NEW LENGTH,OFFSET
+3 ; IB*737/DTG correct center based on report width base
+4 ;S LENGTH=$L(LINE),OFFSET=IOM-$L(LINE)\2
+5 SET LENGTH=$LENGTH(LINE)
+6 SET OFFSET=(IBPWIDTH-LENGTH)\2
+7 QUIT OFFSET+LENGTH
