Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNIUR2

IBCNIUR2.m

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