BPSKBERPT ; AITC/PED - K Bill Error Report;07/2023
;;1.0;E CLAIMS MGMT ENGINE;**36**;JUN 2004;Build 16
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to file 366.14 in ICR #4299
;
Q
;
EN ; Entry Point for Report
;
N BPSEXCEL,BPSTMP,DATERNG
;
W @IOF,!,"ECME Bills Created with Errors Report",!!
;
S BPSTMP=$NA(^TMP($J,"BPSKBE"))
K @BPSTMP
;
; Get date range
S DATERNG=$$DATES
I DATERNG="^" Q
;
; Capture data in Excel format?
S BPSEXCEL=$$EXCEL I BPSEXCEL="^" Q
;
; Prompt user for device
D DEVICE
;
Q
;
DATES() ; Date range prompts
;
; Date range will be stored in variable DATERNG
; DATERNG = START WITH DATE ^ GO TO DATE
;
N DATERNG,DIR,DTOUT,DUOUT,X,Y
;
S DATERNG=""
S DIR(0)="DA^:DT:EX"
S DIR("A")="START WITH CLAIM ENTERED DATE: "
S DIR("B")="T-14"
D ^DIR
;
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S DATERNG="^" Q DATERNG
;
S $P(DATERNG,"^")=Y
;
S DIR(0)="DA^"_DATERNG_":DT:EX"
S DIR("A")=" GO TO CLAIM ENTERED DATE: "
S DIR("B")="T"
D ^DIR
;
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S DATERNG="^" Q DATERNG
;
S $P(DATERNG,"^",2)=Y
;
Q DATERNG
;
EXCEL() ; Capture data in Excel format prompt
;
N BPSEXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
;
S BPSEXCEL=0
S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
S DIR("A")="Do you want to capture report data for an Excel document"
S DIR("?")="^D EXHELP^BPSKBERPT"
;
D ^DIR
K DIR
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
I Y S BPSEXCEL=1
;
;Display Excel device info
I BPSEXCEL=1 D
. W !!?5,"Before continuing, please set up your terminal to capture the"
. W !?5,"detail report data and save the detail report data in a text file"
. W !?5,"to a local drive. This report may take a while to run."
. W !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
. W !?5," please enter '0;256;99999' at the 'DEVICE:' prompt.",!
;
Q BPSEXCEL
;
EXHELP ; - 'Do you want to capture data...' prompt
W !!," Enter: 'Y' - To capture detail report data to transfer"
W !," to an Excel document"
W !," '<CR>' - To skip this option"
W !," '^' - To quit this option"
Q
;
DEVICE ; Device selection prompt
;
N ZTRTN,ZTDESC,ZTSAVE,ZTSK,DIR,X,Y
;
I 'BPSEXCEL D
. W !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED."
. W !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",!
;
S ZTRTN="COMPILE^BPSKBERPT"
S ZTDESC="ECME Bills Created with Errors"
S ZTSAVE("BPSTMP")=""
S ZTSAVE("DATERNG")=""
S ZTSAVE("BPSEXCEL")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR
Q
;
COMPILE ; Compile data using file 366.14
;
N BPSQUIT,DATE1,DATE2,IEN36614,IEN366141,IEN399,X
;
S DATE1=$P(DATERNG,"^")-.5
S DATE2=$P(DATERNG,"^",2)
;
F S DATE1=$O(^IBCNR(366.14,"B",DATE1)) Q:DATE1=""!(DATE1>DATE2) D
. S IEN36614=""
. F S IEN36614=$O(^IBCNR(366.14,"B",DATE1,IEN36614)) Q:IEN36614="" D
. . S IEN366141=0
. . F S IEN366141=$O(^IBCNR(366.14,IEN36614,1,"B",3,IEN366141)) Q:'IEN366141 D
. . . S IEN399=$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.301,"I")
. . . ; Don't include if bill has been cancelled
. . . I $$GET1^DIQ(399,IEN399,16,"I")=1 Q
. . . ; AR Status must be "BILL INCOMPLETE"
. . . I $P($$ARSTATA^IBJTU4(IEN399),"^")'="BILL INCOMPLETE" Q
. . . S @BPSTMP@(IEN36614,IEN366141)=DATE1
;
D PRINT
;
; Close the device
D ^%ZISC
;
;Purge the task
I $D(ZTQUEUED) S ZTREQ="@"
;
; Kill scratch global
K @BPSTMP
;
I $G(BPSQUIT) Q
;
; Pause screen so report can be viewed
U IO(0) W !!,"Press RETURN to continue:"
R X:300
U IO
;
Q
;
PRINT ; Print data
;
N BPSPG,BPSPTDT,DATE,DIR,DIRUT,DUOUT,IEN36614,IEN366141,IEN50,X
;
S BPSPG=1
S BPSQUIT=0
S BPSPTDT=$$HTE^XLFDT($H)
D HDR(BPSPG)
;
S IEN36614=""
F S IEN36614=$O(@BPSTMP@(IEN36614)) Q:IEN36614=""!(BPSQUIT) D
. S IEN366141=""
. F S IEN366141=$O(@BPSTMP@(IEN36614,IEN366141)) Q:IEN366141=""!(BPSQUIT) D
. . S X=@BPSTMP@(IEN36614,IEN366141)
. . S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
. . ;
. . ; Display data in readable format
. . I 'BPSEXCEL D
. . . W !,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.301)
. . . W ?12,$E($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.03),1,30)
. . . W ?45,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.201)
. . . W ?57,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.203)_"/"
. . . W $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.13)
. . . W ?73,DATE
. . . S IEN50=$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.204)
. . . W ?86,$E($$GET1^DIQ(50,IEN50,.01),1,40)
. . . W ?130,$E($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",7.01),1)
. . . ;
. . . I $Y>(IOSL-3) D
. . . . I $E(IOST,1,2)="C-" D
. . . . . W !
. . . . . S DIR(0)="E"
. . . . . D ^DIR
. . . . . K DIR
. . . . . I $D(DIRUT)!($D(DUOUT)) S BPSQUIT=1 K DIRUT,DTOUT,DUOUT
. . . . Q:BPSQUIT
. . . . S BPSPG=BPSPG+1
. . . . D HDR(BPSPG)
. . ;
. . ; Display data in Excel format
. . I BPSEXCEL D
. . . W !,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.301)_"^"
. . . W $E($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.03),1,30)_"^"
. . . W $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.201)_"^"
. . . W $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.203)_"/"
. . . W $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.13)_"^"
. . . W DATE_"^"
. . . S IEN50=$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.204)
. . . W $E($$GET1^DIQ(50,IEN50,.01),1,40)_"^"
. . . W $E($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",7.01),1)_"^"
. . . W $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.08)
;
I 'BPSEXCEL W !!,?5,"*** End of Report ***",!
;
Q
;
HDR(BPSPG) ; Print header
;
N BPSI
;
; Excel header
I BPSEXCEL D Q
. W !,"BILL#^PATIENT^RX#^REF/ECME#^DATE^DRUG^COB^ERROR"
;
W @IOF
;
; Report header
W !,"ECME BILLS CREATED WITH ERRORS"
W ?88,"Print Date: "_BPSPTDT
W ?123,"Page: ",$J(BPSPG,3)
W !,"CLAIM DATE: Start "_$$FMTE^XLFDT($P(DATERNG,"^"),2)
W " Go to "_$$FMTE^XLFDT($P(DATERNG,"^",2),2)
W ! F BPSI=1:1:132 W "="
W !,"BILL#"
W ?12,"PATIENT NAME"
W ?45,"RX#"
W ?57,"REF/ECME #"
W ?73,"FILL DATE"
W ?86,"DRUG"
W ?129,"COB"
W ! F BPSI=1:1:132 W "="
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSKBERPT 6511 printed Dec 13, 2024@01:51:12 Page 2
BPSKBERPT ; AITC/PED - K Bill Error Report;07/2023
+1 ;;1.0;E CLAIMS MGMT ENGINE;**36**;JUN 2004;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to file 366.14 in ICR #4299
+5 ;
+6 QUIT
+7 ;
EN ; Entry Point for Report
+1 ;
+2 NEW BPSEXCEL,BPSTMP,DATERNG
+3 ;
+4 WRITE @IOF,!,"ECME Bills Created with Errors Report",!!
+5 ;
+6 SET BPSTMP=$NAME(^TMP($JOB,"BPSKBE"))
+7 KILL @BPSTMP
+8 ;
+9 ; Get date range
+10 SET DATERNG=$$DATES
+11 IF DATERNG="^"
QUIT
+12 ;
+13 ; Capture data in Excel format?
+14 SET BPSEXCEL=$$EXCEL
IF BPSEXCEL="^"
QUIT
+15 ;
+16 ; Prompt user for device
+17 DO DEVICE
+18 ;
+19 QUIT
+20 ;
DATES() ; Date range prompts
+1 ;
+2 ; Date range will be stored in variable DATERNG
+3 ; DATERNG = START WITH DATE ^ GO TO DATE
+4 ;
+5 NEW DATERNG,DIR,DTOUT,DUOUT,X,Y
+6 ;
+7 SET DATERNG=""
+8 SET DIR(0)="DA^:DT:EX"
+9 SET DIR("A")="START WITH CLAIM ENTERED DATE: "
+10 SET DIR("B")="T-14"
+11 DO ^DIR
+12 ;
+13 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET DATERNG="^"
QUIT DATERNG
+14 ;
+15 SET $PIECE(DATERNG,"^")=Y
+16 ;
+17 SET DIR(0)="DA^"_DATERNG_":DT:EX"
+18 SET DIR("A")=" GO TO CLAIM ENTERED DATE: "
+19 SET DIR("B")="T"
+20 DO ^DIR
+21 ;
+22 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET DATERNG="^"
QUIT DATERNG
+23 ;
+24 SET $PIECE(DATERNG,"^",2)=Y
+25 ;
+26 QUIT DATERNG
+27 ;
EXCEL() ; Capture data in Excel format prompt
+1 ;
+2 NEW BPSEXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
+3 ;
+4 SET BPSEXCEL=0
+5 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("T")=DTIME
WRITE !
+6 SET DIR("A")="Do you want to capture report data for an Excel document"
+7 SET DIR("?")="^D EXHELP^BPSKBERPT"
+8 ;
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT "^"
+12 IF Y
SET BPSEXCEL=1
+13 ;
+14 ;Display Excel device info
+15 IF BPSEXCEL=1
Begin DoDot:1
+16 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+17 WRITE !?5,"detail report data and save the detail report data in a text file"
+18 WRITE !?5,"to a local drive. This report may take a while to run."
+19 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
+20 WRITE !?5," please enter '0;256;99999' at the 'DEVICE:' prompt.",!
End DoDot:1
+21 ;
+22 QUIT BPSEXCEL
+23 ;
EXHELP ; - 'Do you want to capture data...' prompt
+1 WRITE !!," Enter: 'Y' - To capture detail report data to transfer"
+2 WRITE !," to an Excel document"
+3 WRITE !," '<CR>' - To skip this option"
+4 WRITE !," '^' - To quit this option"
+5 QUIT
+6 ;
DEVICE ; Device selection prompt
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTSAVE,ZTSK,DIR,X,Y
+3 ;
+4 IF 'BPSEXCEL
Begin DoDot:1
+5 WRITE !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED."
+6 WRITE !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",!
End DoDot:1
+7 ;
+8 SET ZTRTN="COMPILE^BPSKBERPT"
+9 SET ZTDESC="ECME Bills Created with Errors"
+10 SET ZTSAVE("BPSTMP")=""
+11 SET ZTSAVE("DATERNG")=""
+12 SET ZTSAVE("BPSEXCEL")=""
+13 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+14 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
+15 QUIT
+16 ;
COMPILE ; Compile data using file 366.14
+1 ;
+2 NEW BPSQUIT,DATE1,DATE2,IEN36614,IEN366141,IEN399,X
+3 ;
+4 SET DATE1=$PIECE(DATERNG,"^")-.5
+5 SET DATE2=$PIECE(DATERNG,"^",2)
+6 ;
+7 FOR
SET DATE1=$ORDER(^IBCNR(366.14,"B",DATE1))
if DATE1=""!(DATE1>DATE2)
QUIT
Begin DoDot:1
+8 SET IEN36614=""
+9 FOR
SET IEN36614=$ORDER(^IBCNR(366.14,"B",DATE1,IEN36614))
if IEN36614=""
QUIT
Begin DoDot:2
+10 SET IEN366141=0
+11 FOR
SET IEN366141=$ORDER(^IBCNR(366.14,IEN36614,1,"B",3,IEN366141))
if 'IEN366141
QUIT
Begin DoDot:3
+12 SET IEN399=$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.301,"I")
+13 ; Don't include if bill has been cancelled
+14 IF $$GET1^DIQ(399,IEN399,16,"I")=1
QUIT
+15 ; AR Status must be "BILL INCOMPLETE"
+16 IF $PIECE($$ARSTATA^IBJTU4(IEN399),"^")'="BILL INCOMPLETE"
QUIT
+17 SET @BPSTMP@(IEN36614,IEN366141)=DATE1
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 DO PRINT
+20 ;
+21 ; Close the device
+22 DO ^%ZISC
+23 ;
+24 ;Purge the task
+25 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+26 ;
+27 ; Kill scratch global
+28 KILL @BPSTMP
+29 ;
+30 IF $GET(BPSQUIT)
QUIT
+31 ;
+32 ; Pause screen so report can be viewed
+33 USE IO(0)
WRITE !!,"Press RETURN to continue:"
+34 READ X:300
+35 USE IO
+36 ;
+37 QUIT
+38 ;
PRINT ; Print data
+1 ;
+2 NEW BPSPG,BPSPTDT,DATE,DIR,DIRUT,DUOUT,IEN36614,IEN366141,IEN50,X
+3 ;
+4 SET BPSPG=1
+5 SET BPSQUIT=0
+6 SET BPSPTDT=$$HTE^XLFDT($HOROLOG)
+7 DO HDR(BPSPG)
+8 ;
+9 SET IEN36614=""
+10 FOR
SET IEN36614=$ORDER(@BPSTMP@(IEN36614))
if IEN36614=""!(BPSQUIT)
QUIT
Begin DoDot:1
+11 SET IEN366141=""
+12 FOR
SET IEN366141=$ORDER(@BPSTMP@(IEN36614,IEN366141))
if IEN366141=""!(BPSQUIT)
QUIT
Begin DoDot:2
+13 SET X=@BPSTMP@(IEN36614,IEN366141)
+14 SET DATE=$SELECT(X:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3),1:"")
+15 ;
+16 ; Display data in readable format
+17 IF 'BPSEXCEL
Begin DoDot:3
+18 WRITE !,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.301)
+19 WRITE ?12,$EXTRACT($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.03),1,30)
+20 WRITE ?45,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.201)
+21 WRITE ?57,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.203)_"/"
+22 WRITE $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.13)
+23 WRITE ?73,DATE
+24 SET IEN50=$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.204)
+25 WRITE ?86,$EXTRACT($$GET1^DIQ(50,IEN50,.01),1,40)
+26 WRITE ?130,$EXTRACT($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",7.01),1)
+27 ;
+28 IF $Y>(IOSL-3)
Begin DoDot:4
+29 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:5
+30 WRITE !
+31 SET DIR(0)="E"
+32 DO ^DIR
+33 KILL DIR
+34 IF $DATA(DIRUT)!($DATA(DUOUT))
SET BPSQUIT=1
KILL DIRUT,DTOUT,DUOUT
End DoDot:5
+35 if BPSQUIT
QUIT
+36 SET BPSPG=BPSPG+1
+37 DO HDR(BPSPG)
End DoDot:4
End DoDot:3
+38 ;
+39 ; Display data in Excel format
+40 IF BPSEXCEL
Begin DoDot:3
+41 WRITE !,$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.301)_"^"
+42 WRITE $EXTRACT($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.03),1,30)_"^"
+43 WRITE $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.201)_"^"
+44 WRITE $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.203)_"/"
+45 WRITE $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.13)_"^"
+46 WRITE DATE_"^"
+47 SET IEN50=$$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.204)
+48 WRITE $EXTRACT($$GET1^DIQ(50,IEN50,.01),1,40)_"^"
+49 WRITE $EXTRACT($$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",7.01),1)_"^"
+50 WRITE $$GET1^DIQ(366.141,IEN366141_","_IEN36614_",",.08)
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 IF 'BPSEXCEL
WRITE !!,?5,"*** End of Report ***",!
+53 ;
+54 QUIT
+55 ;
HDR(BPSPG) ; Print header
+1 ;
+2 NEW BPSI
+3 ;
+4 ; Excel header
+5 IF BPSEXCEL
Begin DoDot:1
+6 WRITE !,"BILL#^PATIENT^RX#^REF/ECME#^DATE^DRUG^COB^ERROR"
End DoDot:1
QUIT
+7 ;
+8 WRITE @IOF
+9 ;
+10 ; Report header
+11 WRITE !,"ECME BILLS CREATED WITH ERRORS"
+12 WRITE ?88,"Print Date: "_BPSPTDT
+13 WRITE ?123,"Page: ",$JUSTIFY(BPSPG,3)
+14 WRITE !,"CLAIM DATE: Start "_$$FMTE^XLFDT($PIECE(DATERNG,"^"),2)
+15 WRITE " Go to "_$$FMTE^XLFDT($PIECE(DATERNG,"^",2),2)
+16 WRITE !
FOR BPSI=1:1:132
WRITE "="
+17 WRITE !,"BILL#"
+18 WRITE ?12,"PATIENT NAME"
+19 WRITE ?45,"RX#"
+20 WRITE ?57,"REF/ECME #"
+21 WRITE ?73,"FILL DATE"
+22 WRITE ?86,"DRUG"
+23 WRITE ?129,"COB"
+24 WRITE !
FOR BPSI=1:1:132
WRITE "="
+25 ;
+26 QUIT
