IBCNIUR1 ;AITC/VAD - Interfacility Ins. Update Report;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
;
;ICR #10090 - File 4
;
Q
;
EN ;entry point
N %ZIS,I,IBCNFAC,IBCNIUR,IBCNIRTN,IBDFLTDT,IBOUT,IBRPTPS,IBRPTSD,IBRPTSR
N IBRPTSRX,POP,STOP
N ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE
S STOP=0,IBCNIRTN="IBCNIUR1"
K ^TMP($J,IBCNIRTN)
W @IOF,!,"Interfacility Ins. Update Report",!
;
P10 ;Summary or Detail
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^S:Summary;D:Detailed;"
S DIR("A")="Summary or Detailed:// "
S DIR("??")="^D HELPDS^IBCNIUR1"
D ^DIR
I $D(DUOUT)!$D(DTOUT)!(Y=-1) G EXIT
S IBCNIUR("SD")=Y,IBRPTSD=Y
I IBCNIUR("SD")="S" S IBCNFAC=1,IBCNIUR("SORT")=""
;
P20 ;Received or Sent
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !!,"To view what your facility sent to other VAMCs choose SENT."
W !,"To view what your facility received from other VAMCs choose RECEIVED.",!
S DIR(0)="SA^S:Sent;R:Received"
S DIR("A")="Report Type - (S)ent or (R)eceived Report// "
S DIR("??")="^D HELPSR^IBCNIUR1"
D ^DIR
I $D(DUOUT)!$D(DTOUT)!(Y=-1) G:$$STOP^IBCNINSU EXIT G P10
S IBCNIUR("SR")=Y,IBRPTSR=Y
W !
;If the rpt is "Sent", skip Processing Status prompt
I IBCNIUR("SD")="S"!(IBCNIUR("SR")="S") G P30
;
P25 ;Include or exclude Processing Status
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !,"To know which records filed to buffer and which did not,"
W !,"select ""YES"" to include processing status.",!
S DIR(0)="Y",DIR("A")="Include processing status"
S DIR("B")="YES",DIR("??")="^D HELPPS^IBCNIUR1"
D ^DIR
I $D(DUOUT)!$D(DTOUT)!(Y=-1) G:$$STOP^IBCNINSU EXIT G P20
S IBCNIUR("PS")=Y,IBRPTPS=Y K DIR
W !
;
P30 ;Get Default date
S IBRPTSRX=$S(IBRPTSR="S":"SSR",1:"DIR")
S IBDFLTDT=$O(^IBCN(365.19,IBRPTSRX,IBRPTSR,""))
I IBDFLTDT="" S IBDFLTDT=$$NOW^XLFDT ;If no date, use the current date
S IBDFLTDT=IBDFLTDT\1
;
P35 ;Begin Date
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="D^::EX"
S DIR("A",1)=$S(IBRPTSR="S":"Sent",1:"Receiving")_" Date Range:"
S DIR("A")=" Earliest Date "_$S(IBRPTSR="R":"Received",1:"Sent")
S DIR("B")=$S(IBDFLTDT:$$FMTE^XLFDT(IBDFLTDT,5),1:"")
D ^DIR
I $D(DUOUT)!$D(DTOUT)!(Y=-1) G:$$STOP^IBCNINSU EXIT G:(IBCNIUR("SD")="S"!(IBCNIUR("SR")="S")) P20 G P25
I Y<IBDFLTDT!(Y>DT) D G P35
. W !,"Invalid date entered."
. W !,"Date must be within the range of ",$$FMTE^XLFDT(IBDFLTDT,5)," and ",$$FMTE^XLFDT(DT,5),"...please re-enter.",!
S IBCNIUR("BEGDT")=Y
;
P36 ;End date
K DIR("A")
S DIR("A")=" Latest Date "_$S(IBRPTSR="S":"Sent",1:"Received"),DIR("B")="TODAY"
D ^DIR I $D(DUOUT)!$D(DTOUT)!(Y=-1) G:$$STOP^IBCNINSU EXIT G P35
I Y<IBCNIUR("BEGDT") W !," Latest Date must not precede the Earliest Date." G P36
I Y<IBCNIUR("BEGDT")!(Y>DT) D G P36
. W !,"Invalid date entered."
. W !,"Date must be within the range of ",$$FMTE^XLFDT(IBCNIUR("BEGDT"),5)," and ",$$FMTE^XLFDT(DT,5),"...please re-enter.",!
S IBCNIUR("ENDDT")=Y
;
P40 ;Facility Selection
W !
I IBCNIUR("SD")="D" D INST^IBCNINSL(.IBCNFAC,$S(IBCNIUR("SR")="S":"Destination",1:"Originating")_" Facility")
I $D(DUOUT)!$D(DTOUT) G:$$STOP^IBCNINSU EXIT G P35
;
P50 ;Report or Excel
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR I $D(DIRUT) G:$$STOP^IBCNINSU EXIT G:IBCNIUR("SD")="D" P40 G P35
S (IBOUT,IBCNIUR("IBOUT"))=Y
I IBCNIUR("IBOUT")="E" S IBCNIUR("SORT")="D" G P70
;
P60 ;Sort by Date, Patient or Facility
I IBCNIUR("SD")'="D" G P70 ; If Summary, skip Facility prompt
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^D:Date "_$S(IBCNIUR("SR")="S":"Sent",1:"Received")_";P:Patient Name;F:Facility "_$S(IBCNIUR("SR")="S":"Destination",1:"Originated From")
S DIR("A",1)="Select one of the following:"
S DIR("A",2)=""
S DIR("A",3)=" D Date "_$S(IBCNIUR("SR")="S":"Sent",1:"Received")
S DIR("A",4)=" P Patient Name"
S DIR("A",5)=" F Facility "_$S(IBCNIUR("SR")="S":"Destination",1:"Originated From")
S DIR("A",6)=""
S DIR("A")="Sort the report by: "
D ^DIR I $D(DIRUT) G:$$STOP^IBCNINSU EXIT G P50
S IBCNIUR("SORT")=Y
;
P70 ; Proceed to compile the data and generate the output of the rpt
S STOP=0
I '$D(ZTQUEUED) D
. I IBCNIUR("IBOUT")="R" D Q
. . I IBCNIUR("SD")="D" W !,"*** This report is 132 characters wide ***",! ;For DETAIL
. W !,"*** To avoid wrapping, enter '0;256;999' at the 'DEVICE' prompt. ***",!
D DEVICE(IBCNIRTN,.IBCNIUR,.IBCNFAC)
I +STOP,IBCNIUR("IBOUT")="E" G:$$STOP^IBCNINSU EXIT G P50
I +STOP,IBCNIUR("SD")'="D" G:$$STOP^IBCNINSU EXIT G P50
I +STOP,IBCNIUR("SD")="D" G:$$STOP^IBCNINSU EXIT G P60
G EXIT
; =============================
DEVICE(IBCNIRTN,IBCNIUR,IBCNFAC) ; Device Handler and possible TaskManager calls
; Input params:
; IBCNIRTN = Routine name for ^TMP($J,...
; IBCNIUR = Array passed by ref of the report params
; IBOUT = "R" for Report format or "E" for Excel format
;
N POP,ZTDESC,ZTRTN,ZTSAVE
;
S ZTRTN="COMPILE^IBCNIUR1(.IBCNFAC,.IBCNIUR,"""_IBCNIRTN_""")"
S ZTDESC="IBCNIU - Interfacility Ins. Update Report"
S ZTSAVE("IBCNFAC")=""
S ZTSAVE("IBCNFAC(")=""
S ZTSAVE("IBCNIUR(")=""
S ZTSAVE("IBCNIRTN")=""
S ZTSAVE("IBOUT")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
I POP S STOP=1
Q
;
HELPDS ;Help for Summary/Detail
W !,"Please enter 'S' for 'Summary' or 'D' for a Detailed Report."
Q
;
HELPPS ;Help for (W)ith or With(O)ut Processing Status
W !,"Enter 'YES' to include the processing status for the records received."
W !,"This identifies which records filed to the buffer and which did not."
W !,"Enter 'NO' to exclude the processing status on the report."
Q
;
HELPSR ;Help for (S)ent or (R)eceived Report
W !,"Please enter 'R' for 'Received' or 'S' for 'Sent'."
Q
;
EXIT ;
K ^TMP($J,IBCNIRTN),IBCNIRTN,IBCNIUR
Q
;
COMPILE(IBCNFAC,IBCNIUR,IBCNIRTN) ; Compile the data.
N DSENT,FNAME,FSENT,IBBDT,IBEDT,IBOUT,IBRPTPS,IBRPTSD,IBRPTSR,IBSORT
N PNAME,PSENT,SDATE,SITENO,SUBID
S IBBDT=$G(IBCNIUR("BEGDT")) ;Begin Date
S IBEDT=$G(IBCNIUR("ENDDT")) ;End Date
S IBOUT=$G(IBCNIUR("IBOUT")) ;"E"xcel, "R"eport
S IBRPTPS=$G(IBCNIUR("PS")) ;Processing status: 1-With, 0-Without
S IBRPTSD=$G(IBCNIUR("SD")) ;"S"ummary or "D"etail
S IBRPTSR=$G(IBCNIUR("SR")) ;"S"ent or "R"eceived
S IBSORT=$G(IBCNIUR("SORT")) ;"D"ate or "F"acility or "P"atient
S ^TMP($J,IBCNIRTN)=0
;
I IBRPTSR="R" D GETRECV ;Get RECEIVED data
I IBRPTSR="S" D GETSENT ;Get SENT data
D PRINT^IBCNIUR2
Q
;
GETRECV ;Get RECEIVED Data
N COB,DATAREC,IIUIENS,IIURCV,IIUVAMC,INSNAM,INSNAME,OVAMC,OVAMCIEN,OVAMCNAM,OVAMCSTA
N PATIEN,PATSSN,PATSSN4,PNAME,RCVDTTM,RDATE,RDTTM,RPROCSTAT,SUBID,VAMCSQ
;
S RCVDTTM=IBBDT ;Set begin date
F S RCVDTTM=$O(^IBCN(365.19,"DIR","R",RCVDTTM)) Q:RCVDTTM=""!((RCVDTTM\1)>IBEDT) D
.S IIURCV=""
.;Loop thru receiving records by date
.F S IIURCV=$O(^IBCN(365.19,"DIR","R",RCVDTTM,IIURCV)) Q:IIURCV="" D
..S IIUIENS=IIURCV_","
..S PATIEN=$$GET1^DIQ(365.19,IIUIENS,.01,"I"),PNAME=$$GET1^DIQ(365.19,IIUIENS,.01) ;Patient IEN & Patient Name
..S PNAME=$S(IBOUT="R":$E(PNAME,1,25),1:PNAME) ;Truncate for REPORT
..S PATSSN=$$GET1^DIQ(2,PATIEN_",",.09,"I")
..;Last 4 of Patient's SSN
..S PATSSN4=$S($E(PATSSN,$L(PATSSN))="P":$E(PATSSN,$L(PATSSN)-4,$L(PATSSN)),1:$E(PATSSN,$L(PATSSN)-3,$L(PATSSN)))
..S RDTTM=$$GET1^DIQ(365.19,IIUIENS,2.02,"I"),RDATE=RDTTM\1 ;Received Date/Time
..S RPROCSTAT=$$GET1^DIQ(365.19,IIUIENS,2.01,"E") ;get the RECEIVER PROCESSING STATUS
..S RPROCSTAT=$S(IBOUT="R":$E(RPROCSTAT,1,23),1:RPROCSTAT) ;Truncate for REPORT
..;
..S IIUVAMC="1,"_IIUIENS ;get the Originating VAMC data
..S OVAMCIEN=$$GET1^DIQ(365.192,IIUVAMC,.01,"I") ;VAMC IEN
..I $G(IBCNFAC)'=1,'$D(IBCNFAC(OVAMCIEN)) Q ;** NOT a selected facility
..S OVAMCNAM=$$GET1^DIQ(365.192,IIUVAMC,.01,"E") ;VAMC name
..S OVAMCSTA=$$GET1^DIQ(4,OVAMCIEN,99,"E") ;VAMC station # (ICR #10090)
..S OVAMC=$E(OVAMCNAM,1,$S(+IBRPTPS:11,1:22))_" ("_+OVAMCSTA_")" ;VAMC name & station #
..I IBOUT="E" S OVAMC=OVAMCNAM_" ("_+OVAMCSTA_")" ;Don't truncate VAMC name/station for EXCEL
..;
..;STORE counter data.
..S $P(^TMP($J,IBCNIRTN),U,1)=$P($G(^TMP($J,IBCNIRTN)),U,1)+1 ;# of transmissions received
..I '$D(^TMP($J,IBCNIRTN,"VAMCNAME",OVAMC)) D ;A new VAMC
...S $P(^TMP($J,IBCNIRTN),U,2)=$P(^TMP($J,IBCNIRTN),U,2)+1 ;# of VAMCs
..S ^TMP($J,IBCNIRTN,"VAMCNAME",OVAMC)=$G(^TMP($J,IBCNIRTN,"VAMCNAME",OVAMC))+1 ;increment # per VAMC
..I IBRPTSD="S" Q ;If SUMMARY quit
..;
..;If DETAIL, gather DETAILED RECEIVED data
..S INSNAME=$$GET1^DIQ(365.192,IIUVAMC,.03,"E") ;Insurance Company Name
..S INSNAM=$E(INSNAME,1,$S(+IBRPTPS:25,1:30))
..I IBOUT="E" S INSNAM=INSNAME ;Don't truncate Ins. name for EXCEL
..S SUBID=$$GET1^DIQ(365.192,IIUVAMC,1.03) ;Subscriber ID
..S SUBID=$S(IBOUT="R":$E(SUBID,1,20),1:SUBID) ;Truncate for REPORT
..S COB=$E($$GET1^DIQ(365.192,IIUVAMC,1.05,"E"),1)
..;
..S DATAREC=PNAME_U_PATSSN4_U_INSNAM_U_SUBID_U_COB_U_OVAMC_U_$$FMTE^XLFDT(RDATE,"2Z") ;STORE Originating VAMC info
..I +IBRPTPS S DATAREC=DATAREC_U_RPROCSTAT ;If including Receiver Processing Status
..I IBSORT="D" S ^TMP($J,IBCNIRTN,"DATE",RDATE,OVAMC,PNAME_U_PATSSN4_U_PATIEN_U_IIURCV)=DATAREC
..I IBSORT="F" S ^TMP($J,IBCNIRTN,"FNAME",OVAMC,RDATE,PNAME_U_PATSSN4_U_PATIEN_U_IIURCV)=DATAREC
..I IBSORT="P" S ^TMP($J,IBCNIRTN,"PNAME",PNAME_U_PATSSN4_U_PATIEN_U_IIURCV,RDATE,OVAMC)=DATAREC
Q
;
GETSENT ;Get SENT Data
N COB,DATAREC,DVAMC,DVAMCIEN,DVAMCNAM,DVAMCSTA,IIUIENS,IIUSNT,IIUVAMC,IIUVIENS,INSIEN,INSNAM
N PATIEN,PATSSN,PATSSN4,PNAME,SNTDTTM,SDATE,SDTTM,SUBID,VAMCSQ
;
S SNTDTTM=IBBDT ;Set the begin date
;
;Only want transmissions that were successfully SENT
F S SNTDTTM=$O(^IBCN(365.19,"SSR","S",SNTDTTM)) Q:SNTDTTM=""!((SNTDTTM\1)>IBEDT) D
.S IIUSNT=""
.F S IIUSNT=$O(^IBCN(365.19,"SSR","S",SNTDTTM,IIUSNT)) Q:IIUSNT="" D
..;
..S IIUIENS=IIUSNT_","
..;Patient IEN & Patient Name
..S PATIEN=$$GET1^DIQ(365.19,IIUIENS,.01,"I"),PNAME=$$GET1^DIQ(365.19,IIUIENS,.01)
..S PNAME=$S(IBOUT="R":$E(PNAME,1,28),1:PNAME) ; Truncate Patient Name for REPORT
..S PATSSN=$$GET1^DIQ(2,PATIEN_",",.09,"I")
..;Last 4 of Patient's SSN
..S PATSSN4=$S($E(PATSSN,$L(PATSSN))="P":$E(PATSSN,$L(PATSSN)-4,$L(PATSSN)),1:$E(PATSSN,$L(PATSSN)-3,$L(PATSSN)))
..S INSIEN=$$GET1^DIQ(365.19,IIUIENS,1.03,"E") ;Ins. Company IEN
..S INSNAM=$$GET1^DIQ(2.312,INSIEN_","_PATIEN_",",.01) ;Ins. Company Name
..S INSNAM=$S(IBOUT="R":$E(INSNAM,1,30),1:INSNAM) ;Truncate Ins. Company Name for REPORT
..S SUBID=$$GET1^DIQ(365.19,IIUIENS,1.06) ;Subscriber ID
..S SUBID=$S(IBOUT="R":$E(SUBID,1,20),1:SUBID) ;Truncate for REPORT
..S COB=$E($$GET1^DIQ(365.19,IIUIENS,1.07,"E"),1)
..;
..S IIUVIENS=0
..F S IIUVIENS=$O(^IBCN(365.19,"SSR","S",SNTDTTM,IIUSNT,IIUVIENS)) Q:'(+IIUVIENS) D ;Process each VAMC that was SENT to.
...S IIUVAMC=IIUVIENS_","_IIUIENS ;Get the Destination VAMC data
...I $$GET1^DIQ(365.191,IIUVAMC,.02,"I")'="S" Q ;Only want "S"ENT records
...S DVAMCIEN=$$GET1^DIQ(365.191,IIUVAMC,.01,"I") ;VAMC IEN
...I $G(IBCNFAC)'=1,'$D(IBCNFAC(DVAMCIEN)) Q ;**NOT a selected facility
...S DVAMCNAM=$$GET1^DIQ(365.191,IIUVAMC,.01,"E") ;VAMC name
...S DVAMCSTA=$$GET1^DIQ(4,DVAMCIEN,99,"E") ;VAMC station #
...S DVAMC=$S(IBOUT="R":$E(DVAMCNAM,1,22),1:DVAMCNAM)_" ("_+DVAMCSTA_")" ;VAMC name & station #
...S SDTTM=$$GET1^DIQ(365.191,IIUVAMC,.03,"I"),SDATE=SDTTM\1 ;Sent Date/Time
...;
...;If STORE counter data
...S $P(^TMP($J,IBCNIRTN),U,1)=$P($G(^TMP($J,IBCNIRTN)),U,1)+1 ;# of transmissions sent
...I '$D(^TMP($J,IBCNIRTN,"VAMCNAME",DVAMC)) D ;A new VAMC
....S $P(^TMP($J,IBCNIRTN),U,2)=$P(^TMP($J,IBCNIRTN),U,2)+1 ;# of VAMCs
...S ^TMP($J,IBCNIRTN,"VAMCNAME",DVAMC)=$G(^TMP($J,IBCNIRTN,"VAMCNAME",DVAMC))+1 ;increment # per VAMC
...I IBRPTSD="S" Q ;If SUMMARY quit
...;
...;If DETAIL, gather DETAILED SENT data
...S DATAREC=PNAME_U_PATSSN4_U_INSNAM_U_SUBID_U_COB_U_DVAMC_U_$$FMTE^XLFDT(SDATE,"2Z")
...I IBSORT="D" S ^TMP($J,IBCNIRTN,"DATE",SDATE,DVAMC,PNAME_U_PATSSN4_U_PATIEN_U_IIUSNT)=DATAREC
...I IBSORT="F" S ^TMP($J,IBCNIRTN,"FNAME",DVAMC,SDATE,PNAME_U_PATSSN4_U_PATIEN_U_IIUSNT)=DATAREC
...I IBSORT="P" S ^TMP($J,IBCNIRTN,"PNAME",PNAME_U_PATSSN4_U_PATIEN_U_IIUSNT,SDATE,DVAMC)=DATAREC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNIUR1 13118 printed Apr 09, 2024@21:16:17 Page 2
IBCNIUR1 ;AITC/VAD - Interfacility Ins. Update Report;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 ;ICR #10090 - File 4
+16 ;
+17 QUIT
+18 ;
EN ;entry point
+1 NEW %ZIS,I,IBCNFAC,IBCNIUR,IBCNIRTN,IBDFLTDT,IBOUT,IBRPTPS,IBRPTSD,IBRPTSR
+2 NEW IBRPTSRX,POP,STOP
+3 NEW ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE
+4 SET STOP=0
SET IBCNIRTN="IBCNIUR1"
+5 KILL ^TMP($JOB,IBCNIRTN)
+6 WRITE @IOF,!,"Interfacility Ins. Update Report",!
+7 ;
P10 ;Summary or Detail
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^S:Summary;D:Detailed;"
+4 SET DIR("A")="Summary or Detailed:// "
+5 SET DIR("??")="^D HELPDS^IBCNIUR1"
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
GOTO EXIT
+8 SET IBCNIUR("SD")=Y
SET IBRPTSD=Y
+9 IF IBCNIUR("SD")="S"
SET IBCNFAC=1
SET IBCNIUR("SORT")=""
+10 ;
P20 ;Received or Sent
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !!,"To view what your facility sent to other VAMCs choose SENT."
+3 WRITE !,"To view what your facility received from other VAMCs choose RECEIVED.",!
+4 SET DIR(0)="SA^S:Sent;R:Received"
+5 SET DIR("A")="Report Type - (S)ent or (R)eceived Report// "
+6 SET DIR("??")="^D HELPSR^IBCNIUR1"
+7 DO ^DIR
+8 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P10
+9 SET IBCNIUR("SR")=Y
SET IBRPTSR=Y
+10 WRITE !
+11 ;If the rpt is "Sent", skip Processing Status prompt
+12 IF IBCNIUR("SD")="S"!(IBCNIUR("SR")="S")
GOTO P30
+13 ;
P25 ;Include or exclude Processing Status
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !,"To know which records filed to buffer and which did not,"
+3 WRITE !,"select ""YES"" to include processing status.",!
+4 SET DIR(0)="Y"
SET DIR("A")="Include processing status"
+5 SET DIR("B")="YES"
SET DIR("??")="^D HELPPS^IBCNIUR1"
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P20
+8 SET IBCNIUR("PS")=Y
SET IBRPTPS=Y
KILL DIR
+9 WRITE !
+10 ;
P30 ;Get Default date
+1 SET IBRPTSRX=$SELECT(IBRPTSR="S":"SSR",1:"DIR")
+2 SET IBDFLTDT=$ORDER(^IBCN(365.19,IBRPTSRX,IBRPTSR,""))
+3 ;If no date, use the current date
IF IBDFLTDT=""
SET IBDFLTDT=$$NOW^XLFDT
+4 SET IBDFLTDT=IBDFLTDT\1
+5 ;
P35 ;Begin Date
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="D^::EX"
+3 SET DIR("A",1)=$SELECT(IBRPTSR="S":"Sent",1:"Receiving")_" Date Range:"
+4 SET DIR("A")=" Earliest Date "_$SELECT(IBRPTSR="R":"Received",1:"Sent")
+5 SET DIR("B")=$SELECT(IBDFLTDT:$$FMTE^XLFDT(IBDFLTDT,5),1:"")
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
if $$STOP^IBCNINSU
GOTO EXIT
if (IBCNIUR("SD")="S"!(IBCNIUR("SR")="S"))
GOTO P20
GOTO P25
+8 IF Y<IBDFLTDT!(Y>DT)
Begin DoDot:1
+9 WRITE !,"Invalid date entered."
+10 WRITE !,"Date must be within the range of ",$$FMTE^XLFDT(IBDFLTDT,5)," and ",$$FMTE^XLFDT(DT,5),"...please re-enter.",!
End DoDot:1
GOTO P35
+11 SET IBCNIUR("BEGDT")=Y
+12 ;
P36 ;End date
+1 KILL DIR("A")
+2 SET DIR("A")=" Latest Date "_$SELECT(IBRPTSR="S":"Sent",1:"Received")
SET DIR("B")="TODAY"
+3 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P35
+4 IF Y<IBCNIUR("BEGDT")
WRITE !," Latest Date must not precede the Earliest Date."
GOTO P36
+5 IF Y<IBCNIUR("BEGDT")!(Y>DT)
Begin DoDot:1
+6 WRITE !,"Invalid date entered."
+7 WRITE !,"Date must be within the range of ",$$FMTE^XLFDT(IBCNIUR("BEGDT"),5)," and ",$$FMTE^XLFDT(DT,5),"...please re-enter.",!
End DoDot:1
GOTO P36
+8 SET IBCNIUR("ENDDT")=Y
+9 ;
P40 ;Facility Selection
+1 WRITE !
+2 IF IBCNIUR("SD")="D"
DO INST^IBCNINSL(.IBCNFAC,$SELECT(IBCNIUR("SR")="S":"Destination",1:"Originating")_" Facility")
+3 IF $DATA(DUOUT)!$DATA(DTOUT)
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P35
+4 ;
P50 ;Report or Excel
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
IF $DATA(DIRUT)
if $$STOP^IBCNINSU
GOTO EXIT
if IBCNIUR("SD")="D"
GOTO P40
GOTO P35
+7 SET (IBOUT,IBCNIUR("IBOUT"))=Y
+8 IF IBCNIUR("IBOUT")="E"
SET IBCNIUR("SORT")="D"
GOTO P70
+9 ;
P60 ;Sort by Date, Patient or Facility
+1 ; If Summary, skip Facility prompt
IF IBCNIUR("SD")'="D"
GOTO P70
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 WRITE !
+4 SET DIR(0)="SA^D:Date "_$SELECT(IBCNIUR("SR")="S":"Sent",1:"Received")_";P:Patient Name;F:Facility "_$SELECT(IBCNIUR("SR")="S":"Destination",1:"Originated From")
+5 SET DIR("A",1)="Select one of the following:"
+6 SET DIR("A",2)=""
+7 SET DIR("A",3)=" D Date "_$SELECT(IBCNIUR("SR")="S":"Sent",1:"Received")
+8 SET DIR("A",4)=" P Patient Name"
+9 SET DIR("A",5)=" F Facility "_$SELECT(IBCNIUR("SR")="S":"Destination",1:"Originated From")
+10 SET DIR("A",6)=""
+11 SET DIR("A")="Sort the report by: "
+12 DO ^DIR
IF $DATA(DIRUT)
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P50
+13 SET IBCNIUR("SORT")=Y
+14 ;
P70 ; Proceed to compile the data and generate the output of the rpt
+1 SET STOP=0
+2 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 IF IBCNIUR("IBOUT")="R"
Begin DoDot:2
+4 ;For DETAIL
IF IBCNIUR("SD")="D"
WRITE !,"*** This report is 132 characters wide ***",!
End DoDot:2
QUIT
+5 WRITE !,"*** To avoid wrapping, enter '0;256;999' at the 'DEVICE' prompt. ***",!
End DoDot:1
+6 DO DEVICE(IBCNIRTN,.IBCNIUR,.IBCNFAC)
+7 IF +STOP
IF IBCNIUR("IBOUT")="E"
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P50
+8 IF +STOP
IF IBCNIUR("SD")'="D"
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P50
+9 IF +STOP
IF IBCNIUR("SD")="D"
if $$STOP^IBCNINSU
GOTO EXIT
GOTO P60
+10 GOTO EXIT
+11 ; =============================
DEVICE(IBCNIRTN,IBCNIUR,IBCNFAC) ; Device Handler and possible TaskManager calls
+1 ; Input params:
+2 ; IBCNIRTN = Routine name for ^TMP($J,...
+3 ; IBCNIUR = Array passed by ref of the report params
+4 ; IBOUT = "R" for Report format or "E" for Excel format
+5 ;
+6 NEW POP,ZTDESC,ZTRTN,ZTSAVE
+7 ;
+8 SET ZTRTN="COMPILE^IBCNIUR1(.IBCNFAC,.IBCNIUR,"""_IBCNIRTN_""")"
+9 SET ZTDESC="IBCNIU - Interfacility Ins. Update Report"
+10 SET ZTSAVE("IBCNFAC")=""
+11 SET ZTSAVE("IBCNFAC(")=""
+12 SET ZTSAVE("IBCNIUR(")=""
+13 SET ZTSAVE("IBCNIRTN")=""
+14 SET ZTSAVE("IBOUT")=""
+15 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
+16 IF POP
SET STOP=1
+17 QUIT
+18 ;
HELPDS ;Help for Summary/Detail
+1 WRITE !,"Please enter 'S' for 'Summary' or 'D' for a Detailed Report."
+2 QUIT
+3 ;
HELPPS ;Help for (W)ith or With(O)ut Processing Status
+1 WRITE !,"Enter 'YES' to include the processing status for the records received."
+2 WRITE !,"This identifies which records filed to the buffer and which did not."
+3 WRITE !,"Enter 'NO' to exclude the processing status on the report."
+4 QUIT
+5 ;
HELPSR ;Help for (S)ent or (R)eceived Report
+1 WRITE !,"Please enter 'R' for 'Received' or 'S' for 'Sent'."
+2 QUIT
+3 ;
EXIT ;
+1 KILL ^TMP($JOB,IBCNIRTN),IBCNIRTN,IBCNIUR
+2 QUIT
+3 ;
COMPILE(IBCNFAC,IBCNIUR,IBCNIRTN) ; Compile the data.
+1 NEW DSENT,FNAME,FSENT,IBBDT,IBEDT,IBOUT,IBRPTPS,IBRPTSD,IBRPTSR,IBSORT
+2 NEW PNAME,PSENT,SDATE,SITENO,SUBID
+3 ;Begin Date
SET IBBDT=$GET(IBCNIUR("BEGDT"))
+4 ;End Date
SET IBEDT=$GET(IBCNIUR("ENDDT"))
+5 ;"E"xcel, "R"eport
SET IBOUT=$GET(IBCNIUR("IBOUT"))
+6 ;Processing status: 1-With, 0-Without
SET IBRPTPS=$GET(IBCNIUR("PS"))
+7 ;"S"ummary or "D"etail
SET IBRPTSD=$GET(IBCNIUR("SD"))
+8 ;"S"ent or "R"eceived
SET IBRPTSR=$GET(IBCNIUR("SR"))
+9 ;"D"ate or "F"acility or "P"atient
SET IBSORT=$GET(IBCNIUR("SORT"))
+10 SET ^TMP($JOB,IBCNIRTN)=0
+11 ;
+12 ;Get RECEIVED data
IF IBRPTSR="R"
DO GETRECV
+13 ;Get SENT data
IF IBRPTSR="S"
DO GETSENT
+14 DO PRINT^IBCNIUR2
+15 QUIT
+16 ;
GETRECV ;Get RECEIVED Data
+1 NEW COB,DATAREC,IIUIENS,IIURCV,IIUVAMC,INSNAM,INSNAME,OVAMC,OVAMCIEN,OVAMCNAM,OVAMCSTA
+2 NEW PATIEN,PATSSN,PATSSN4,PNAME,RCVDTTM,RDATE,RDTTM,RPROCSTAT,SUBID,VAMCSQ
+3 ;
+4 ;Set begin date
SET RCVDTTM=IBBDT
+5 FOR
SET RCVDTTM=$ORDER(^IBCN(365.19,"DIR","R",RCVDTTM))
if RCVDTTM=""!((RCVDTTM\1)>IBEDT)
QUIT
Begin DoDot:1
+6 SET IIURCV=""
+7 ;Loop thru receiving records by date
+8 FOR
SET IIURCV=$ORDER(^IBCN(365.19,"DIR","R",RCVDTTM,IIURCV))
if IIURCV=""
QUIT
Begin DoDot:2
+9 SET IIUIENS=IIURCV_","
+10 ;Patient IEN & Patient Name
SET PATIEN=$$GET1^DIQ(365.19,IIUIENS,.01,"I")
SET PNAME=$$GET1^DIQ(365.19,IIUIENS,.01)
+11 ;Truncate for REPORT
SET PNAME=$SELECT(IBOUT="R":$EXTRACT(PNAME,1,25),1:PNAME)
+12 SET PATSSN=$$GET1^DIQ(2,PATIEN_",",.09,"I")
+13 ;Last 4 of Patient's SSN
+14 SET PATSSN4=$SELECT($EXTRACT(PATSSN,$LENGTH(PATSSN))="P":$EXTRACT(PATSSN,$LENGTH(PATSSN)-4,$LENGTH(PATSSN)),1:$EXTRACT(PATSSN,$LENGTH(PATSSN)-3,$LENGTH(PATSSN)))
+15 ;Received Date/Time
SET RDTTM=$$GET1^DIQ(365.19,IIUIENS,2.02,"I")
SET RDATE=RDTTM\1
+16 ;get the RECEIVER PROCESSING STATUS
SET RPROCSTAT=$$GET1^DIQ(365.19,IIUIENS,2.01,"E")
+17 ;Truncate for REPORT
SET RPROCSTAT=$SELECT(IBOUT="R":$EXTRACT(RPROCSTAT,1,23),1:RPROCSTAT)
+18 ;
+19 ;get the Originating VAMC data
SET IIUVAMC="1,"_IIUIENS
+20 ;VAMC IEN
SET OVAMCIEN=$$GET1^DIQ(365.192,IIUVAMC,.01,"I")
+21 ;** NOT a selected facility
IF $GET(IBCNFAC)'=1
IF '$DATA(IBCNFAC(OVAMCIEN))
QUIT
+22 ;VAMC name
SET OVAMCNAM=$$GET1^DIQ(365.192,IIUVAMC,.01,"E")
+23 ;VAMC station # (ICR #10090)
SET OVAMCSTA=$$GET1^DIQ(4,OVAMCIEN,99,"E")
+24 ;VAMC name & station #
SET OVAMC=$EXTRACT(OVAMCNAM,1,$SELECT(+IBRPTPS:11,1:22))_" ("_+OVAMCSTA_")"
+25 ;Don't truncate VAMC name/station for EXCEL
IF IBOUT="E"
SET OVAMC=OVAMCNAM_" ("_+OVAMCSTA_")"
+26 ;
+27 ;STORE counter data.
+28 ;# of transmissions received
SET $PIECE(^TMP($JOB,IBCNIRTN),U,1)=$PIECE($GET(^TMP($JOB,IBCNIRTN)),U,1)+1
+29 ;A new VAMC
IF '$DATA(^TMP($JOB,IBCNIRTN,"VAMCNAME",OVAMC))
Begin DoDot:3
+30 ;# of VAMCs
SET $PIECE(^TMP($JOB,IBCNIRTN),U,2)=$PIECE(^TMP($JOB,IBCNIRTN),U,2)+1
End DoDot:3
+31 ;increment # per VAMC
SET ^TMP($JOB,IBCNIRTN,"VAMCNAME",OVAMC)=$GET(^TMP($JOB,IBCNIRTN,"VAMCNAME",OVAMC))+1
+32 ;If SUMMARY quit
IF IBRPTSD="S"
QUIT
+33 ;
+34 ;If DETAIL, gather DETAILED RECEIVED data
+35 ;Insurance Company Name
SET INSNAME=$$GET1^DIQ(365.192,IIUVAMC,.03,"E")
+36 SET INSNAM=$EXTRACT(INSNAME,1,$SELECT(+IBRPTPS:25,1:30))
+37 ;Don't truncate Ins. name for EXCEL
IF IBOUT="E"
SET INSNAM=INSNAME
+38 ;Subscriber ID
SET SUBID=$$GET1^DIQ(365.192,IIUVAMC,1.03)
+39 ;Truncate for REPORT
SET SUBID=$SELECT(IBOUT="R":$EXTRACT(SUBID,1,20),1:SUBID)
+40 SET COB=$EXTRACT($$GET1^DIQ(365.192,IIUVAMC,1.05,"E"),1)
+41 ;
+42 ;STORE Originating VAMC info
SET DATAREC=PNAME_U_PATSSN4_U_INSNAM_U_SUBID_U_COB_U_OVAMC_U_$$FMTE^XLFDT(RDATE,"2Z")
+43 ;If including Receiver Processing Status
IF +IBRPTPS
SET DATAREC=DATAREC_U_RPROCSTAT
+44 IF IBSORT="D"
SET ^TMP($JOB,IBCNIRTN,"DATE",RDATE,OVAMC,PNAME_U_PATSSN4_U_PATIEN_U_IIURCV)=DATAREC
+45 IF IBSORT="F"
SET ^TMP($JOB,IBCNIRTN,"FNAME",OVAMC,RDATE,PNAME_U_PATSSN4_U_PATIEN_U_IIURCV)=DATAREC
+46 IF IBSORT="P"
SET ^TMP($JOB,IBCNIRTN,"PNAME",PNAME_U_PATSSN4_U_PATIEN_U_IIURCV,RDATE,OVAMC)=DATAREC
End DoDot:2
End DoDot:1
+47 QUIT
+48 ;
GETSENT ;Get SENT Data
+1 NEW COB,DATAREC,DVAMC,DVAMCIEN,DVAMCNAM,DVAMCSTA,IIUIENS,IIUSNT,IIUVAMC,IIUVIENS,INSIEN,INSNAM
+2 NEW PATIEN,PATSSN,PATSSN4,PNAME,SNTDTTM,SDATE,SDTTM,SUBID,VAMCSQ
+3 ;
+4 ;Set the begin date
SET SNTDTTM=IBBDT
+5 ;
+6 ;Only want transmissions that were successfully SENT
+7 FOR
SET SNTDTTM=$ORDER(^IBCN(365.19,"SSR","S",SNTDTTM))
if SNTDTTM=""!((SNTDTTM\1)>IBEDT)
QUIT
Begin DoDot:1
+8 SET IIUSNT=""
+9 FOR
SET IIUSNT=$ORDER(^IBCN(365.19,"SSR","S",SNTDTTM,IIUSNT))
if IIUSNT=""
QUIT
Begin DoDot:2
+10 ;
+11 SET IIUIENS=IIUSNT_","
+12 ;Patient IEN & Patient Name
+13 SET PATIEN=$$GET1^DIQ(365.19,IIUIENS,.01,"I")
SET PNAME=$$GET1^DIQ(365.19,IIUIENS,.01)
+14 ; Truncate Patient Name for REPORT
SET PNAME=$SELECT(IBOUT="R":$EXTRACT(PNAME,1,28),1:PNAME)
+15 SET PATSSN=$$GET1^DIQ(2,PATIEN_",",.09,"I")
+16 ;Last 4 of Patient's SSN
+17 SET PATSSN4=$SELECT($EXTRACT(PATSSN,$LENGTH(PATSSN))="P":$EXTRACT(PATSSN,$LENGTH(PATSSN)-4,$LENGTH(PATSSN)),1:$EXTRACT(PATSSN,$LENGTH(PATSSN)-3,$LENGTH(PATSSN)))
+18 ;Ins. Company IEN
SET INSIEN=$$GET1^DIQ(365.19,IIUIENS,1.03,"E")
+19 ;Ins. Company Name
SET INSNAM=$$GET1^DIQ(2.312,INSIEN_","_PATIEN_",",.01)
+20 ;Truncate Ins. Company Name for REPORT
SET INSNAM=$SELECT(IBOUT="R":$EXTRACT(INSNAM,1,30),1:INSNAM)
+21 ;Subscriber ID
SET SUBID=$$GET1^DIQ(365.19,IIUIENS,1.06)
+22 ;Truncate for REPORT
SET SUBID=$SELECT(IBOUT="R":$EXTRACT(SUBID,1,20),1:SUBID)
+23 SET COB=$EXTRACT($$GET1^DIQ(365.19,IIUIENS,1.07,"E"),1)
+24 ;
+25 SET IIUVIENS=0
+26 ;Process each VAMC that was SENT to.
FOR
SET IIUVIENS=$ORDER(^IBCN(365.19,"SSR","S",SNTDTTM,IIUSNT,IIUVIENS))
if '(+IIUVIENS)
QUIT
Begin DoDot:3
+27 ;Get the Destination VAMC data
SET IIUVAMC=IIUVIENS_","_IIUIENS
+28 ;Only want "S"ENT records
IF $$GET1^DIQ(365.191,IIUVAMC,.02,"I")'="S"
QUIT
+29 ;VAMC IEN
SET DVAMCIEN=$$GET1^DIQ(365.191,IIUVAMC,.01,"I")
+30 ;**NOT a selected facility
IF $GET(IBCNFAC)'=1
IF '$DATA(IBCNFAC(DVAMCIEN))
QUIT
+31 ;VAMC name
SET DVAMCNAM=$$GET1^DIQ(365.191,IIUVAMC,.01,"E")
+32 ;VAMC station #
SET DVAMCSTA=$$GET1^DIQ(4,DVAMCIEN,99,"E")
+33 ;VAMC name & station #
SET DVAMC=$SELECT(IBOUT="R":$EXTRACT(DVAMCNAM,1,22),1:DVAMCNAM)_" ("_+DVAMCSTA_")"
+34 ;Sent Date/Time
SET SDTTM=$$GET1^DIQ(365.191,IIUVAMC,.03,"I")
SET SDATE=SDTTM\1
+35 ;
+36 ;If STORE counter data
+37 ;# of transmissions sent
SET $PIECE(^TMP($JOB,IBCNIRTN),U,1)=$PIECE($GET(^TMP($JOB,IBCNIRTN)),U,1)+1
+38 ;A new VAMC
IF '$DATA(^TMP($JOB,IBCNIRTN,"VAMCNAME",DVAMC))
Begin DoDot:4
+39 ;# of VAMCs
SET $PIECE(^TMP($JOB,IBCNIRTN),U,2)=$PIECE(^TMP($JOB,IBCNIRTN),U,2)+1
End DoDot:4
+40 ;increment # per VAMC
SET ^TMP($JOB,IBCNIRTN,"VAMCNAME",DVAMC)=$GET(^TMP($JOB,IBCNIRTN,"VAMCNAME",DVAMC))+1
+41 ;If SUMMARY quit
IF IBRPTSD="S"
QUIT
+42 ;
+43 ;If DETAIL, gather DETAILED SENT data
+44 SET DATAREC=PNAME_U_PATSSN4_U_INSNAM_U_SUBID_U_COB_U_DVAMC_U_$$FMTE^XLFDT(SDATE,"2Z")
+45 IF IBSORT="D"
SET ^TMP($JOB,IBCNIRTN,"DATE",SDATE,DVAMC,PNAME_U_PATSSN4_U_PATIEN_U_IIUSNT)=DATAREC
+46 IF IBSORT="F"
SET ^TMP($JOB,IBCNIRTN,"FNAME",DVAMC,SDATE,PNAME_U_PATSSN4_U_PATIEN_U_IIUSNT)=DATAREC
+47 IF IBSORT="P"
SET ^TMP($JOB,IBCNIRTN,"PNAME",PNAME_U_PATSSN4_U_PATIEN_U_IIUSNT,SDATE,DVAMC)=DATAREC
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
