IBCNERPI ;ALB/EJK - IBCNE EIV SECONDARY INSURANCE REPORT PRINT;08-APR-2013
;;2.0;INTEGRATED BILLING;**497**;08-APR-13;Build 120
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; variables from IBCNESI:
; IBCNERTN = "IBCNERPI"
; ^TMP($J,"IBCNESI1")
; IBCNESPC("TYPE")
; IBCOMP - FLAG FOR COMPLETED ENTRIES
; IBSDT - REPORT START DATE
; IBEDT - REPORT END DATE
Q
;
EN ; Entry point
N DLINE,CRT,DFN,EORMSG,IBDFN,IBDOB,IBDT,IBEIEN,IBURTE,IBSTR1,IBSEQ,IBCNT
S (IBPYR,RIEN,IBELG,IBDT,IBDFN,IBRIEN,IBEIEN)=""
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(IBCNESPC("TYPE")) ; report type
S WIDTH=$S(TYPE="S":79,1:131)
S IBSDT=$$FMTE^XLFDT(IBSDT,"5Z"),IBEDT=$$FMTE^XLFDT(IBEDT,"5Z")
; Determine IO parameters
S MAXCNT=IOSL-6,CRT=0
S:IOST["C-" MAXCNT=IOSL-3,CRT=1
; print data
D HEADER I $G(ZTSTOP)!IBPXT Q
; If global does not exist - display No Data message
I '$D(^TMP($J,"IBCNESI1")) D LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R")) G EXIT
F S IBDT=$O(^TMP($J,"IBCNESI1",IBDT)) Q:IBDT="" D Q:$G(ZTSTOP)!IBPXT
.F S IBDFN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN)) Q:IBDFN="" D Q:$G(ZTSTOP)!IBPXT
..F S IBRIEN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN,IBRIEN)) Q:IBRIEN="" D Q:$G(ZTSTOP)!IBPXT
...D PTHDR Q:$G(ZTSTOP)!IBPXT
...F S IBEIEN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN,IBRIEN,"INS",IBEIEN)) Q:IBEIEN="" D PTDTL Q:$G(ZTSTOP)!IBPXT
...Q:$G(ZTSTOP)!IBPXT
...D PTCMT
...Q
..Q
.Q
I $G(ZTSTOP)!IBPXT Q
;
EXIT ;
D LINE($$FO^IBCNEUT1(EORMSG,$$CENTER(EORMSG),"R"))
I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
K IBCNESPC("TYPE"),IBELG,IBPGC,IBPXT,IBPYR,IBRIEN,MAXCNT,NONEMSG,RIEN,TSTAMP,TYPE,WIDTH,IBCOMP,IBEDT,IBSDT,IBSORT
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
;
N DASHES,HDR,OFFSET,SRT
;
I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL I IBPXT Q
S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 Q
S IBPGC=IBPGC+1
W @IOF,!,"Pt. Secondary Insurance Report"
S HDR=TSTAMP_" Page: "_IBPGC,OFFSET=WIDTH-$L(HDR)
W ?OFFSET,HDR,!
I IBSORT="+1" W "Sort: Chronological Order"
I IBSORT=-1 W "Sort: Reverse Chronological Order"
S HDR=IBSDT_" - "_IBEDT
S OFFSET=WIDTH-$L(HDR)
W ?OFFSET,HDR,!
W "Includes: "
W $S(IBCOMP=3!(IBCOMP=4):"non-",1:""),"Completed Entries"
W $S(IBCOMP=1!(IBCOMP=3):" without",1:" with")," associated comments"
W !
Q
;
PTHDR ;HEADER FOR EACH PATIENT ENTRY
N REVSTAT
W !,$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"PATIENT NAME"))
S IBDOB=$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"DOB"))
I IBDOB>0 S IBDOB=17000000+IBDOB,IBDOB=$E(IBDOB,5,6)_"/"_$E(IBDOB,7,8)_"/"_$E(IBDOB,1,4)
W " "_IBDOB
S REVSTAT=$P($G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"REV STATUS")),U)
W " Review Status: "_$S(REVSTAT=0:"Not Reviewed",REVSTAT=1:"In Process",REVSTAT=2:"Complete",1:"")
S $P(DASHES,"-",WIDTH)="" D LINE(DASHES)
Q
;
PTDTL ;PRINT PATIENT DETAIL LINES
S DLINE=IBDT*IBSORT,DLINE=$$FMTE^XLFDT(DLINE,"5Z") D LINE(DLINE)
S DLINE=$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"EMFLAG"))_" "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"NAME")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
I $G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ID"))]"" S DLINE=" Payer ID: "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ID")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
I $G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 1"))]"" S DLINE=" "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 1")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
I $G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 2"))]"" S DLINE=" "_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 2")) D LINE(DLINE) Q:$G(ZTSTOP)!IBPXT
S DLINE=" "
S DLINE=DLINE_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"CITY"))_", "
S DLINE=DLINE_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"STATE"))_" "
S DLINE=DLINE_$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ZIP"))
D LINE(DLINE) I $G(ZTSTOP)!IBPXT Q
F IBURTE="TE","UR" D I $G(ZTSTOP)!IBPXT Q
. S IBSEQ=0,IBSEQ=$O(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,IBURTE,IBSEQ)) Q:'IBSEQ
. S IBSTR1=$S(IBURTE="TE":"Phone: ",1:"Website: ")_^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,IBURTE,IBSEQ) D WRAP^IBCNESI2(.IBSTR1,70)
. F IBCNT=1:1:$O(IBSTR1(""),-1) S DLINE=" "_IBSTR1(IBCNT) D LINE(DLINE) I $G(ZTSTOP)!IBPXT Q
. Q
I '$G(ZTSTOP)&'IBPXT D LINE("")
Q
PTCMT ; print comments
; print comments
N DIWF,DIWL,DIWR,IBCMDT,IBCMIEN,IBLN,IBRVIEN,IENS,X
I '+$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"NO CMNT")) D
.D LINE("") I $G(ZTSTOP)!IBPXT Q
.D LINE("Comments:") I $G(ZTSTOP)!IBPXT Q
.D LINE("") I $G(ZTSTOP)!IBPXT Q
.S IBRVIEN=+$G(^TMP($J,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"REV IEN"))
.I '$D(^IBCN(365.2,IBRVIEN,1)) D LINE(" No Comments Entered."),LINE("") Q
.S IBCMDT="" F S IBCMDT=$O(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT),-1) Q:'IBCMDT!$G(ZTSTOP)!IBPXT D
..S IBCMIEN=$O(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT,"")) I IBCMIEN="" Q
..S IENS=IBCMIEN_","_IBRVIEN_","
..S DLINE=$$FMTE^XLFDT($$GET1^DIQ(365.21,IENS,.01),"5Z")_" Entered by: "_$$GET1^DIQ(365.21,IENS,.02)
..D LINE(DLINE) I $G(ZTSTOP)!IBPXT Q
..K ^UTILITY($J,"W")
..F IBLN=1:1:$P($G(^IBCN(365.2,IBRVIEN,1,IBCMIEN,1,0)),U,3) S X=$G(^IBCN(365.2,IBRVIEN,1,IBCMIEN,1,IBLN,0)),DIWL=1,DIWR=70,DIWF="" D ^DIWP
..I $D(^UTILITY($J,"W")) S IBLN=0 F S IBLN=$O(^UTILITY($J,"W",1,IBLN)) Q:'IBLN!$G(ZTSTOP)!IBPXT D
...S DLINE=" "_$G(^UTILITY($J,"W",1,IBLN,0)) D LINE(DLINE)
...Q
..I '$G(ZTSTOP),'IBPXT,$O(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT),-1)'="" D LINE("")
..Q
.D LINE("") ; blank line before next person
.Q
K ^UTILITY($J,"W")
Q
;
LINE(LINE) ; Print line of data
I $Y+1>MAXCNT D HEADER I $G(ZTSTOP)!IBPXT Q
W !,?1,LINE
Q
;
CENTER(LINE) ; return length of a centered line
; LINE - line to center
N LENGTH,OFFSET
S LENGTH=$L(LINE),OFFSET=IOM-$L(LINE)\2
Q OFFSET+LENGTH
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERPI 6456 printed Dec 13, 2024@02:15:14 Page 2
IBCNERPI ;ALB/EJK - IBCNE EIV SECONDARY INSURANCE REPORT PRINT;08-APR-2013
+1 ;;2.0;INTEGRATED BILLING;**497**;08-APR-13;Build 120
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; variables from IBCNESI:
+5 ; IBCNERTN = "IBCNERPI"
+6 ; ^TMP($J,"IBCNESI1")
+7 ; IBCNESPC("TYPE")
+8 ; IBCOMP - FLAG FOR COMPLETED ENTRIES
+9 ; IBSDT - REPORT START DATE
+10 ; IBEDT - REPORT END DATE
+11 QUIT
+12 ;
EN ; Entry point
+1 NEW DLINE,CRT,DFN,EORMSG,IBDFN,IBDOB,IBDT,IBEIEN,IBURTE,IBSTR1,IBSEQ,IBCNT
+2 SET (IBPYR,RIEN,IBELG,IBDT,IBDFN,IBRIEN,IBEIEN)=""
+3 SET (IBPGC,IBPXT)=0
+4 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+5 SET EORMSG="*** END OF REPORT ***"
+6 ;S NPROC="Not Processed"
+7 ; time of report
SET TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1)
+8 ; report type
SET TYPE=$GET(IBCNESPC("TYPE"))
+9 SET WIDTH=$SELECT(TYPE="S":79,1:131)
+10 SET IBSDT=$$FMTE^XLFDT(IBSDT,"5Z")
SET IBEDT=$$FMTE^XLFDT(IBEDT,"5Z")
+11 ; Determine IO parameters
+12 SET MAXCNT=IOSL-6
SET CRT=0
+13 if IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
+14 ; print data
+15 DO HEADER
IF $GET(ZTSTOP)!IBPXT
QUIT
+16 ; If global does not exist - display No Data message
+17 IF '$DATA(^TMP($JOB,"IBCNESI1"))
DO LINE($$FO^IBCNEUT1(NONEMSG,$$CENTER(NONEMSG),"R"))
GOTO EXIT
+18 FOR
SET IBDT=$ORDER(^TMP($JOB,"IBCNESI1",IBDT))
if IBDT=""
QUIT
Begin DoDot:1
+19 FOR
SET IBDFN=$ORDER(^TMP($JOB,"IBCNESI1",IBDT,IBDFN))
if IBDFN=""
QUIT
Begin DoDot:2
+20 FOR
SET IBRIEN=$ORDER(^TMP($JOB,"IBCNESI1",IBDT,IBDFN,IBRIEN))
if IBRIEN=""
QUIT
Begin DoDot:3
+21 DO PTHDR
if $GET(ZTSTOP)!IBPXT
QUIT
+22 FOR
SET IBEIEN=$ORDER(^TMP($JOB,"IBCNESI1",IBDT,IBDFN,IBRIEN,"INS",IBEIEN))
if IBEIEN=""
QUIT
DO PTDTL
if $GET(ZTSTOP)!IBPXT
QUIT
+23 if $GET(ZTSTOP)!IBPXT
QUIT
+24 DO PTCMT
+25 QUIT
End DoDot:3
if $GET(ZTSTOP)!IBPXT
QUIT
+26 QUIT
End DoDot:2
if $GET(ZTSTOP)!IBPXT
QUIT
+27 QUIT
End DoDot:1
if $GET(ZTSTOP)!IBPXT
QUIT
+28 IF $GET(ZTSTOP)!IBPXT
QUIT
+29 ;
EXIT ;
+1 DO LINE($$FO^IBCNEUT1(EORMSG,$$CENTER(EORMSG),"R"))
+2 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
+3 KILL IBCNESPC("TYPE"),IBELG,IBPGC,IBPXT,IBPYR,IBRIEN,MAXCNT,NONEMSG,RIEN,TSTAMP,TYPE,WIDTH,IBCOMP,IBEDT,IBSDT,IBSORT
+4 QUIT
+5 ;
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 ;
+1 NEW DASHES,HDR,OFFSET,SRT
+2 ;
+3 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
IF IBPXT
QUIT
+4 ; time of report
SET TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1)
+5 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET (ZTSTOP,IBPXT)=1
QUIT
+6 SET IBPGC=IBPGC+1
+7 WRITE @IOF,!,"Pt. Secondary Insurance Report"
+8 SET HDR=TSTAMP_" Page: "_IBPGC
SET OFFSET=WIDTH-$LENGTH(HDR)
+9 WRITE ?OFFSET,HDR,!
+10 IF IBSORT="+1"
WRITE "Sort: Chronological Order"
+11 IF IBSORT=-1
WRITE "Sort: Reverse Chronological Order"
+12 SET HDR=IBSDT_" - "_IBEDT
+13 SET OFFSET=WIDTH-$LENGTH(HDR)
+14 WRITE ?OFFSET,HDR,!
+15 WRITE "Includes: "
+16 WRITE $SELECT(IBCOMP=3!(IBCOMP=4):"non-",1:""),"Completed Entries"
+17 WRITE $SELECT(IBCOMP=1!(IBCOMP=3):" without",1:" with")," associated comments"
+18 WRITE !
+19 QUIT
+20 ;
PTHDR ;HEADER FOR EACH PATIENT ENTRY
+1 NEW REVSTAT
+2 WRITE !,$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"PATIENT NAME"))
+3 SET IBDOB=$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"DOB"))
+4 IF IBDOB>0
SET IBDOB=17000000+IBDOB
SET IBDOB=$EXTRACT(IBDOB,5,6)_"/"_$EXTRACT(IBDOB,7,8)_"/"_$EXTRACT(IBDOB,1,4)
+5 WRITE " "_IBDOB
+6 SET REVSTAT=$PIECE($GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"REV STATUS")),U)
+7 WRITE " Review Status: "_$SELECT(REVSTAT=0:"Not Reviewed",REVSTAT=1:"In Process",REVSTAT=2:"Complete",1:"")
+8 SET $PIECE(DASHES,"-",WIDTH)=""
DO LINE(DASHES)
+9 QUIT
+10 ;
PTDTL ;PRINT PATIENT DETAIL LINES
+1 SET DLINE=IBDT*IBSORT
SET DLINE=$$FMTE^XLFDT(DLINE,"5Z")
DO LINE(DLINE)
+2 SET DLINE=$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"EMFLAG"))_" "_$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"NAME"))
DO LINE(DLINE)
if $GET(ZTSTOP)!IBPXT
QUIT
+3 IF $GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ID"))]""
SET DLINE=" Payer ID: "_$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ID"))
DO LINE(DLINE)
if $GET(ZTSTOP)!IBPXT
QUIT
+4 IF $GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 1"))]""
SET DLINE=" "_$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 1"))
DO LINE(DLINE)
if $GET(ZTSTOP)!IBPXT
QUIT
+5 IF $GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 2"))]""
SET DLINE=" "_$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 2"))
DO LINE(DLINE)
if $GET(ZTSTOP)!IBPXT
QUIT
+6 SET DLINE=" "
+7 SET DLINE=DLINE_$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"CITY"))_", "
+8 SET DLINE=DLINE_$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"STATE"))_" "
+9 SET DLINE=DLINE_$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,"ZIP"))
+10 DO LINE(DLINE)
IF $GET(ZTSTOP)!IBPXT
QUIT
+11 FOR IBURTE="TE","UR"
Begin DoDot:1
+12 SET IBSEQ=0
SET IBSEQ=$ORDER(^TMP($JOB,"IBCNESI2",IBRIEN,"INS",IBEIEN,IBURTE,IBSEQ))
if 'IBSEQ
QUIT
+13 SET IBSTR1=$SELECT(IBURTE="TE":"Phone: ",1:"Website: ")_^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"INS",IBEIEN,IBURTE,IBSEQ)
DO WRAP^IBCNESI2(.IBSTR1,70)
+14 FOR IBCNT=1:1:$ORDER(IBSTR1(""),-1)
SET DLINE=" "_IBSTR1(IBCNT)
DO LINE(DLINE)
IF $GET(ZTSTOP)!IBPXT
QUIT
+15 QUIT
End DoDot:1
IF $GET(ZTSTOP)!IBPXT
QUIT
+16 IF '$GET(ZTSTOP)&'IBPXT
DO LINE("")
+17 QUIT
PTCMT ; print comments
+1 ; print comments
+2 NEW DIWF,DIWL,DIWR,IBCMDT,IBCMIEN,IBLN,IBRVIEN,IENS,X
+3 IF '+$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"NO CMNT"))
Begin DoDot:1
+4 DO LINE("")
IF $GET(ZTSTOP)!IBPXT
QUIT
+5 DO LINE("Comments:")
IF $GET(ZTSTOP)!IBPXT
QUIT
+6 DO LINE("")
IF $GET(ZTSTOP)!IBPXT
QUIT
+7 SET IBRVIEN=+$GET(^TMP($JOB,"IBCNESI1",IBDT*IBSORT,IBDFN,IBRIEN,"REV IEN"))
+8 IF '$DATA(^IBCN(365.2,IBRVIEN,1))
DO LINE(" No Comments Entered.")
DO LINE("")
QUIT
+9 SET IBCMDT=""
FOR
SET IBCMDT=$ORDER(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT),-1)
if 'IBCMDT!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:2
+10 SET IBCMIEN=$ORDER(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT,""))
IF IBCMIEN=""
QUIT
+11 SET IENS=IBCMIEN_","_IBRVIEN_","
+12 SET DLINE=$$FMTE^XLFDT($$GET1^DIQ(365.21,IENS,.01),"5Z")_" Entered by: "_$$GET1^DIQ(365.21,IENS,.02)
+13 DO LINE(DLINE)
IF $GET(ZTSTOP)!IBPXT
QUIT
+14 KILL ^UTILITY($JOB,"W")
+15 FOR IBLN=1:1:$PIECE($GET(^IBCN(365.2,IBRVIEN,1,IBCMIEN,1,0)),U,3)
SET X=$GET(^IBCN(365.2,IBRVIEN,1,IBCMIEN,1,IBLN,0))
SET DIWL=1
SET DIWR=70
SET DIWF=""
DO ^DIWP
+16 IF $DATA(^UTILITY($JOB,"W"))
SET IBLN=0
FOR
SET IBLN=$ORDER(^UTILITY($JOB,"W",1,IBLN))
if 'IBLN!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:3
+17 SET DLINE=" "_$GET(^UTILITY($JOB,"W",1,IBLN,0))
DO LINE(DLINE)
+18 QUIT
End DoDot:3
+19 IF '$GET(ZTSTOP)
IF 'IBPXT
IF $ORDER(^IBCN(365.2,IBRVIEN,1,"B",IBCMDT),-1)'=""
DO LINE("")
+20 QUIT
End DoDot:2
+21 ; blank line before next person
DO LINE("")
+22 QUIT
End DoDot:1
+23 KILL ^UTILITY($JOB,"W")
+24 QUIT
+25 ;
LINE(LINE) ; Print line of data
+1 IF $Y+1>MAXCNT
DO HEADER
IF $GET(ZTSTOP)!IBPXT
QUIT
+2 WRITE !,?1,LINE
+3 QUIT
+4 ;
CENTER(LINE) ; return length of a centered line
+1 ; LINE - line to center
+2 NEW LENGTH,OFFSET
+3 SET LENGTH=$LENGTH(LINE)
SET OFFSET=IOM-$LENGTH(LINE)\2
+4 QUIT OFFSET+LENGTH
