IBTRHRD ;ALB/JWS - CLAIMS TRACKING 278 DISPOSITION REPORT ;21-SEP-2015
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
% ;
; FILTERS array is built
; FILTERS(0)[1] = 1 if report by Staff
; 2 if report by Patient
; 3 if report by Date
; FILTERS(0)[2] =
; FILTERS(0)[3] = 0 (or null) if All staff, 1 if selected staff
; FILTERS(0)[4] = 0 (or null) if All Patients, 1 if selected patients
; FILTERS(0)[5] =
; FILTERS(0)[6] = sort, 1 = name, 2 = date
; FILTERS(2,staff name) = ien
; FILTERS(3,patient name) = ien
; FILTERS(4)[1] = from date
; FILTERS(4)[2] = through date
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RPTDATE,IBQUIT,FILTERS,OK
I '$D(DT) D DT^DICRW
W !!,"278 Deletion Disposition Report"
; selection filter
S DIR(0)="S^1:Report by Staff;2:Report by Patient;3:Report by Date Range^I '$F("",1,2,3"","",""_X) K X"
S DIR("A")="Select the type of report to generate"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)="1 Report by Staff"
S DIR("L",4)="2 Report by Patient"
S DIR("L",5)="3 Report by Date Range"
S DIR("?",1)="Select how you wish to select the entries to display on the report."
S DIR("?",2)=""
S DIR("?",3)="1 will allow you to select one or more Staff members to report on."
S DIR("?",4)="2 will allow you to select one or more Patients to report on."
S DIR("?")="3 will allow you to select a Date Range of 278 transactions to report on."
W ! D ^DIR K DIR
I $G(DIRUT) Q
S FILTERS(0)=Y
I Y=1 D STAFF G 1
I Y=3 G 1
I Y=2 D PAT
;
1 ;
S RPTDATE=$$FMDATES("") I RPTDATE="" Q
S FILTERS(4)=RPTDATE
S DIR(0)="Y",DIR("A")="Include Delete Reason",DIR("B")="NO"
S DIR("?",1)=" Enter: 'Y' - to include the Delete Reason Codes on report."
S DIR("?",2)=" 'N' - to exclude the Delete Reason Codes on report."
S DIR("?")=" '^' - to exit this report."
D ^DIR K DIR
I $G(DIRUT) Q
S $P(FILTERS(0),"^",8)=+Y
I $P(FILTERS(0),"^")=3 S $P(FILTERS(0),"^",6)=2 G 4
;I $P(FILTERS(0),"^")=1 G 2
I $P(FILTERS(0),"^")=2 G 3
;
2 ;
S OK=1,X=$P(FILTERS(0),"^",3)
I X S X=$O(FILTERS(2,"")) I X,$O(FILTERS(2,X))="" S OK=0,$P(FILTERS(0),"^",6)=1
I OK D I $G(DIRUT) Q
. S DIR(0)="S^1:Staff Name;2:Date^I '$F("",1,2"",X) K X"
. S DIR("A")="Select the Primary Sort"
. S DIR("L",1)="Select one of the following:"
. S DIR("L",2)=""
. S DIR("L",3)="1 Staff Name"
. S DIR("L",4)="2 Date"
. S DIR("?",1)="Select how you wish to sort the entries on this report."
. S DIR("?",2)=""
. S DIR("?",3)="1 will sort the entries by Staff Name."
. S DIR("?")="2 will sort the entries by 278 Transaction Date."
. W ! D ^DIR K DIR
. I $G(DIRUT) Q
. S $P(FILTERS(0),"^",6)=Y
. Q
G 4
;
3 ;
S OK=1,X=$P(FILTERS(0),"^",4)
I X S X=$O(FILTERS(3,"")) I X,$O(FILTERS(3,X))="" S OK=0,$P(FILTERS(0),"^",6)=1
I OK D I $G(DIRUT) Q
. S DIR(0)="S^1:Patient Name;2:Date^I '$F("",1,2"",X) K X"
. S DIR("A")="Select the Primary Sort"
. S DIR("L",1)="Select one of the following:"
. S DIR("L",2)=""
. S DIR("L",3)="1 Patient Name"
. S DIR("L",4)="2 Date"
. S DIR("?",1)="Select how you wish to sort the entries on this report."
. S DIR("?",2)=""
. S DIR("?",3)="1 will sort the entries by Patient Name."
. S DIR("?")="2 will sort the entries by 278 Transaction Date."
. W ! D ^DIR K DIR
. I $G(DIRUT) Q
. S $P(FILTERS(0),"^",6)=Y
. Q
4 ;
D DEV
Q
;
STAFF ; Staff ( New Person file) filter
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="S",DIR("A")="Select(A)ll or (S)elected Staff",DIR("B")="All"
S DIR("?",1)="Enter 'A' to select all Staff Members."
S DIR("?")="Enter 'S' to select specific Staff Members."
S $P(DIR(0),"^",2)="A:All Staff Members;S:Selected Staff Members"
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),"^",3)=$S(Y="A":0,1:1)
; Set staff
I $P(FILTERS(0),"^",3)=1 D ASKSTAFF(.FILTERS)
Q
;
PAT ; Patient filter
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="S",DIR("A")="Select(A)ll or (S)elected Patient(s)",DIR("B")="All"
S DIR("?",1)="Enter 'A' to select all Patients."
S DIR("?")="Enter 'S' to select specific Patients."
S $P(DIR(0),"^",2)="A:All Patients;S:Selected Patients"
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),"^",4)=$S(Y="A":0,1:1)
; Set Patient
I $P(FILTERS(0),"^",4)=1 D ASKPAT(.FILTERS)
Q
;
DEV ; -- select device, run option
;W !!,"You will need a 132 column printer for this report!",!
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="DQ^IBTRHRD",ZTSAVE("IB*")="",ZTDESC="IB - 278 Statistical Volume Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
;
U IO
S X=80 X ^%ZOSF("RM")
DQ D PRINT G END
Q
;
END ; -- Clean up
;;K ^TMP($J) W !
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT
Q
;
PRINT ; -- print one billing report from ct
W !,"Compiling report data..."
N SDT,EDT,IEN,NODE0,PATIEN,INSIEN,IBQUIT,IBPAG,CERT,PATINS,STAFF
S IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0,IBPAG=0
K ^TMP($J)
S SDT=$P(FILTERS(4),"^"),EDT=$P(FILTERS(4),"^",2)
F S SDT=$O(^IBT(356.22,"F",SDT)) Q:SDT="" Q:$P(SDT,".")>EDT D
. S IEN=0 F S IEN=$O(^IBT(356.22,"F",SDT,IEN)) Q:IEN="" Q:$G(IBQUIT) D
.. S NODE0=$G(^IBT(356.22,IEN,0)) I NODE0'="" D
... I $P(NODE0,"^",20)=2 Q ;skip response entries 1/19/16
... ;;I $P(NODE0,"^",15)="" Q ;must have been submitted
... ;I $P(NODE0,"^",11)="" Q ;278 has not been 'worked' for submission
... S PATIEN=$P(NODE0,"^",2),INSIEN=$P(NODE0,"^",3)
... I PATIEN="" Q
... I INSIEN="" Q
... S PATINS=$P($G(^DPT(PATIEN,.312,INSIEN,0)),"^") I PATINS="" Q
... S OK=1
... I $P(FILTERS(0),"^")=1 D I 'OK Q
.... S STAFF=$P(NODE0,"^",24) I STAFF="" S OK=0 Q
.... I $P(FILTERS(0),"^",3) D I 'OK Q
..... I '$D(FILTERS(2,STAFF)) S OK=0 Q
..... Q
.... Q
... I $P(FILTERS(0),"^")=2 D I 'OK Q
.... I $P(FILTERS(0),"^",4) D I 'OK Q
..... I '$D(FILTERS(3,PATIEN)) S OK=0 Q
..... Q
.... Q
... D SET
.. Q
. Q
;
PR ;
D HDR
I '$D(^TMP($J,"IBTRHRD")) W !!,"No 278 Transactions found in date range.",! G PR1
N Z1,Z2,Z3,TOT1,TOT2,TOT3,TOT4,TOT5,TOT6,TOT7,TOT8,TOT9,DATA,DDATA
N GTOT1,GTOT2,GTOT3,GTOT4,GTOT5,GTOT6,GTOT7,GTOT8,GTOT9,D1,D2
S (Z1,Z2)=""
F S Z1=$O(^TMP($J,"IBTRHRD",Z1)) Q:Z1=""!($G(IBQUIT)) D Q:IBQUIT
. S Z2="" F S Z2=$O(^TMP($J,"IBTRHRD",Z1,Z2)) Q:Z2=""!($G(IBQUIT)) S DATA=$G(^(Z2)) I DATA'="" D
.. I ($Y+5)>IOSL D HDR Q:IBQUIT
.. I $P(FILTERS(0),"^",6)=1 W !,$E(Z1,1,23) I $P(FILTERS(0),"^")'=3 W ?25,$E(Z2,4,5),"/",$E(Z2,6,7),"/",$E(Z2,2,3)
.. I $P(FILTERS(0),"^",6)=2 D
... I $P(FILTERS(0),"^")=3 W !,$E(Z1,4,5),"/",$E(Z1,6,7),"/",$S($E(Z1)=3:20,1:19),$E(Z1,2,3) Q
... W !,$E(Z2,1,23),?25,$E(Z1,4,5),"/",$E(Z1,6,7),"/",$E(Z1,2,3)
.. W ?47,$J(+$P(DATA,"^"),3),?69,$J(+$P(DATA,"^",2),3)
.. I $P(FILTERS(0),"^",8),$O(^TMP($J,"IBTRHRD",Z1,Z2,"")) D
... W !?10,"Detail Delete Reason:",?40,"---"
... S Z3="" F S Z3=$O(^TMP($J,"IBTRHRD",Z1,Z2,Z3)) Q:Z3="" S DDATA=$G(^(Z3)) I DDATA D
.... S D1=$$GET1^DIQ(356.023,Z3_",",.01)
.... S D2=$$GET1^DIQ(356.023,Z3_",",.02)
.... W !?10,D1,"-",$E(D2,1,25),?41,DDATA
.... Q
.. S TOT1=$G(TOT1)+$P(DATA,"^"),TOT2=$G(TOT2)+$P(DATA,"^",2)
. I +$G(TOT1)=0,+$G(TOT2)=0 Q
. I $P(FILTERS(0),"^")'=3 D ;don't print subtotals when selecting by date
.. N CHK S CHK=$O(FILTERS(2,"")) I CHK'="",$O(FILTERS(2,CHK))="" Q
.. S CHK=$O(FILTERS(3,"")) I CHK'="",$O(FILTERS(2,CHK))="" Q
.. W !?38,$TR($J(" ",42)," ","-")
.. W !," Total"
.. W ?46,$J(TOT1,4),?68,$J(TOT2,4)
.. W !
. S GTOT1=$G(GTOT1)+$G(TOT1),GTOT2=$G(GTOT2)+$G(TOT2)
. S (TOT1,TOT2)=""
. Q
I +$G(GTOT1)=0,+$G(GTOT2)=0 G PR1
W !,?25,$TR($J(" ",55)," ","=")
W !,"Grand Total"
W ?46,$J(GTOT1,4),?68,$J(GTOT2,4)
W !
PR1 ;
W !,?(80-$L("*** END OF REPORT ***")\2),"*** END OF REPORT ***"
I $D(ZTQUEUED) G END
Q
;
HDR ; -- Print header for billing report
Q:IBQUIT
I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !," 278 Deletion Disposition Report",?40,IBHDT,?72,"Page: ",IBPAG
W !," Sort by: ",$S($P(FILTERS(0),"^",6)=1:$S($P(FILTERS(0),"^")=1:"Staff",1:"Patient"),1:"Date")
W !,?30,"Report Timeframe:"
S SDT=$P(FILTERS(4),"^"),EDT=$P(FILTERS(4),"^",2)
W !,?27,$E(SDT,4,5),"/",$E(SDT,6,7),"/",$S($E(SDT)=3:20,1:19),$E(SDT,2,3)
W " - ",$E(EDT,4,5),"/",$E(EDT,6,7),"/",$S($E(EDT)=3:20,1:19),$E(EDT,2,3)
I $P(FILTERS(0),"^")=1 W !?31,$S($P(FILTERS(0),"^",3)=1:"Selected",1:"All")," Staff"
I $P(FILTERS(0),"^")=2 W !?31,$S($P(FILTERS(0),"^",4)=1:"Selected",1:"All")," Patient(s)"
I $P(FILTERS(0),"^")=3 W !?31,"Selected Dates"
W !!,$S($P(FILTERS(0),"^")=1:"Staff",$P(FILTERS(0),"^")=2:"Patient",1:"Date")
I $P(FILTERS(0),"^")'=3 W ?27,"Date"
W ?43,"#278s Submitted",?64,"#Delete Reasons"
W !,$TR($J(" ",80)," ","=")
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stopped at user request"
Q
;
SET ; -- set tmp array
N PIECE,ST1,ST2,INS,DATE,TRANST,DELETE,COUNT
S TRANST=+$P(NODE0,"^",20)
I $P(FILTERS(0),"^")=1 D
. I $D(FILTERS(2,STAFF)) S INS=FILTERS(2,STAFF)
. E S INS=$$GET1^DIQ(200,STAFF_",",.01)
. I INS="" S INS="UNKNOWN" Q
I $P(FILTERS(0),"^")=2 D
. I $D(FILTERS(3,PATIEN)) S INS=FILTERS(3,PATIEN)
. E S INS=$$GET1^DIQ(2,PATIEN_",",.01)
. I INS="" S INS="INKNOWN" Q
I $P(FILTERS(0),"^")=3 S INS=$P(SDT,".")
I $P(FILTERS(0),"^",6)=1 S ST1=INS,ST2=$P(SDT,".")
I $P(FILTERS(0),"^",6)=2 S ST1=$P(SDT,"."),ST2=INS
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 D HDR W !!,"....task stopped at user request" Q
S DELETE=$P(NODE0,"^",25)
S COUNT=$G(^TMP($J,"IBTRHRD",ST1,ST2))
; count[1] = number of 278s submitted
I +TRANST<2,$P(NODE0,"^",12)'="" S $P(COUNT,"^")=$P(COUNT,"^")+1
; count[2] = number of 278s deleted
I DELETE D
. S $P(COUNT,"^",2)=$P(COUNT,"^",2)+1
. I +$P(FILTERS(0),"^",8) S ^(DELETE)=$G(^TMP($J,"IBTRHRD",ST1,ST2,DELETE))+1
S ^TMP($J,"IBTRHRD",ST1,ST2)=COUNT
Q
;
FMDATES(PROMPT) ; ask for date range
N %DT,X,Y,DT1,DT2,IB1,IB2
S DT1="",IB1="Start Date: ",IB2="End Date: "
I $G(PROMPT)'="" S IB1="Start with "_PROMPT_": ",IB2="Go to "_PROMPT_": "
FM1 ;
S %DT="AEX",%DT("A")=IB1 D ^%DT K %DT I Y<0!($P(Y,".",1)'?7N) G FM1E:(Y<0&(X="")),FMDQ
S (%DT(0),DT2)=$P(Y,".",1) I DT2'>DT S %DT("B")="Today"
FM2 ;
S %DT="AEX",%DT("A")=IB2 D ^%DT K %DT I Y<0!($P(Y,".",1)'?7N) G FM2E:(Y<0&(X="")),FMDQ
S DT1=DT2_"^"_$P(Y,".",1)
FMDQ ;
Q DT1
FM1E ;
W !,"A date must be entered." G FM1
FM2E ;
W !,"A date must be entered." G FM2
Q
;
ASKSTAFF(FILTERS) ; Sets a list of staff
; Input: FILTERS - Current Array of filter settings
; Output: FILTERS - Updated Array of filter settings
N DIC,DIR,DIRUT,DIVS,DUOUT,IBIENS,IEN,N,NM,NODE,X,XX,Y
S DIC=200,DIC(0)="AEM"
F D Q:+IEN<1
. D ONE(.DIC,.IEN)
. Q:+IEN<1
. S FILTERS(2,$P(IEN,"^"))=$P(IEN,"^",2)
Q
;
ONE(DIC,IEN) ; Prompts the user for Payer
; Input: DIC - Variable/Array of settings needed for ^DIC call
;
; Output: IEN - IEN of the selected Payer Entry
; null if no selection was made
S DIC("A")="Select "_$S(DIC=200:"Staff Member: ",DIC="^VA(200,":"Staff Member: ",DIC=2:"Patient: ",DIC="^DPT(":"Patient: ",1:"Payer: ")
D ^DIC
S IEN=Y
Q
;
ASKPAT(FILTERS) ; Sets a list of Patients
; Input: FILTERS - Current Array of filter settings
; Output: FILTERS - Updated Array of filter settings
N DIC,DIR,DIRUT,DIVS,DUOUT,IBIENS,IEN,N,NM,NODE,X,XX,Y
S DIC=2,DIC(0)="AEM"
F D Q:+IEN<1
. D ONE(.DIC,.IEN)
. Q:+IEN<1
. S FILTERS(3,$P(IEN,"^"))=$P(IEN,"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRHRD 11892 printed Apr 09, 2024@21:04:50 Page 2
IBTRHRD ;ALB/JWS - CLAIMS TRACKING 278 DISPOSITION REPORT ;21-SEP-2015
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
% ;
+1 ; FILTERS array is built
+2 ; FILTERS(0)[1] = 1 if report by Staff
+3 ; 2 if report by Patient
+4 ; 3 if report by Date
+5 ; FILTERS(0)[2] =
+6 ; FILTERS(0)[3] = 0 (or null) if All staff, 1 if selected staff
+7 ; FILTERS(0)[4] = 0 (or null) if All Patients, 1 if selected patients
+8 ; FILTERS(0)[5] =
+9 ; FILTERS(0)[6] = sort, 1 = name, 2 = date
+10 ; FILTERS(2,staff name) = ien
+11 ; FILTERS(3,patient name) = ien
+12 ; FILTERS(4)[1] = from date
+13 ; FILTERS(4)[2] = through date
+14 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RPTDATE,IBQUIT,FILTERS,OK
+15 IF '$DATA(DT)
DO DT^DICRW
+16 WRITE !!,"278 Deletion Disposition Report"
+17 ; selection filter
+18 SET DIR(0)="S^1:Report by Staff;2:Report by Patient;3:Report by Date Range^I '$F("",1,2,3"","",""_X) K X"
+19 SET DIR("A")="Select the type of report to generate"
+20 SET DIR("L",1)="Select one of the following:"
+21 SET DIR("L",2)=""
+22 SET DIR("L",3)="1 Report by Staff"
+23 SET DIR("L",4)="2 Report by Patient"
+24 SET DIR("L",5)="3 Report by Date Range"
+25 SET DIR("?",1)="Select how you wish to select the entries to display on the report."
+26 SET DIR("?",2)=""
+27 SET DIR("?",3)="1 will allow you to select one or more Staff members to report on."
+28 SET DIR("?",4)="2 will allow you to select one or more Patients to report on."
+29 SET DIR("?")="3 will allow you to select a Date Range of 278 transactions to report on."
+30 WRITE !
DO ^DIR
KILL DIR
+31 IF $GET(DIRUT)
QUIT
+32 SET FILTERS(0)=Y
+33 IF Y=1
DO STAFF
GOTO 1
+34 IF Y=3
GOTO 1
+35 IF Y=2
DO PAT
+36 ;
1 ;
+1 SET RPTDATE=$$FMDATES("")
IF RPTDATE=""
QUIT
+2 SET FILTERS(4)=RPTDATE
+3 SET DIR(0)="Y"
SET DIR("A")="Include Delete Reason"
SET DIR("B")="NO"
+4 SET DIR("?",1)=" Enter: 'Y' - to include the Delete Reason Codes on report."
+5 SET DIR("?",2)=" 'N' - to exclude the Delete Reason Codes on report."
+6 SET DIR("?")=" '^' - to exit this report."
+7 DO ^DIR
KILL DIR
+8 IF $GET(DIRUT)
QUIT
+9 SET $PIECE(FILTERS(0),"^",8)=+Y
+10 IF $PIECE(FILTERS(0),"^")=3
SET $PIECE(FILTERS(0),"^",6)=2
GOTO 4
+11 ;I $P(FILTERS(0),"^")=1 G 2
+12 IF $PIECE(FILTERS(0),"^")=2
GOTO 3
+13 ;
2 ;
+1 SET OK=1
SET X=$PIECE(FILTERS(0),"^",3)
+2 IF X
SET X=$ORDER(FILTERS(2,""))
IF X
IF $ORDER(FILTERS(2,X))=""
SET OK=0
SET $PIECE(FILTERS(0),"^",6)=1
+3 IF OK
Begin DoDot:1
+4 SET DIR(0)="S^1:Staff Name;2:Date^I '$F("",1,2"",X) K X"
+5 SET DIR("A")="Select the Primary Sort"
+6 SET DIR("L",1)="Select one of the following:"
+7 SET DIR("L",2)=""
+8 SET DIR("L",3)="1 Staff Name"
+9 SET DIR("L",4)="2 Date"
+10 SET DIR("?",1)="Select how you wish to sort the entries on this report."
+11 SET DIR("?",2)=""
+12 SET DIR("?",3)="1 will sort the entries by Staff Name."
+13 SET DIR("?")="2 will sort the entries by 278 Transaction Date."
+14 WRITE !
DO ^DIR
KILL DIR
+15 IF $GET(DIRUT)
QUIT
+16 SET $PIECE(FILTERS(0),"^",6)=Y
+17 QUIT
End DoDot:1
IF $GET(DIRUT)
QUIT
+18 GOTO 4
+19 ;
3 ;
+1 SET OK=1
SET X=$PIECE(FILTERS(0),"^",4)
+2 IF X
SET X=$ORDER(FILTERS(3,""))
IF X
IF $ORDER(FILTERS(3,X))=""
SET OK=0
SET $PIECE(FILTERS(0),"^",6)=1
+3 IF OK
Begin DoDot:1
+4 SET DIR(0)="S^1:Patient Name;2:Date^I '$F("",1,2"",X) K X"
+5 SET DIR("A")="Select the Primary Sort"
+6 SET DIR("L",1)="Select one of the following:"
+7 SET DIR("L",2)=""
+8 SET DIR("L",3)="1 Patient Name"
+9 SET DIR("L",4)="2 Date"
+10 SET DIR("?",1)="Select how you wish to sort the entries on this report."
+11 SET DIR("?",2)=""
+12 SET DIR("?",3)="1 will sort the entries by Patient Name."
+13 SET DIR("?")="2 will sort the entries by 278 Transaction Date."
+14 WRITE !
DO ^DIR
KILL DIR
+15 IF $GET(DIRUT)
QUIT
+16 SET $PIECE(FILTERS(0),"^",6)=Y
+17 QUIT
End DoDot:1
IF $GET(DIRUT)
QUIT
4 ;
+1 DO DEV
+2 QUIT
+3 ;
STAFF ; Staff ( New Person file) filter
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="S"
SET DIR("A")="Select(A)ll or (S)elected Staff"
SET DIR("B")="All"
+3 SET DIR("?",1)="Enter 'A' to select all Staff Members."
+4 SET DIR("?")="Enter 'S' to select specific Staff Members."
+5 SET $PIECE(DIR(0),"^",2)="A:All Staff Members;S:Selected Staff Members"
+6 WRITE !
DO ^DIR
KILL DIR
+7 IF $GET(DIRUT)
QUIT 0
+8 SET X=$$UP^XLFSTR(X)
+9 SET $PIECE(FILTERS(0),"^",3)=$SELECT(Y="A":0,1:1)
+10 ; Set staff
+11 IF $PIECE(FILTERS(0),"^",3)=1
DO ASKSTAFF(.FILTERS)
+12 QUIT
+13 ;
PAT ; Patient filter
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="S"
SET DIR("A")="Select(A)ll or (S)elected Patient(s)"
SET DIR("B")="All"
+3 SET DIR("?",1)="Enter 'A' to select all Patients."
+4 SET DIR("?")="Enter 'S' to select specific Patients."
+5 SET $PIECE(DIR(0),"^",2)="A:All Patients;S:Selected Patients"
+6 WRITE !
DO ^DIR
KILL DIR
+7 IF $GET(DIRUT)
QUIT 0
+8 SET X=$$UP^XLFSTR(X)
+9 SET $PIECE(FILTERS(0),"^",4)=$SELECT(Y="A":0,1:1)
+10 ; Set Patient
+11 IF $PIECE(FILTERS(0),"^",4)=1
DO ASKPAT(.FILTERS)
+12 QUIT
+13 ;
DEV ; -- select device, run option
+1 ;W !!,"You will need a 132 column printer for this report!",!
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+3 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBTRHRD"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - 278 Statistical Volume Report"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO END
+4 ;
+5 USE IO
+6 SET X=80
XECUTE ^%ZOSF("RM")
DQ DO PRINT
GOTO END
+1 QUIT
+2 ;
END ; -- Clean up
+1 ;;K ^TMP($J) W !
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT
+5 QUIT
+6 ;
PRINT ; -- print one billing report from ct
+1 WRITE !,"Compiling report data..."
+2 NEW SDT,EDT,IEN,NODE0,PATIEN,INSIEN,IBQUIT,IBPAG,CERT,PATINS,STAFF
+3 SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
SET IBQUIT=0
SET IBPAG=0
+4 KILL ^TMP($JOB)
+5 SET SDT=$PIECE(FILTERS(4),"^")
SET EDT=$PIECE(FILTERS(4),"^",2)
+6 FOR
SET SDT=$ORDER(^IBT(356.22,"F",SDT))
if SDT=""
QUIT
if $PIECE(SDT,".")>EDT
QUIT
Begin DoDot:1
+7 SET IEN=0
FOR
SET IEN=$ORDER(^IBT(356.22,"F",SDT,IEN))
if IEN=""
QUIT
if $GET(IBQUIT)
QUIT
Begin DoDot:2
+8 SET NODE0=$GET(^IBT(356.22,IEN,0))
IF NODE0'=""
Begin DoDot:3
+9 ;skip response entries 1/19/16
IF $PIECE(NODE0,"^",20)=2
QUIT
+10 ;;I $P(NODE0,"^",15)="" Q ;must have been submitted
+11 ;I $P(NODE0,"^",11)="" Q ;278 has not been 'worked' for submission
+12 SET PATIEN=$PIECE(NODE0,"^",2)
SET INSIEN=$PIECE(NODE0,"^",3)
+13 IF PATIEN=""
QUIT
+14 IF INSIEN=""
QUIT
+15 SET PATINS=$PIECE($GET(^DPT(PATIEN,.312,INSIEN,0)),"^")
IF PATINS=""
QUIT
+16 SET OK=1
+17 IF $PIECE(FILTERS(0),"^")=1
Begin DoDot:4
+18 SET STAFF=$PIECE(NODE0,"^",24)
IF STAFF=""
SET OK=0
QUIT
+19 IF $PIECE(FILTERS(0),"^",3)
Begin DoDot:5
+20 IF '$DATA(FILTERS(2,STAFF))
SET OK=0
QUIT
+21 QUIT
End DoDot:5
IF 'OK
QUIT
+22 QUIT
End DoDot:4
IF 'OK
QUIT
+23 IF $PIECE(FILTERS(0),"^")=2
Begin DoDot:4
+24 IF $PIECE(FILTERS(0),"^",4)
Begin DoDot:5
+25 IF '$DATA(FILTERS(3,PATIEN))
SET OK=0
QUIT
+26 QUIT
End DoDot:5
IF 'OK
QUIT
+27 QUIT
End DoDot:4
IF 'OK
QUIT
+28 DO SET
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 ;
PR ;
+1 DO HDR
+2 IF '$DATA(^TMP($JOB,"IBTRHRD"))
WRITE !!,"No 278 Transactions found in date range.",!
GOTO PR1
+3 NEW Z1,Z2,Z3,TOT1,TOT2,TOT3,TOT4,TOT5,TOT6,TOT7,TOT8,TOT9,DATA,DDATA
+4 NEW GTOT1,GTOT2,GTOT3,GTOT4,GTOT5,GTOT6,GTOT7,GTOT8,GTOT9,D1,D2
+5 SET (Z1,Z2)=""
+6 FOR
SET Z1=$ORDER(^TMP($JOB,"IBTRHRD",Z1))
if Z1=""!($GET(IBQUIT))
QUIT
Begin DoDot:1
+7 SET Z2=""
FOR
SET Z2=$ORDER(^TMP($JOB,"IBTRHRD",Z1,Z2))
if Z2=""!($GET(IBQUIT))
QUIT
SET DATA=$GET(^(Z2))
IF DATA'=""
Begin DoDot:2
+8 IF ($Y+5)>IOSL
DO HDR
if IBQUIT
QUIT
+9 IF $PIECE(FILTERS(0),"^",6)=1
WRITE !,$EXTRACT(Z1,1,23)
IF $PIECE(FILTERS(0),"^")'=3
WRITE ?25,$EXTRACT(Z2,4,5),"/",$EXTRACT(Z2,6,7),"/",$EXTRACT(Z2,2,3)
+10 IF $PIECE(FILTERS(0),"^",6)=2
Begin DoDot:3
+11 IF $PIECE(FILTERS(0),"^")=3
WRITE !,$EXTRACT(Z1,4,5),"/",$EXTRACT(Z1,6,7),"/",$SELECT($EXTRACT(Z1)=3:20,1:19),$EXTRACT(Z1,2,3)
QUIT
+12 WRITE !,$EXTRACT(Z2,1,23),?25,$EXTRACT(Z1,4,5),"/",$EXTRACT(Z1,6,7),"/",$EXTRACT(Z1,2,3)
End DoDot:3
+13 WRITE ?47,$JUSTIFY(+$PIECE(DATA,"^"),3),?69,$JUSTIFY(+$PIECE(DATA,"^",2),3)
+14 IF $PIECE(FILTERS(0),"^",8)
IF $ORDER(^TMP($JOB,"IBTRHRD",Z1,Z2,""))
Begin DoDot:3
+15 WRITE !?10,"Detail Delete Reason:",?40,"---"
+16 SET Z3=""
FOR
SET Z3=$ORDER(^TMP($JOB,"IBTRHRD",Z1,Z2,Z3))
if Z3=""
QUIT
SET DDATA=$GET(^(Z3))
IF DDATA
Begin DoDot:4
+17 SET D1=$$GET1^DIQ(356.023,Z3_",",.01)
+18 SET D2=$$GET1^DIQ(356.023,Z3_",",.02)
+19 WRITE !?10,D1,"-",$EXTRACT(D2,1,25),?41,DDATA
+20 QUIT
End DoDot:4
End DoDot:3
+21 SET TOT1=$GET(TOT1)+$PIECE(DATA,"^")
SET TOT2=$GET(TOT2)+$PIECE(DATA,"^",2)
End DoDot:2
+22 IF +$GET(TOT1)=0
IF +$GET(TOT2)=0
QUIT
+23 ;don't print subtotals when selecting by date
IF $PIECE(FILTERS(0),"^")'=3
Begin DoDot:2
+24 NEW CHK
SET CHK=$ORDER(FILTERS(2,""))
IF CHK'=""
IF $ORDER(FILTERS(2,CHK))=""
QUIT
+25 SET CHK=$ORDER(FILTERS(3,""))
IF CHK'=""
IF $ORDER(FILTERS(2,CHK))=""
QUIT
+26 WRITE !?38,$TRANSLATE($JUSTIFY(" ",42)," ","-")
+27 WRITE !," Total"
+28 WRITE ?46,$JUSTIFY(TOT1,4),?68,$JUSTIFY(TOT2,4)
+29 WRITE !
End DoDot:2
+30 SET GTOT1=$GET(GTOT1)+$GET(TOT1)
SET GTOT2=$GET(GTOT2)+$GET(TOT2)
+31 SET (TOT1,TOT2)=""
+32 QUIT
End DoDot:1
if IBQUIT
QUIT
+33 IF +$GET(GTOT1)=0
IF +$GET(GTOT2)=0
GOTO PR1
+34 WRITE !,?25,$TRANSLATE($JUSTIFY(" ",55)," ","=")
+35 WRITE !,"Grand Total"
+36 WRITE ?46,$JUSTIFY(GTOT1,4),?68,$JUSTIFY(GTOT2,4)
+37 WRITE !
PR1 ;
+1 WRITE !,?(80-$LENGTH("*** END OF REPORT ***")\2),"*** END OF REPORT ***"
+2 IF $DATA(ZTQUEUED)
GOTO END
+3 QUIT
+4 ;
HDR ; -- Print header for billing report
+1 if IBQUIT
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF IBPAG
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+4 SET IBPAG=IBPAG+1
+5 WRITE !," 278 Deletion Disposition Report",?40,IBHDT,?72,"Page: ",IBPAG
+6 WRITE !," Sort by: ",$SELECT($PIECE(FILTERS(0),"^",6)=1:$SELECT($PIECE(FILTERS(0),"^")=1:"Staff",1:"Patient"),1:"Date")
+7 WRITE !,?30,"Report Timeframe:"
+8 SET SDT=$PIECE(FILTERS(4),"^")
SET EDT=$PIECE(FILTERS(4),"^",2)
+9 WRITE !,?27,$EXTRACT(SDT,4,5),"/",$EXTRACT(SDT,6,7),"/",$SELECT($EXTRACT(SDT)=3:20,1:19),$EXTRACT(SDT,2,3)
+10 WRITE " - ",$EXTRACT(EDT,4,5),"/",$EXTRACT(EDT,6,7),"/",$SELECT($EXTRACT(EDT)=3:20,1:19),$EXTRACT(EDT,2,3)
+11 IF $PIECE(FILTERS(0),"^")=1
WRITE !?31,$SELECT($PIECE(FILTERS(0),"^",3)=1:"Selected",1:"All")," Staff"
+12 IF $PIECE(FILTERS(0),"^")=2
WRITE !?31,$SELECT($PIECE(FILTERS(0),"^",4)=1:"Selected",1:"All")," Patient(s)"
+13 IF $PIECE(FILTERS(0),"^")=3
WRITE !?31,"Selected Dates"
+14 WRITE !!,$SELECT($PIECE(FILTERS(0),"^")=1:"Staff",$PIECE(FILTERS(0),"^")=2:"Patient",1:"Date")
+15 IF $PIECE(FILTERS(0),"^")'=3
WRITE ?27,"Date"
+16 WRITE ?43,"#278s Submitted",?64,"#Delete Reasons"
+17 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","=")
+18 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
WRITE !!,"....task stopped at user request"
+19 QUIT
+20 ;
SET ; -- set tmp array
+1 NEW PIECE,ST1,ST2,INS,DATE,TRANST,DELETE,COUNT
+2 SET TRANST=+$PIECE(NODE0,"^",20)
+3 IF $PIECE(FILTERS(0),"^")=1
Begin DoDot:1
+4 IF $DATA(FILTERS(2,STAFF))
SET INS=FILTERS(2,STAFF)
+5 IF '$TEST
SET INS=$$GET1^DIQ(200,STAFF_",",.01)
+6 IF INS=""
SET INS="UNKNOWN"
QUIT
End DoDot:1
+7 IF $PIECE(FILTERS(0),"^")=2
Begin DoDot:1
+8 IF $DATA(FILTERS(3,PATIEN))
SET INS=FILTERS(3,PATIEN)
+9 IF '$TEST
SET INS=$$GET1^DIQ(2,PATIEN_",",.01)
+10 IF INS=""
SET INS="INKNOWN"
QUIT
End DoDot:1
+11 IF $PIECE(FILTERS(0),"^")=3
SET INS=$PIECE(SDT,".")
+12 IF $PIECE(FILTERS(0),"^",6)=1
SET ST1=INS
SET ST2=$PIECE(SDT,".")
+13 IF $PIECE(FILTERS(0),"^",6)=2
SET ST1=$PIECE(SDT,".")
SET ST2=INS
+14 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
DO HDR
WRITE !!,"....task stopped at user request"
QUIT
+15 SET DELETE=$PIECE(NODE0,"^",25)
+16 SET COUNT=$GET(^TMP($JOB,"IBTRHRD",ST1,ST2))
+17 ; count[1] = number of 278s submitted
+18 IF +TRANST<2
IF $PIECE(NODE0,"^",12)'=""
SET $PIECE(COUNT,"^")=$PIECE(COUNT,"^")+1
+19 ; count[2] = number of 278s deleted
+20 IF DELETE
Begin DoDot:1
+21 SET $PIECE(COUNT,"^",2)=$PIECE(COUNT,"^",2)+1
+22 IF +$PIECE(FILTERS(0),"^",8)
SET ^(DELETE)=$GET(^TMP($JOB,"IBTRHRD",ST1,ST2,DELETE))+1
End DoDot:1
+23 SET ^TMP($JOB,"IBTRHRD",ST1,ST2)=COUNT
+24 QUIT
+25 ;
FMDATES(PROMPT) ; ask for date range
+1 NEW %DT,X,Y,DT1,DT2,IB1,IB2
+2 SET DT1=""
SET IB1="Start Date: "
SET IB2="End Date: "
+3 IF $GET(PROMPT)'=""
SET IB1="Start with "_PROMPT_": "
SET IB2="Go to "_PROMPT_": "
FM1 ;
+1 SET %DT="AEX"
SET %DT("A")=IB1
DO ^%DT
KILL %DT
IF Y<0!($PIECE(Y,".",1)'?7N)
if (Y<0&(X=""))
GOTO FM1E
GOTO FMDQ
+2 SET (%DT(0),DT2)=$PIECE(Y,".",1)
IF DT2'>DT
SET %DT("B")="Today"
FM2 ;
+1 SET %DT="AEX"
SET %DT("A")=IB2
DO ^%DT
KILL %DT
IF Y<0!($PIECE(Y,".",1)'?7N)
if (Y<0&(X=""))
GOTO FM2E
GOTO FMDQ
+2 SET DT1=DT2_"^"_$PIECE(Y,".",1)
FMDQ ;
+1 QUIT DT1
FM1E ;
+1 WRITE !,"A date must be entered."
GOTO FM1
FM2E ;
+1 WRITE !,"A date must be entered."
GOTO FM2
+2 QUIT
+3 ;
ASKSTAFF(FILTERS) ; Sets a list of staff
+1 ; Input: FILTERS - Current Array of filter settings
+2 ; Output: FILTERS - Updated Array of filter settings
+3 NEW DIC,DIR,DIRUT,DIVS,DUOUT,IBIENS,IEN,N,NM,NODE,X,XX,Y
+4 SET DIC=200
SET DIC(0)="AEM"
+5 FOR
Begin DoDot:1
+6 DO ONE(.DIC,.IEN)
+7 if +IEN<1
QUIT
+8 SET FILTERS(2,$PIECE(IEN,"^"))=$PIECE(IEN,"^",2)
End DoDot:1
if +IEN<1
QUIT
+9 QUIT
+10 ;
ONE(DIC,IEN) ; Prompts the user for Payer
+1 ; Input: DIC - Variable/Array of settings needed for ^DIC call
+2 ;
+3 ; Output: IEN - IEN of the selected Payer Entry
+4 ; null if no selection was made
+5 SET DIC("A")="Select "_$SELECT(DIC=200:"Staff Member: ",DIC="^VA(200,":"Staff Member: ",DIC=2:"Patient: ",DIC="^DPT(":"Patient: ",1:"Payer: ")
+6 DO ^DIC
+7 SET IEN=Y
+8 QUIT
+9 ;
ASKPAT(FILTERS) ; Sets a list of Patients
+1 ; Input: FILTERS - Current Array of filter settings
+2 ; Output: FILTERS - Updated Array of filter settings
+3 NEW DIC,DIR,DIRUT,DIVS,DUOUT,IBIENS,IEN,N,NM,NODE,X,XX,Y
+4 SET DIC=2
SET DIC(0)="AEM"
+5 FOR
Begin DoDot:1
+6 DO ONE(.DIC,.IEN)
+7 if +IEN<1
QUIT
+8 SET FILTERS(3,$PIECE(IEN,"^"))=$PIECE(IEN,"^",2)
End DoDot:1
if +IEN<1
QUIT
+9 QUIT
