IBTRHRS ;ALB/JWS - CLAIMS TRACKING 278 STATISTICAL REPORT ;24-AUG-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 Statistical Volume 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 Rejection/Review Decision Code",DIR("B")="NO"
S DIR("?",1)=" Enter: 'Y' - to include Rejection/Review Decision Reason Codes on report."
S DIR("?",2)=" 'N' - to exclude Rejection/Review Decision Reason Codes on report."
S DIR("?")=" '^' - to exit this report."
D ^DIR K DIR
I $G(DIRUT) Q
S $P(FILTERS(0),"^",5)=+Y
I $P(FILTERS(0),"^")=3 S $P(FILTERS(0),"^",6)=2 G 4
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^IBTRHRS",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,AUTH,PATINS,STAFF,XRESP
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,"AC",SDT)) Q:SDT="" Q:$P(SDT,".")>EDT D
. S IEN=0 F S IEN=$O(^IBT(356.22,"AC",SDT,IEN)) Q:IEN="" Q:$G(IBQUIT) D
.. S NODE0=$G(^IBT(356.22,IEN,0)) I NODE0'="" D
... I $P(NODE0,"^",15)="" Q ;must have been submitted
... 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,"^",11) 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
... S XRESP=$P(^IBT(356.22,IEN,0),"^",14)
... S CERT=$P($G(^IBT(356.22,+XRESP,103)),"^")
... S AUTH=$P($G(^IBT(356.22,+XRESP,103)),"^",3)
... D SET
.. Q
. Q
;
PR ;
D HDR
I '$D(^TMP($J,"IBTRHRS")) 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,TAB,TOT
S (Z1,Z2)=""
F S Z1=$O(^TMP($J,"IBTRHRS",Z1)) Q:Z1=""!($G(IBQUIT)) D Q:IBQUIT
. S Z2="" F S Z2=$O(^TMP($J,"IBTRHRS",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,16) I $P(FILTERS(0),"^")'=3 W ?18,$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,16),?18,$E(Z1,4,5),"/",$E(Z1,6,7),"/",$E(Z1,2,3)
.. W ?27,$J($P(DATA,"^"),3),?33,$J($P(DATA,"^",2),3)
.. W ?39,$J($P(DATA,"^",3),3),?45,$J($P(DATA,"^",4),3)
.. W ?51,$J($P(DATA,"^",5),3),?57,$J($P(DATA,"^",6),3)
.. W ?63,$J($P(DATA,"^",7),3),?69,$J($P(DATA,"^",8),3),?75,$J($P(DATA,"^",9),3)
.. I $P(FILTERS(0),"^",5),$O(^TMP($J,"IBTRHRS",Z1,Z2,"")) D
... W !?18,"Detail Rejection/Review Decision Code:",?70,"----"
... S Z3="" F S Z3=$O(^TMP($J,"IBTRHRS",Z1,Z2,1,Z3)) Q:Z3="" S DDATA=$G(^(Z3)) I DDATA D
.... S D1=$$GET1^DIQ(356.021,Z3_",",.01)
.... S D2=$$GET1^DIQ(356.021,Z3_",",.02)
.... W !?18,D1,"-",D2,?72,DDATA
.... Q
... S Z3="" F S Z3=$O(^TMP($J,"IBTRHRS",Z1,Z2,2,Z3)) Q:Z3="" S DDATA=$G(^(Z3)) I DDATA D
.... S D1=$$GET1^DIQ(365.017,Z3_",",.01)
.... S D2=$$GET1^DIQ(365.017,Z3_",",.02)
.... W !?18,D1,"-",D2,?72,DDATA
.... Q
.. S TOT1=$G(TOT1)+$P(DATA,"^"),TOT2=$G(TOT2)+$P(DATA,"^",2)
.. S TOT3=$G(TOT3)+$P(DATA,"^",3),TOT4=$G(TOT4)+$P(DATA,"^",4)
.. S TOT5=$G(TOT5)+$P(DATA,"^",5),TOT6=$G(TOT6)+$P(DATA,"^",6)
.. S TOT7=$G(TOT7)+$P(DATA,"^",7),TOT8=$G(TOT8)+$P(DATA,"^",8)
.. S TOT9=$G(TOT9)+$P(DATA,"^",9)
. I +$G(TOT1)=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(3,CHK))="" Q
.. W !?26,$TR($J(" ",54)," ","-")
.. W !," Total"
.. F I=1:1:9 S TAB=20+(6*I),TAB="?"_TAB,TOT="TOT"_I W @TAB,$J(@TOT,4)
.. W !
. S GTOT1=$G(GTOT1)+$G(TOT1),GTOT2=$G(GTOT2)+$G(TOT2)
. S GTOT3=$G(GTOT3)+$G(TOT3),GTOT4=$G(GTOT4)+$G(TOT4)
. S GTOT5=$G(GTOT5)+$G(TOT5),GTOT6=$G(GTOT6)+$G(TOT6)
. S GTOT7=$G(GTOT7)+$G(TOT7),GTOT8=$G(GTOT8)+$G(TOT8)
. S GTOT9=$G(GTOT9)+$G(TOT9)
. S (TOT1,TOT2,TOT3,TOT4,TOT5,TOT6,TOT7,TOT8,TOT9)=""
. Q
I +GTOT1=0 G PR1
W !,?18,$TR($J(" ",62)," ","=")
W !,"Grand Total"
F I=1:1:9 S TAB=20+(6*I),TAB="?"_TAB,TOT="GTOT"_I W @TAB,$J(@TOT,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 Statistical Volume 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 ?18,"Date"
W ?27,"#278s",?33,"#217",?39,"#215",?45,"#215",?51,"#Auth",?57,"#Rej",?63,"#Pend",?69,"AAA",?75,"Await"
W !?27,"Submitted",?39,"Man",?45,"Auto",?51,"Recd",?57,"Recd"
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,AUTH1,TRANST,NODE103,COUNT,AUTH2,DATA,X,XRESP
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),FILTERS(2,STAFF)=INS
. 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),FILTERS(3,PATIEN)=INS
. 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 COUNT=$G(^TMP($J,"IBTRHRS",ST1,ST2))
; count[1] = number of 278s submitted
I TRANST<2 S $P(COUNT,"^")=$P(COUNT,"^")+1
; count[2] = number of 278x217s
I TRANST=0 S $P(COUNT,"^",2)=$P(COUNT,"^",2)+1
; count[3] = number of manual 278x215s
; count[4] = number of auto 278x215s
I TRANST=1 D
. I +$P(NODE0,"^",26) S $P(COUNT,"^",3)=$P(COUNT,"^",3)+1
. E S $P(COUNT,"^",4)=$P(COUNT,"^",4)+1
S XRESP=$P(^IBT(356.22,IEN,0),"^",14)
S NODE103=$G(^IBT(356.22,+XRESP,103))
; count[5] = number of authorizations received
I $P(NODE103,"^",2) S $P(COUNT,"^",5)=$P(COUNT,"^",5)+1
I CERT D ;;W !,IEN,?10,CERT H 2
. S CERT=$$GET1^DIQ(356.02,CERT_",",.01)
. ; count[6] = number of rejections received
. I CERT="A3" S $P(COUNT,"^",6)=$P(COUNT,"^",6)+1
. ; count[7] = number of pended transactions received
. I CERT="A4" S $P(COUNT,"^",7)=$P(COUNT,"^",7)+1
; count[8] = number of AAA transactions received
I $D(^IBT(356.22,+XRESP,101)) S $P(COUNT,"^",8)=$P(COUNT,"^",8)+1
; count[9] = number of 278s awaiting a response
I TRANST<2,$P(NODE0,"^",14)="" S $P(COUNT,"^",9)=$P(COUNT,"^",9)+1
S ^TMP($J,"IBTRHRS",ST1,ST2)=COUNT
I AUTH D
. S AUTH1=$$GET1^DIQ(356.021,AUTH_",",.01)
. I AUTH1="" Q
. S COUNT=$G(^TMP($J,"IBTRHRS",ST1,ST2,1,AUTH))
. S COUNT=COUNT+1
. S ^TMP($J,"IBTRHRS",ST1,ST2,1,AUTH)=COUNT
S AUTH2=0 F S AUTH2=$O(^IBT(356.22,+XRESP,101,AUTH2)) Q:AUTH2'=+AUTH2 D
. S DATA=$G(^IBT(356.22,XRESP,101,AUTH2,0)) I DATA="" Q
. I $P(DATA,"^",4)="" Q
. S COUNT=$G(^TMP($J,"IBTRHRS",ST1,ST2,2,$P(DATA,"^",4)))
. S COUNT=COUNT+1
. S ^TMP($J,"IBTRHRS",ST1,ST2,2,$P(DATA,"^",4))=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[HIBTRHRS 14311 printed Nov 22, 2024@17:38:36 Page 2
IBTRHRS ;ALB/JWS - CLAIMS TRACKING 278 STATISTICAL REPORT ;24-AUG-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 Statistical Volume 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 Rejection/Review Decision Code"
SET DIR("B")="NO"
+4 SET DIR("?",1)=" Enter: 'Y' - to include Rejection/Review Decision Reason Codes on report."
+5 SET DIR("?",2)=" 'N' - to exclude Rejection/Review Decision 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),"^",5)=+Y
+10 IF $PIECE(FILTERS(0),"^")=3
SET $PIECE(FILTERS(0),"^",6)=2
GOTO 4
+11 IF $PIECE(FILTERS(0),"^")=2
GOTO 3
+12 ;
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^IBTRHRS"
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,AUTH,PATINS,STAFF,XRESP
+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,"AC",SDT))
if SDT=""
QUIT
if $PIECE(SDT,".")>EDT
QUIT
Begin DoDot:1
+7 SET IEN=0
FOR
SET IEN=$ORDER(^IBT(356.22,"AC",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 ;must have been submitted
IF $PIECE(NODE0,"^",15)=""
QUIT
+10 SET PATIEN=$PIECE(NODE0,"^",2)
SET INSIEN=$PIECE(NODE0,"^",3)
+11 IF PATIEN=""
QUIT
+12 IF INSIEN=""
QUIT
+13 SET PATINS=$PIECE($GET(^DPT(PATIEN,.312,INSIEN,0)),"^")
IF PATINS=""
QUIT
+14 SET OK=1
+15 IF $PIECE(FILTERS(0),"^")=1
Begin DoDot:4
+16 SET STAFF=$PIECE(NODE0,"^",11)
IF STAFF=""
SET OK=0
QUIT
+17 IF $PIECE(FILTERS(0),"^",3)
Begin DoDot:5
+18 IF '$DATA(FILTERS(2,STAFF))
SET OK=0
QUIT
+19 QUIT
End DoDot:5
IF 'OK
QUIT
+20 QUIT
End DoDot:4
IF 'OK
QUIT
+21 IF $PIECE(FILTERS(0),"^")=2
Begin DoDot:4
+22 IF $PIECE(FILTERS(0),"^",4)
Begin DoDot:5
+23 IF '$DATA(FILTERS(3,PATIEN))
SET OK=0
QUIT
+24 QUIT
End DoDot:5
IF 'OK
QUIT
+25 QUIT
End DoDot:4
IF 'OK
QUIT
+26 SET XRESP=$PIECE(^IBT(356.22,IEN,0),"^",14)
+27 SET CERT=$PIECE($GET(^IBT(356.22,+XRESP,103)),"^")
+28 SET AUTH=$PIECE($GET(^IBT(356.22,+XRESP,103)),"^",3)
+29 DO SET
End DoDot:3
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 ;
PR ;
+1 DO HDR
+2 IF '$DATA(^TMP($JOB,"IBTRHRS"))
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,TAB,TOT
+5 SET (Z1,Z2)=""
+6 FOR
SET Z1=$ORDER(^TMP($JOB,"IBTRHRS",Z1))
if Z1=""!($GET(IBQUIT))
QUIT
Begin DoDot:1
+7 SET Z2=""
FOR
SET Z2=$ORDER(^TMP($JOB,"IBTRHRS",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,16)
IF $PIECE(FILTERS(0),"^")'=3
WRITE ?18,$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,16),?18,$EXTRACT(Z1,4,5),"/",$EXTRACT(Z1,6,7),"/",$EXTRACT(Z1,2,3)
End DoDot:3
+13 WRITE ?27,$JUSTIFY($PIECE(DATA,"^"),3),?33,$JUSTIFY($PIECE(DATA,"^",2),3)
+14 WRITE ?39,$JUSTIFY($PIECE(DATA,"^",3),3),?45,$JUSTIFY($PIECE(DATA,"^",4),3)
+15 WRITE ?51,$JUSTIFY($PIECE(DATA,"^",5),3),?57,$JUSTIFY($PIECE(DATA,"^",6),3)
+16 WRITE ?63,$JUSTIFY($PIECE(DATA,"^",7),3),?69,$JUSTIFY($PIECE(DATA,"^",8),3),?75,$JUSTIFY($PIECE(DATA,"^",9),3)
+17 IF $PIECE(FILTERS(0),"^",5)
IF $ORDER(^TMP($JOB,"IBTRHRS",Z1,Z2,""))
Begin DoDot:3
+18 WRITE !?18,"Detail Rejection/Review Decision Code:",?70,"----"
+19 SET Z3=""
FOR
SET Z3=$ORDER(^TMP($JOB,"IBTRHRS",Z1,Z2,1,Z3))
if Z3=""
QUIT
SET DDATA=$GET(^(Z3))
IF DDATA
Begin DoDot:4
+20 SET D1=$$GET1^DIQ(356.021,Z3_",",.01)
+21 SET D2=$$GET1^DIQ(356.021,Z3_",",.02)
+22 WRITE !?18,D1,"-",D2,?72,DDATA
+23 QUIT
End DoDot:4
+24 SET Z3=""
FOR
SET Z3=$ORDER(^TMP($JOB,"IBTRHRS",Z1,Z2,2,Z3))
if Z3=""
QUIT
SET DDATA=$GET(^(Z3))
IF DDATA
Begin DoDot:4
+25 SET D1=$$GET1^DIQ(365.017,Z3_",",.01)
+26 SET D2=$$GET1^DIQ(365.017,Z3_",",.02)
+27 WRITE !?18,D1,"-",D2,?72,DDATA
+28 QUIT
End DoDot:4
End DoDot:3
+29 SET TOT1=$GET(TOT1)+$PIECE(DATA,"^")
SET TOT2=$GET(TOT2)+$PIECE(DATA,"^",2)
+30 SET TOT3=$GET(TOT3)+$PIECE(DATA,"^",3)
SET TOT4=$GET(TOT4)+$PIECE(DATA,"^",4)
+31 SET TOT5=$GET(TOT5)+$PIECE(DATA,"^",5)
SET TOT6=$GET(TOT6)+$PIECE(DATA,"^",6)
+32 SET TOT7=$GET(TOT7)+$PIECE(DATA,"^",7)
SET TOT8=$GET(TOT8)+$PIECE(DATA,"^",8)
+33 SET TOT9=$GET(TOT9)+$PIECE(DATA,"^",9)
End DoDot:2
+34 IF +$GET(TOT1)=0
QUIT
+35 ;don't print subtotals when selecting by date
IF $PIECE(FILTERS(0),"^")'=3
Begin DoDot:2
+36 NEW CHK
SET CHK=$ORDER(FILTERS(2,""))
IF CHK'=""
IF $ORDER(FILTERS(2,CHK))=""
QUIT
+37 SET CHK=$ORDER(FILTERS(3,""))
IF CHK'=""
IF $ORDER(FILTERS(3,CHK))=""
QUIT
+38 WRITE !?26,$TRANSLATE($JUSTIFY(" ",54)," ","-")
+39 WRITE !," Total"
+40 FOR I=1:1:9
SET TAB=20+(6*I)
SET TAB="?"_TAB
SET TOT="TOT"_I
WRITE @TAB,$JUSTIFY(@TOT,4)
+41 WRITE !
End DoDot:2
+42 SET GTOT1=$GET(GTOT1)+$GET(TOT1)
SET GTOT2=$GET(GTOT2)+$GET(TOT2)
+43 SET GTOT3=$GET(GTOT3)+$GET(TOT3)
SET GTOT4=$GET(GTOT4)+$GET(TOT4)
+44 SET GTOT5=$GET(GTOT5)+$GET(TOT5)
SET GTOT6=$GET(GTOT6)+$GET(TOT6)
+45 SET GTOT7=$GET(GTOT7)+$GET(TOT7)
SET GTOT8=$GET(GTOT8)+$GET(TOT8)
+46 SET GTOT9=$GET(GTOT9)+$GET(TOT9)
+47 SET (TOT1,TOT2,TOT3,TOT4,TOT5,TOT6,TOT7,TOT8,TOT9)=""
+48 QUIT
End DoDot:1
if IBQUIT
QUIT
+49 IF +GTOT1=0
GOTO PR1
+50 WRITE !,?18,$TRANSLATE($JUSTIFY(" ",62)," ","=")
+51 WRITE !,"Grand Total"
+52 FOR I=1:1:9
SET TAB=20+(6*I)
SET TAB="?"_TAB
SET TOT="GTOT"_I
WRITE @TAB,$JUSTIFY(@TOT,4)
+53 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 Statistical Volume 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 ?18,"Date"
+16 WRITE ?27,"#278s",?33,"#217",?39,"#215",?45,"#215",?51,"#Auth",?57,"#Rej",?63,"#Pend",?69,"AAA",?75,"Await"
+17 WRITE !?27,"Submitted",?39,"Man",?45,"Auto",?51,"Recd",?57,"Recd"
+18 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","=")
+19 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
WRITE !!,"....task stopped at user request"
+20 QUIT
+21 ;
SET ; -- set tmp array
+1 NEW PIECE,ST1,ST2,INS,DATE,AUTH1,TRANST,NODE103,COUNT,AUTH2,DATA,X,XRESP
+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)
SET FILTERS(2,STAFF)=INS
+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)
SET FILTERS(3,PATIEN)=INS
+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 COUNT=$GET(^TMP($JOB,"IBTRHRS",ST1,ST2))
+16 ; count[1] = number of 278s submitted
+17 IF TRANST<2
SET $PIECE(COUNT,"^")=$PIECE(COUNT,"^")+1
+18 ; count[2] = number of 278x217s
+19 IF TRANST=0
SET $PIECE(COUNT,"^",2)=$PIECE(COUNT,"^",2)+1
+20 ; count[3] = number of manual 278x215s
+21 ; count[4] = number of auto 278x215s
+22 IF TRANST=1
Begin DoDot:1
+23 IF +$PIECE(NODE0,"^",26)
SET $PIECE(COUNT,"^",3)=$PIECE(COUNT,"^",3)+1
+24 IF '$TEST
SET $PIECE(COUNT,"^",4)=$PIECE(COUNT,"^",4)+1
End DoDot:1
+25 SET XRESP=$PIECE(^IBT(356.22,IEN,0),"^",14)
+26 SET NODE103=$GET(^IBT(356.22,+XRESP,103))
+27 ; count[5] = number of authorizations received
+28 IF $PIECE(NODE103,"^",2)
SET $PIECE(COUNT,"^",5)=$PIECE(COUNT,"^",5)+1
+29 ;;W !,IEN,?10,CERT H 2
IF CERT
Begin DoDot:1
+30 SET CERT=$$GET1^DIQ(356.02,CERT_",",.01)
+31 ; count[6] = number of rejections received
+32 IF CERT="A3"
SET $PIECE(COUNT,"^",6)=$PIECE(COUNT,"^",6)+1
+33 ; count[7] = number of pended transactions received
+34 IF CERT="A4"
SET $PIECE(COUNT,"^",7)=$PIECE(COUNT,"^",7)+1
End DoDot:1
+35 ; count[8] = number of AAA transactions received
+36 IF $DATA(^IBT(356.22,+XRESP,101))
SET $PIECE(COUNT,"^",8)=$PIECE(COUNT,"^",8)+1
+37 ; count[9] = number of 278s awaiting a response
+38 IF TRANST<2
IF $PIECE(NODE0,"^",14)=""
SET $PIECE(COUNT,"^",9)=$PIECE(COUNT,"^",9)+1
+39 SET ^TMP($JOB,"IBTRHRS",ST1,ST2)=COUNT
+40 IF AUTH
Begin DoDot:1
+41 SET AUTH1=$$GET1^DIQ(356.021,AUTH_",",.01)
+42 IF AUTH1=""
QUIT
+43 SET COUNT=$GET(^TMP($JOB,"IBTRHRS",ST1,ST2,1,AUTH))
+44 SET COUNT=COUNT+1
+45 SET ^TMP($JOB,"IBTRHRS",ST1,ST2,1,AUTH)=COUNT
End DoDot:1
+46 SET AUTH2=0
FOR
SET AUTH2=$ORDER(^IBT(356.22,+XRESP,101,AUTH2))
if AUTH2'=+AUTH2
QUIT
Begin DoDot:1
+47 SET DATA=$GET(^IBT(356.22,XRESP,101,AUTH2,0))
IF DATA=""
QUIT
+48 IF $PIECE(DATA,"^",4)=""
QUIT
+49 SET COUNT=$GET(^TMP($JOB,"IBTRHRS",ST1,ST2,2,$PIECE(DATA,"^",4)))
+50 SET COUNT=COUNT+1
+51 SET ^TMP($JOB,"IBTRHRS",ST1,ST2,2,$PIECE(DATA,"^",4))=COUNT
End DoDot:1
+52 QUIT
+53 ;
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
