IBCNIUR2 ;AITC/VAD - Interfacility Ins. Update Report - cont;3-FEB-2021
;;2.0;INTEGRATED BILLING;**687**; 21-MAR-94;Build 88
;;Per VA Directive 6402, this routine should not be modified.
;
;Variables:
;IBCNFAC(ien) = Facilities (if IBCNFAC=1, include all)
;IBCNIRTN = "IBCNIUR1" (routine name for queueing)
;IBCNIUR("BEGDT") = Begin Date
;IBCNIUR("ENDDT") = End Date
;IBCNIUR("IBOUT") = "E"xcel, "R"eport
;IBCNIUR("PS") = processing status: 1-With, 0-Without
;IBCNIUR("SD") = "S"ummary or "D"etail
;IBCNIUR("SORT") = "D"ate or "F"acility
;IBCNIUR("SR") = "S"ent or "R"eceived
;
Q
;
PRINT ;Generate the report output (called by COMPILE^IBCNIUR1)
N CRT,DASHES,EORMSG,HDR1,HDR1A,HDR1B,IBPGC,IBPXT,MAXCNT,NONEMSG,SORTTXT
N TSTAMP,ZTSTOP
;
S (IBPGC,IBPXT)=0
S NONEMSG="* * * N O D A T A F O U N D * * *"
S EORMSG="*** END OF REPORT ***"
S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
S $P(DASHES,"-",$S(IBRPTSD="S":80,1:132))=""
;
;Set Headers
S HDR1="Date Range: "_$$FMTE^XLFDT(IBBDT,"5Z")_" - "_$$FMTE^XLFDT(IBEDT,"5Z")
S HDR1A=$S(IBRPTSR="S":"Sent to",1:"Received from")_" other Facilities"
S HDR1B=""
I IBRPTSD="D" D ;Set up DETAIL report sub-heading
.S HDR1A=$S($G(IBCNFAC)=1:"All",1:"Selected")_" Facilities, "_HDR1A
.S SORTTXT=$S(IBSORT="D":"Date",IBSORT="P":"Patient Name",1:"Facility")
.I IBSORT="F" S SORTTXT=$S(IBRPTSR="S":"Sent to ",1:"Received from ")_SORTTXT
.S HDR1B="Primary sort: "_SORTTXT
;
;Set IO parameters
S MAXCNT=IOSL-6,CRT=0
S:IOST["C-" MAXCNT=IOSL-3,CRT=1
;
I IBOUT="E" D EHDR I $G(ZTSTOP)!IBPXT G EXITXX ;EXCEL Header
I IBOUT="R" D HEADER I $G(ZTSTOP)!IBPXT G EXITXX ;REPORT Header
;
;If nothing exists, display No Data message
I IBRPTSD="D",$G(^TMP($J,IBCNIRTN))=0 D G EXITPR
.S OFFSET=$$CENTER(NONEMSG,$S(IBRPTSD="S":80,1:132))
.S ELINE="" D LINE(ELINE) Q:$G(ZTSTOP)!IBPXT
.S $E(ELINE,OFFSET,OFFSET+$L(NONEMSG))=NONEMSG
.D LINE(ELINE)
;
I IBOUT="E" D EXCEL(IBRPTSD,IBRPTSR,IBSORT) G:$G(ZTSTOP)!IBPXT EXITXX
I IBOUT="R" D REPORT(IBRPTSD,IBRPTSR,IBSORT) G:$G(ZTSTOP)!IBPXT EXITXX
;
EXITPR ; print end of rpt
N ELINE
I IBOUT="E" W !,EORMSG S IBPGC=1
I IBOUT="R" D G:$G(ZTSTOP)!IBPXT EXITXX
.S OFFSET=$$CENTER(EORMSG,$S(IBRPTSD="S":80,1:132))
.S ELINE="" D LINE(ELINE) Q:$G(ZTSTOP)!IBPXT
.S $E(ELINE,OFFSET,OFFSET+$L(EORMSG))=EORMSG
.D LINE(ELINE) Q:$G(ZTSTOP)!IBPXT
I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
;
EXITXX ; done printing
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
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,!,"Interfacility Ins. Update Report-",$S(IBRPTSD="S":"Summary",1:"Detail")
S HDR=TSTAMP_" Page: "_IBPGC,OFFSET=$S(IBRPTSD="S":80,1:132)-($L(HDR)+1)
W ?OFFSET,HDR
I IBRPTSD="S" W !,HDR1,?80-($L(HDR1A)+1),HDR1A
I IBRPTSD="D" D
.S OFFSET=$$CENTER(HDR1A,132-($L(HDR1)+$L(HDR1B)))
.W !,HDR1,?OFFSET+$L(HDR1),HDR1A,?132-($L(HDR1B)+1),HDR1B
.I 'IBRPTPS D
..W !!,?30,"Last",?93,$S(IBRPTSR="S":"Destination",1:"Originating"),?123,"Date"
..W !,"Patient Name",?29,"4 SSN",?36,"Insurance Company",?68,"Subscriber ID",?89,"COB",?93,"Facility",?123,$S(IBRPTSR="S":"Sent",1:"Received")
.I +IBRPTPS D
..W !!,?26,"Last",?82,"Originating",?100,"Date"
..W !,"Patient Name",?25,"4 SSN",?31,"Insurance Company",?57,"Subscriber ID",?78,"COB",?82,"Facility",?100,"Received",?109,"Processing Status"
W !,DASHES
Q
;
EHDR ;Header for Excel
N LINE,TREC
W !,"Interfacility Ins. Update Report"_U_$S(IBRPTSD="S":"Summary",1:"Detail")_U_TSTAMP
W !,HDR1_U_HDR1A
I IBRPTSD="D" D ;Detail version
.S LINE="Patient Name"_U_"Last 4 SSN"_U_"Insurance Company"_U_"Subscriber ID #"
.S LINE=LINE_U_"COB"_U_$S(IBRPTSR="S":"Destination",1:"Originating")_" Facility"
.S LINE=LINE_U_"Date "_$S(IBRPTSR="S":"Sent",1:"Received")
.I +IBRPTPS S LINE=LINE_U_"Processing Status"
I IBRPTSD="S" D ;Summary version
.S TREC=$G(^TMP($J,IBCNIRTN))
.S LINE="Facility (Total = "_+$P(TREC,U,2)_")"
.S LINE=LINE_U_"# of Transmissions (Total = "_+TREC_")"
W !,LINE
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
;
EXCEL(IBRPTSD,IBRPTSR,IBSORT) ;Output in Excel format
N DLINE,SORT,SORT1,SORT2,SORT3
I IBRPTSD="S" D Q ;For SUMMARY format
.S SORT1=""
.F S SORT1=$O(^TMP($J,IBCNIRTN,"VAMCNAME",SORT1)) Q:SORT1=""!$G(ZTSTOP)!IBPXT D
..S DLINE=SORT1_U_+$G(^TMP($J,IBCNIRTN,"VAMCNAME",SORT1))
..D LINE(DLINE)
;
;DETAIL format
S SORT=""
F S SORT=$O(^TMP($J,IBCNIRTN,SORT)) Q:SORT=""!$G(ZTSTOP)!IBPXT D
.S SORT1=""
.F S SORT1=$O(^TMP($J,IBCNIRTN,SORT,SORT1)) Q:SORT1=""!$G(ZTSTOP)!IBPXT D
..S SORT2=""
..F S SORT2=$O(^TMP($J,IBCNIRTN,SORT,SORT1,SORT2)) Q:SORT2=""!$G(ZTSTOP)!IBPXT D
...S SORT3=""
...F S SORT3=$O(^TMP($J,IBCNIRTN,SORT,SORT1,SORT2,SORT3)) Q:SORT3=""!$G(ZTSTOP)!IBPXT D
... .S DLINE=^TMP($J,IBCNIRTN,SORT,SORT1,SORT2,SORT3)
... .D LINE(DLINE)
Q
;
REPORT(IBRPTSD,IBRPTSR,IBSORT) ;REPORT format (not Excel version)
N DATA,DLINE,SORT1,SORT2,SORT3,TREC
I IBRPTSD="S" D Q:$G(ZTSTOP)!IBPXT ;SUMMARY format
.S TREC=$G(^TMP($J,IBCNIRTN))
.W !!,"Total Number of Transmissions "_$S(IBRPTSR="S":"Sent",1:"Received"),?54,$J(+TREC,6)
.W !,"Total Facilities ",?54,$J(+$P(TREC,U,2),6)
.S SORT1=""
.F S SORT1=$O(^TMP($J,IBCNIRTN,"VAMCNAME",SORT1)) Q:SORT1=""!$G(ZTSTOP)!IBPXT D
..S DATA=^TMP($J,IBCNIRTN,"VAMCNAME",SORT1)
..S DLINE=""
..S $E(DLINE,3,35)=SORT1
..S $E(DLINE,40,46)=$J($P(DATA,U,1),6)
..D LINE(DLINE)
..Q
;
;DETAIL format
S SORT=""
F S SORT=$O(^TMP($J,IBCNIRTN,SORT)) Q:SORT="" D Q:$G(ZTSTOP)!IBPXT
.S SORT1=""
.F S SORT1=$O(^TMP($J,IBCNIRTN,SORT,SORT1)) Q:SORT1="" D Q:$G(ZTSTOP)!IBPXT
..S SORT2=""
..F S SORT2=$O(^TMP($J,IBCNIRTN,SORT,SORT1,SORT2)) Q:SORT2="" D Q:$G(ZTSTOP)!IBPXT
...S SORT3=""
...F S SORT3=$O(^TMP($J,IBCNIRTN,SORT,SORT1,SORT2,SORT3)) Q:SORT3="" D Q:$G(ZTSTOP)!IBPXT
... .S DATA=$G(^TMP($J,IBCNIRTN,SORT,SORT1,SORT2,SORT3))
... .S DLINE=""
... .I 'IBRPTPS D ;Set output W/O Processing Status
... ..S $E(DLINE,1,28)=$E($P(DATA,U),1,28) ;Patient Name
... ..S $E(DLINE,30,34)=$P(DATA,U,2) ;Last 4 of SSN
... ..S $E(DLINE,37,66)=$E($P(DATA,U,3),1,30) ;Insurance Company Name
... ..S $E(DLINE,69,88)=$E($P(DATA,U,4),1,20) ;Subscriber ID
... ..S $E(DLINE,91,91)=$P(DATA,U,5) ;COB
... ..S $E(DLINE,94,121)=$E($P(DATA,U,6),1,28) ;Facility Name
... ..S $E(DLINE,124,131)=$P(DATA,U,7) ;Date (received or sent)
... ..D LINE(DLINE)
... .;
... .I +IBRPTPS D ;Set output W/ Processing Status
... ..S $E(DLINE,1,25)=$E($P(DATA,U),1,25) ;Patient Name
... ..S $E(DLINE,26,30)=$P(DATA,U,2) ;Last 4 of SSN
... ..S $E(DLINE,32,56)=$E($P(DATA,U,3),1,25) ;Insurance Company Name
... ..S $E(DLINE,58,77)=$E($P(DATA,U,4),1,20) ;Subscriber ID
... ..S $E(DLINE,80,80)=$P(DATA,U,5) ;COB
... ..S $E(DLINE,83,99)=$E($P(DATA,U,6),1,17) ;Facility Name
... ..S $E(DLINE,101,108)=$P(DATA,U,7) ;Received Date
... ..S $E(DLINE,110,132)=$E($P(DATA,U,8),1,23) ;Processing Status/Receiver Status
... ..D LINE(DLINE)
Q
;
LINE(LINE) ;Print detail line
I $Y+1>MAXCNT D HEADER I $G(ZTSTOP)!IBPXT Q
W !,LINE
Q
;
CENTER(LINE,XWIDTH) ;return length of a centered line
N LENGTH,OFFSET
S LENGTH=$L(LINE),OFFSET=XWIDTH-$L(LINE)\2
Q OFFSET
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNIUR2 7672 printed Apr 09, 2024@21:09:14 Page 2
IBCNIUR2 ;AITC/VAD - Interfacility Ins. Update Report - cont;3-FEB-2021
+1 ;;2.0;INTEGRATED BILLING;**687**; 21-MAR-94;Build 88
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Variables:
+5 ;IBCNFAC(ien) = Facilities (if IBCNFAC=1, include all)
+6 ;IBCNIRTN = "IBCNIUR1" (routine name for queueing)
+7 ;IBCNIUR("BEGDT") = Begin Date
+8 ;IBCNIUR("ENDDT") = End Date
+9 ;IBCNIUR("IBOUT") = "E"xcel, "R"eport
+10 ;IBCNIUR("PS") = processing status: 1-With, 0-Without
+11 ;IBCNIUR("SD") = "S"ummary or "D"etail
+12 ;IBCNIUR("SORT") = "D"ate or "F"acility
+13 ;IBCNIUR("SR") = "S"ent or "R"eceived
+14 ;
+15 QUIT
+16 ;
PRINT ;Generate the report output (called by COMPILE^IBCNIUR1)
+1 NEW CRT,DASHES,EORMSG,HDR1,HDR1A,HDR1B,IBPGC,IBPXT,MAXCNT,NONEMSG,SORTTXT
+2 NEW TSTAMP,ZTSTOP
+3 ;
+4 SET (IBPGC,IBPXT)=0
+5 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+6 SET EORMSG="*** END OF REPORT ***"
+7 ; time of report
SET TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1)
+8 SET $PIECE(DASHES,"-",$SELECT(IBRPTSD="S":80,1:132))=""
+9 ;
+10 ;Set Headers
+11 SET HDR1="Date Range: "_$$FMTE^XLFDT(IBBDT,"5Z")_" - "_$$FMTE^XLFDT(IBEDT,"5Z")
+12 SET HDR1A=$SELECT(IBRPTSR="S":"Sent to",1:"Received from")_" other Facilities"
+13 SET HDR1B=""
+14 ;Set up DETAIL report sub-heading
IF IBRPTSD="D"
Begin DoDot:1
+15 SET HDR1A=$SELECT($GET(IBCNFAC)=1:"All",1:"Selected")_" Facilities, "_HDR1A
+16 SET SORTTXT=$SELECT(IBSORT="D":"Date",IBSORT="P":"Patient Name",1:"Facility")
+17 IF IBSORT="F"
SET SORTTXT=$SELECT(IBRPTSR="S":"Sent to ",1:"Received from ")_SORTTXT
+18 SET HDR1B="Primary sort: "_SORTTXT
End DoDot:1
+19 ;
+20 ;Set IO parameters
+21 SET MAXCNT=IOSL-6
SET CRT=0
+22 if IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
+23 ;
+24 ;EXCEL Header
IF IBOUT="E"
DO EHDR
IF $GET(ZTSTOP)!IBPXT
GOTO EXITXX
+25 ;REPORT Header
IF IBOUT="R"
DO HEADER
IF $GET(ZTSTOP)!IBPXT
GOTO EXITXX
+26 ;
+27 ;If nothing exists, display No Data message
+28 IF IBRPTSD="D"
IF $GET(^TMP($JOB,IBCNIRTN))=0
Begin DoDot:1
+29 SET OFFSET=$$CENTER(NONEMSG,$SELECT(IBRPTSD="S":80,1:132))
+30 SET ELINE=""
DO LINE(ELINE)
if $GET(ZTSTOP)!IBPXT
QUIT
+31 SET $EXTRACT(ELINE,OFFSET,OFFSET+$LENGTH(NONEMSG))=NONEMSG
+32 DO LINE(ELINE)
End DoDot:1
GOTO EXITPR
+33 ;
+34 IF IBOUT="E"
DO EXCEL(IBRPTSD,IBRPTSR,IBSORT)
if $GET(ZTSTOP)!IBPXT
GOTO EXITXX
+35 IF IBOUT="R"
DO REPORT(IBRPTSD,IBRPTSR,IBSORT)
if $GET(ZTSTOP)!IBPXT
GOTO EXITXX
+36 ;
EXITPR ; print end of rpt
+1 NEW ELINE
+2 IF IBOUT="E"
WRITE !,EORMSG
SET IBPGC=1
+3 IF IBOUT="R"
Begin DoDot:1
+4 SET OFFSET=$$CENTER(EORMSG,$SELECT(IBRPTSD="S":80,1:132))
+5 SET ELINE=""
DO LINE(ELINE)
if $GET(ZTSTOP)!IBPXT
QUIT
+6 SET $EXTRACT(ELINE,OFFSET,OFFSET+$LENGTH(EORMSG))=EORMSG
+7 DO LINE(ELINE)
if $GET(ZTSTOP)!IBPXT
QUIT
End DoDot:1
if $GET(ZTSTOP)!IBPXT
GOTO EXITXX
+8 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
+9 ;
EXITXX ; done printing
+1 DO ^%ZISC
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
+4 ;
+1 NEW HDR,OFFSET,SRT
+2 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
IF IBPXT
QUIT
+3 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET (ZTSTOP,IBPXT)=1
QUIT
+4 SET IBPGC=IBPGC+1
+5 WRITE @IOF,!,"Interfacility Ins. Update Report-",$SELECT(IBRPTSD="S":"Summary",1:"Detail")
+6 SET HDR=TSTAMP_" Page: "_IBPGC
SET OFFSET=$SELECT(IBRPTSD="S":80,1:132)-($LENGTH(HDR)+1)
+7 WRITE ?OFFSET,HDR
+8 IF IBRPTSD="S"
WRITE !,HDR1,?80-($LENGTH(HDR1A)+1),HDR1A
+9 IF IBRPTSD="D"
Begin DoDot:1
+10 SET OFFSET=$$CENTER(HDR1A,132-($LENGTH(HDR1)+$LENGTH(HDR1B)))
+11 WRITE !,HDR1,?OFFSET+$LENGTH(HDR1),HDR1A,?132-($LENGTH(HDR1B)+1),HDR1B
+12 IF 'IBRPTPS
Begin DoDot:2
+13 WRITE !!,?30,"Last",?93,$SELECT(IBRPTSR="S":"Destination",1:"Originating"),?123,"Date"
+14 WRITE !,"Patient Name",?29,"4 SSN",?36,"Insurance Company",?68,"Subscriber ID",?89,"COB",?93,"Facility",?123,$SELECT(IBRPTSR="S":"Sent",1:"Received")
End DoDot:2
+15 IF +IBRPTPS
Begin DoDot:2
+16 WRITE !!,?26,"Last",?82,"Originating",?100,"Date"
+17 WRITE !,"Patient Name",?25,"4 SSN",?31,"Insurance Company",?57,"Subscriber ID",?78,"COB",?82,"Facility",?100,"Received",?109,"Processing Status"
End DoDot:2
End DoDot:1
+18 WRITE !,DASHES
+19 QUIT
+20 ;
EHDR ;Header for Excel
+1 NEW LINE,TREC
+2 WRITE !,"Interfacility Ins. Update Report"_U_$SELECT(IBRPTSD="S":"Summary",1:"Detail")_U_TSTAMP
+3 WRITE !,HDR1_U_HDR1A
+4 ;Detail version
IF IBRPTSD="D"
Begin DoDot:1
+5 SET LINE="Patient Name"_U_"Last 4 SSN"_U_"Insurance Company"_U_"Subscriber ID #"
+6 SET LINE=LINE_U_"COB"_U_$SELECT(IBRPTSR="S":"Destination",1:"Originating")_" Facility"
+7 SET LINE=LINE_U_"Date "_$SELECT(IBRPTSR="S":"Sent",1:"Received")
+8 IF +IBRPTPS
SET LINE=LINE_U_"Processing Status"
End DoDot:1
+9 ;Summary version
IF IBRPTSD="S"
Begin DoDot:1
+10 SET TREC=$GET(^TMP($JOB,IBCNIRTN))
+11 SET LINE="Facility (Total = "_+$PIECE(TREC,U,2)_")"
+12 SET LINE=LINE_U_"# of Transmissions (Total = "_+TREC_")"
End DoDot:1
+13 WRITE !,LINE
+14 QUIT
+15 ;
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 ;
EXCEL(IBRPTSD,IBRPTSR,IBSORT) ;Output in Excel format
+1 NEW DLINE,SORT,SORT1,SORT2,SORT3
+2 ;For SUMMARY format
IF IBRPTSD="S"
Begin DoDot:1
+3 SET SORT1=""
+4 FOR
SET SORT1=$ORDER(^TMP($JOB,IBCNIRTN,"VAMCNAME",SORT1))
if SORT1=""!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:2
+5 SET DLINE=SORT1_U_+$GET(^TMP($JOB,IBCNIRTN,"VAMCNAME",SORT1))
+6 DO LINE(DLINE)
End DoDot:2
End DoDot:1
QUIT
+7 ;
+8 ;DETAIL format
+9 SET SORT=""
+10 FOR
SET SORT=$ORDER(^TMP($JOB,IBCNIRTN,SORT))
if SORT=""!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:1
+11 SET SORT1=""
+12 FOR
SET SORT1=$ORDER(^TMP($JOB,IBCNIRTN,SORT,SORT1))
if SORT1=""!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:2
+13 SET SORT2=""
+14 FOR
SET SORT2=$ORDER(^TMP($JOB,IBCNIRTN,SORT,SORT1,SORT2))
if SORT2=""!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:3
+15 SET SORT3=""
+16 FOR
SET SORT3=$ORDER(^TMP($JOB,IBCNIRTN,SORT,SORT1,SORT2,SORT3))
if SORT3=""!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:4
+17 SET DLINE=^TMP($JOB,IBCNIRTN,SORT,SORT1,SORT2,SORT3)
+18 DO LINE(DLINE)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
REPORT(IBRPTSD,IBRPTSR,IBSORT) ;REPORT format (not Excel version)
+1 NEW DATA,DLINE,SORT1,SORT2,SORT3,TREC
+2 ;SUMMARY format
IF IBRPTSD="S"
Begin DoDot:1
+3 SET TREC=$GET(^TMP($JOB,IBCNIRTN))
+4 WRITE !!,"Total Number of Transmissions "_$SELECT(IBRPTSR="S":"Sent",1:"Received"),?54,$JUSTIFY(+TREC,6)
+5 WRITE !,"Total Facilities ",?54,$JUSTIFY(+$PIECE(TREC,U,2),6)
+6 SET SORT1=""
+7 FOR
SET SORT1=$ORDER(^TMP($JOB,IBCNIRTN,"VAMCNAME",SORT1))
if SORT1=""!$GET(ZTSTOP)!IBPXT
QUIT
Begin DoDot:2
+8 SET DATA=^TMP($JOB,IBCNIRTN,"VAMCNAME",SORT1)
+9 SET DLINE=""
+10 SET $EXTRACT(DLINE,3,35)=SORT1
+11 SET $EXTRACT(DLINE,40,46)=$JUSTIFY($PIECE(DATA,U,1),6)
+12 DO LINE(DLINE)
+13 QUIT
End DoDot:2
End DoDot:1
if $GET(ZTSTOP)!IBPXT
QUIT
+14 ;
+15 ;DETAIL format
+16 SET SORT=""
+17 FOR
SET SORT=$ORDER(^TMP($JOB,IBCNIRTN,SORT))
if SORT=""
QUIT
Begin DoDot:1
+18 SET SORT1=""
+19 FOR
SET SORT1=$ORDER(^TMP($JOB,IBCNIRTN,SORT,SORT1))
if SORT1=""
QUIT
Begin DoDot:2
+20 SET SORT2=""
+21 FOR
SET SORT2=$ORDER(^TMP($JOB,IBCNIRTN,SORT,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:3
+22 SET SORT3=""
+23 FOR
SET SORT3=$ORDER(^TMP($JOB,IBCNIRTN,SORT,SORT1,SORT2,SORT3))
if SORT3=""
QUIT
Begin DoDot:4
+24 SET DATA=$GET(^TMP($JOB,IBCNIRTN,SORT,SORT1,SORT2,SORT3))
+25 SET DLINE=""
+26 ;Set output W/O Processing Status
IF 'IBRPTPS
Begin DoDot:5
+27 ;Patient Name
SET $EXTRACT(DLINE,1,28)=$EXTRACT($PIECE(DATA,U),1,28)
+28 ;Last 4 of SSN
SET $EXTRACT(DLINE,30,34)=$PIECE(DATA,U,2)
+29 ;Insurance Company Name
SET $EXTRACT(DLINE,37,66)=$EXTRACT($PIECE(DATA,U,3),1,30)
+30 ;Subscriber ID
SET $EXTRACT(DLINE,69,88)=$EXTRACT($PIECE(DATA,U,4),1,20)
+31 ;COB
SET $EXTRACT(DLINE,91,91)=$PIECE(DATA,U,5)
+32 ;Facility Name
SET $EXTRACT(DLINE,94,121)=$EXTRACT($PIECE(DATA,U,6),1,28)
+33 ;Date (received or sent)
SET $EXTRACT(DLINE,124,131)=$PIECE(DATA,U,7)
+34 DO LINE(DLINE)
End DoDot:5
+35 ;
+36 ;Set output W/ Processing Status
IF +IBRPTPS
Begin DoDot:5
+37 ;Patient Name
SET $EXTRACT(DLINE,1,25)=$EXTRACT($PIECE(DATA,U),1,25)
+38 ;Last 4 of SSN
SET $EXTRACT(DLINE,26,30)=$PIECE(DATA,U,2)
+39 ;Insurance Company Name
SET $EXTRACT(DLINE,32,56)=$EXTRACT($PIECE(DATA,U,3),1,25)
+40 ;Subscriber ID
SET $EXTRACT(DLINE,58,77)=$EXTRACT($PIECE(DATA,U,4),1,20)
+41 ;COB
SET $EXTRACT(DLINE,80,80)=$PIECE(DATA,U,5)
+42 ;Facility Name
SET $EXTRACT(DLINE,83,99)=$EXTRACT($PIECE(DATA,U,6),1,17)
+43 ;Received Date
SET $EXTRACT(DLINE,101,108)=$PIECE(DATA,U,7)
+44 ;Processing Status/Receiver Status
SET $EXTRACT(DLINE,110,132)=$EXTRACT($PIECE(DATA,U,8),1,23)
+45 DO LINE(DLINE)
End DoDot:5
End DoDot:4
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
+46 QUIT
+47 ;
LINE(LINE) ;Print detail line
+1 IF $Y+1>MAXCNT
DO HEADER
IF $GET(ZTSTOP)!IBPXT
QUIT
+2 WRITE !,LINE
+3 QUIT
+4 ;
CENTER(LINE,XWIDTH) ;return length of a centered line
+1 NEW LENGTH,OFFSET
+2 SET LENGTH=$LENGTH(LINE)
SET OFFSET=XWIDTH-$LENGTH(LINE)\2
+3 QUIT OFFSET
+4 ;
