- 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 Feb 18, 2025@23:41:37 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