- 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 Jan 18, 2025@03:17:15 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 ;