IBTRHRC ;ALB/JWS - CLAIMS TRACKING 278 CERTIFICATION 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 Payer (Insurance)
; 2 if report by Staff
; 3 if report by Patient
; 4 if report by Date
; FILTERS(0)[2] = 0 (or null) if All Payer's, 1 if selected payers
; 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] = 0 (No) to display decision reason code, 1 (Yes)
; FILTERS(0)[6] = sort, 1 = name, 2 = date
; FILTERS(0)[7] = 0 (No) to total by Date, 1 (Yes)
; FILTERS(1,payer name) = ien
; 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 Certification Report"
; selection filter
S DIR(0)="S^1:Report by Payer;2:Report by Staff;3:Report by Patient;4:Report by Date Range^I '$F("",1,2,3,4"",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 Payer"
S DIR("L",4)="2 Report by Staff"
S DIR("L",5)="3 Report by Patient"
S DIR("L",6)="4 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 Payers to report on."
S DIR("?",4)="2 will allow you to select one or more Staff members to report on."
S DIR("?",5)="3 will allow you to select one or more Patients to report on."
S DIR("?")="4 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 PAY G 1
I Y=2 D STAFF G 1
I Y=4 G 1
I Y=3 D PAT
;
1 ;
S RPTDATE=$$FMDATES("") I RPTDATE="" Q
S FILTERS(4)=RPTDATE
S DIR(0)="Y",DIR("A")="Include Autho/Review Decision Code",DIR("B")="NO"
S DIR("?",1)=" Enter: 'Y' - to include Authorization/Review Decision Reason Codes on report."
S DIR("?",2)=" 'N' - to exclude Authorization/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),"^")=4 S $P(FILTERS(0),"^",6)=2 G 4
S DIR(0)="Y",DIR("A")="Total by Date",DIR("B")="NO"
S DIR("?",1)=" Enter: 'Y' - to include totals for each date on report."
S DIR("?",2)=" 'N' - to NOT include totals for each date on report."
S DIR("?")=" '^' - to exit this report."
D ^DIR K DIR
I $G(DIRUT) Q
S $P(FILTERS(0),"^",7)=+Y
I 'Y S $P(FILTERS(0),"^",6)=1 G 4
I $P(FILTERS(0),"^")=2 G 2
I $P(FILTERS(0),"^")=3 G 3
S OK=1
S X=$O(FILTERS(1,"")) I X,$O(FILTERS(1,X))="" S OK=0,$P(FILTERS(0),"^",6)=2
I OK D I $G(DIRUT) Q
. S DIR(0)="S^1:Payer 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 Payer 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 Payer 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
;
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)=2
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)=2
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
;
PAY ; Payer filter
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="S",DIR("A")="Select(A)ll or (S)elected Payer(s)",DIR("B")="All"
S DIR("?",1)="Enter 'A' to select all Payers."
S DIR("?")="Enter 'S' to select specific Payers."
S $P(DIR(0),"^",2)="A:All Payers;S:Selected Payers"
W ! D ^DIR K DIR
I $G(DIRUT) Q 0
S X=$$UP^XLFSTR(X)
S $P(FILTERS(0),"^",2)=$S(Y="A":0,1:1)
; Set Payer
I $P(FILTERS(0),"^",2)=1 D ASKPAY(.FILTERS)
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^IBTRHRC",ZTSAVE("IB*")="",ZTDESC="IB - 278 Certification Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
U IO
S X=132 X ^%ZOSF("RM")
DQ D PRINT G END
Q
;
END ; -- Clean up
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,AUTH2,PATINS,STAFF,XREQ
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,"^",20)'=2 Q ;response message
... 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
.... I $P(FILTERS(0),"^",2) D I 'OK Q
..... I '$D(FILTERS(1,PATINS)) S OK=0 Q
..... Q
.... Q
... I $P(FILTERS(0),"^")=2 D I 'OK Q
.... S XREQ=$P(NODE0,"^",13) I XREQ="" S OK=0 Q
.... S STAFF=$P($G(^IBT(356.22,XREQ,0)),"^",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),"^")=3 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 CERT=$P($G(^IBT(356.22,IEN,103)),"^")
... S AUTH=$P($G(^IBT(356.22,IEN,103)),"^",3),AUTH2=$P($G(^(103)),"^",2)
... I CERT D SET
.. Q
. Q
;
PR ;
D HDR
I '$D(^TMP($J,"IBTRHRC")) 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,"IBTRHRC",Z1)) Q:Z1=""!($G(IBQUIT)) D Q:IBQUIT
. S Z2="" F S Z2=$O(^TMP($J,"IBTRHRC",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 !,Z1 I $P(FILTERS(0),"^",7),$P(FILTERS(0),"^")'=4 W ?30,$E(Z2,4,5),"/",$E(Z2,6,7),"/",$S($E(Z2)=3:20,1:19),$E(Z2,2,3)
.. I $P(FILTERS(0),"^",6)=2 D
... I $P(FILTERS(0),"^")=4 W !,$E(Z1,4,5),"/",$E(Z1,6,7),"/",$S($E(Z1)=3:20,1:19),$E(Z1,2,3) Q
... W !,Z2,?30,$E(Z1,4,5),"/",$E(Z1,6,7),"/",$S($E(Z1)=3:20,1:19),$E(Z1,2,3)
.. W ?49,$J($P(DATA,"^"),3),?57,$J($P(DATA,"^",2),3)
.. W ?67,$J($P(DATA,"^",3),3),?77,$J($P(DATA,"^",4),3),?87,$J($P(DATA,"^",5),3),?97,$J($P(DATA,"^",6),3)
.. W ?107,$J($P(DATA,"^",7),3),?117,$J($P(DATA,"^",8),3),?126,$J($P(DATA,"^",9),4)
.. I $P(FILTERS(0),"^",5),$O(^TMP($J,"IBTRHRC",Z1,Z2,""))'="" D
... W !?48,"Detail Autho/Review Decision Code:",?93,"----"
... S Z3="" F S Z3=$O(^TMP($J,"IBTRHRC",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 !?48,D1,"-",D2,?95,DDATA
... S Z3="" F S Z3=$O(^TMP($J,"IBTRHRC",Z1,Z2,2,Z3)) Q:Z3="" S DDATA=$G(^(Z3)) I DDATA D
.... W !?48,Z3,?95,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 +$P(FILTERS(0),"^",7) D
.. ;N CHK S CHK=$O(FILTERS(1,"")) I CHK'="",$O(FILTERS(1,CHK))="" Q
.. ;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 !?48,$TR($J(" ",84)," ","-")
.. W !," Total"
.. W ?48,$J(TOT1,4)
.. F I=2:1:8 S TAB=36+(10*I),TAB="?"_TAB,TOT="TOT"_I W @TAB,$J(@TOT,4)
.. W ?126,$J(TOT9,4)
.. W !?29,$TR($J(" ",103)," ","-")
. 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 '+$P(FILTERS(0),"^",7) W !?29,$TR($J(" ",103)," ","-")
W !,"Grand Total"
W ?48,$J(GTOT1,4)
F I=2:1:9 S TAB=36+(10*I),TAB="?"_TAB,TOT="GTOT"_I W @TAB,$J(@TOT,4)
W !?29,$TR($J(" ",103)," ","=")
W !
PR1 ;
W !?(132-$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 Certification Report",?55,IBHDT,?125,"Page: ",IBPAG
W !," Sort by: ",$S($P(FILTERS(0),"^",6)=1:$S($P(FILTERS(0),"^")=1:"Payer",$P(FILTERS(0),"^")=2:"Staff",1:"Patient"),1:"Date"),?116,"Detail: ",$S($P(FILTERS(0),"^",7)=1:"Included",1:"Excluded")
W !?55,"Report Timeframe:"
S SDT=$P(FILTERS(4),"^"),EDT=$P(FILTERS(4),"^",2)
W !?52,$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 !?55,$S($P(FILTERS(0),"^",2)=1:"Selected",1:"All")," Payer(s)"
I $P(FILTERS(0),"^")=2 W !?55,$S($P(FILTERS(0),"^",3)=1:"Selected",1:"All")," Staff"
I $P(FILTERS(0),"^")=3 W !?55,$S($P(FILTERS(0),"^",4)=1:"Selected",1:"All")," Patient(s)"
I $P(FILTERS(0),"^")=4 W !?55,"Selected Dates"
W !
W !,$S($P(FILTERS(0),"^")=1:"Payer",$P(FILTERS(0),"^")=2:"Staff",$P(FILTERS(0),"^")=3:"Patient",1:"Date")
W ?30
I $P(FILTERS(0),"^",7),$P(FILTERS(0),"^")'=4 W "Date"
W ?48,"#278s",?58,"#A1",?68,"#A2",?78,"#A6",?88,"#A4",?98,"#A3",?108,"#C",?118,"CT",?128,"NA"
W !,$TR($J(" ",132)," ","=")
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,COUNT
I $P(FILTERS(0),"^")=1 D
. I $D(FILTERS(1,PATINS)) S INS=FILTERS(1,PATINS)
. E S INS=$$GET1^DIQ(36,PATINS_",",.01),FILTERS(1,PATINS)=INS
. I INS="" S INS="UNKNOWN" Q
I $P(FILTERS(0),"^")=2 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),"^")=3 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="UNKNOWN" Q
I $P(FILTERS(0),"^")=4 S INS=$P(SDT,".")
I $P(FILTERS(0),"^",6)=1 S ST1=INS,ST2=$P(SDT,".") I '$P(FILTERS(0),"^",7) S ST2=ST1
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,"IBTRHRC",ST1,ST2)),$P(COUNT,"^")=$P(COUNT,"^")+1,^(ST2)=COUNT
I CERT D
. S CERT=$$GET1^DIQ(356.02,CERT_",",.01)
. S PIECE=$S(CERT="A1":2,CERT="A2":3,CERT="A6":4,CERT="A4":5,CERT="A3":6,CERT="C":7,CERT="CT":8,1:"9")
. S $P(COUNT,"^",PIECE)=$P(COUNT,"^",PIECE)+1
. S ^TMP($J,"IBTRHRC",ST1,ST2)=COUNT
I AUTH'="" D
. S AUTH1=$$GET1^DIQ(356.021,AUTH_",",.01)
. I AUTH1="" Q
. S COUNT=$G(^TMP($J,"IBTRHRC",ST1,ST2,1,AUTH))
. S COUNT=COUNT+1
. S ^TMP($J,"IBTRHRC",ST1,ST2,1,AUTH)=COUNT
I AUTH2'="" D
. S COUNT=$G(^TMP($J,"IBTRHRC",ST1,ST2,2,AUTH2))
. S COUNT=COUNT+1
. S ^TMP($J,"IBTRHRC",ST1,ST2,2,AUTH2)=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
;
ASKPAY(FILTERS) ; Sets a list of patients
; the HCSR Worklist
; Input: FILTERS - Current Array of filter settings
; Output: FILTERS - Updated Array of filter settings
N CLINS,DIC,DIR,DIRUT,DIVS,DUOUT,IBIENS,IEN,N,NM,NODE,WARDS,X,XX,Y
S DIC=36,DIC(0)="AEM"
F D Q:+IEN<1
. D ONE(.DIC,.IEN) ; One patient
. Q:+IEN<1
. S FILTERS(1,$P(IEN,"^"))=$P(IEN,"^",2)
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[HIBTRHRC 16163 printed Sep 23, 2025@20:04:53 Page 2
IBTRHRC ;ALB/JWS - CLAIMS TRACKING 278 CERTIFICATION 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 ;
+2 ; FILTERS array is built
+3 ; FILTERS(0)[1] = 1 if report by Payer (Insurance)
+4 ; 2 if report by Staff
+5 ; 3 if report by Patient
+6 ; 4 if report by Date
+7 ; FILTERS(0)[2] = 0 (or null) if All Payer's, 1 if selected payers
+8 ; FILTERS(0)[3] = 0 (or null) if All staff, 1 if selected staff
+9 ; FILTERS(0)[4] = 0 (or null) if All Patients, 1 if selected patients
+10 ; FILTERS(0)[5] = 0 (No) to display decision reason code, 1 (Yes)
+11 ; FILTERS(0)[6] = sort, 1 = name, 2 = date
+12 ; FILTERS(0)[7] = 0 (No) to total by Date, 1 (Yes)
+13 ; FILTERS(1,payer name) = ien
+14 ; FILTERS(2,staff name) = ien
+15 ; FILTERS(3,patient name) = ien
+16 ; FILTERS(4)[1] = from date
+17 ; FILTERS(4)[2] = through date
+18 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,RPTDATE,IBQUIT,FILTERS,OK
+19 IF '$DATA(DT)
DO DT^DICRW
+20 WRITE !!,"278 Certification Report"
+21 ; selection filter
+22 SET DIR(0)="S^1:Report by Payer;2:Report by Staff;3:Report by Patient;4:Report by Date Range^I '$F("",1,2,3,4"",X) K X"
+23 SET DIR("A")="Select the type of report to generate"
+24 SET DIR("L",1)="Select one of the following:"
+25 SET DIR("L",2)=""
+26 SET DIR("L",3)="1 Report by Payer"
+27 SET DIR("L",4)="2 Report by Staff"
+28 SET DIR("L",5)="3 Report by Patient"
+29 SET DIR("L",6)="4 Report by Date Range"
+30 SET DIR("?",1)="Select how you wish to select the entries to display on the report."
+31 SET DIR("?",2)=""
+32 SET DIR("?",3)="1 will allow you to select one or more Payers to report on."
+33 SET DIR("?",4)="2 will allow you to select one or more Staff members to report on."
+34 SET DIR("?",5)="3 will allow you to select one or more Patients to report on."
+35 SET DIR("?")="4 will allow you to select a Date Range of 278 transactions to report on."
+36 WRITE !
DO ^DIR
KILL DIR
+37 IF $GET(DIRUT)
QUIT
+38 SET FILTERS(0)=Y
+39 IF Y=1
DO PAY
GOTO 1
+40 IF Y=2
DO STAFF
GOTO 1
+41 IF Y=4
GOTO 1
+42 IF Y=3
DO PAT
+43 ;
1 ;
+1 SET RPTDATE=$$FMDATES("")
IF RPTDATE=""
QUIT
+2 SET FILTERS(4)=RPTDATE
+3 SET DIR(0)="Y"
SET DIR("A")="Include Autho/Review Decision Code"
SET DIR("B")="NO"
+4 SET DIR("?",1)=" Enter: 'Y' - to include Authorization/Review Decision Reason Codes on report."
+5 SET DIR("?",2)=" 'N' - to exclude Authorization/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),"^")=4
SET $PIECE(FILTERS(0),"^",6)=2
GOTO 4
+11 SET DIR(0)="Y"
SET DIR("A")="Total by Date"
SET DIR("B")="NO"
+12 SET DIR("?",1)=" Enter: 'Y' - to include totals for each date on report."
+13 SET DIR("?",2)=" 'N' - to NOT include totals for each date on report."
+14 SET DIR("?")=" '^' - to exit this report."
+15 DO ^DIR
KILL DIR
+16 IF $GET(DIRUT)
QUIT
+17 SET $PIECE(FILTERS(0),"^",7)=+Y
+18 IF 'Y
SET $PIECE(FILTERS(0),"^",6)=1
GOTO 4
+19 IF $PIECE(FILTERS(0),"^")=2
GOTO 2
+20 IF $PIECE(FILTERS(0),"^")=3
GOTO 3
+21 SET OK=1
+22 SET X=$ORDER(FILTERS(1,""))
IF X
IF $ORDER(FILTERS(1,X))=""
SET OK=0
SET $PIECE(FILTERS(0),"^",6)=2
+23 IF OK
Begin DoDot:1
+24 SET DIR(0)="S^1:Payer Name;2:Date^I '$F("",1,2"",X) K X"
+25 SET DIR("A")="Select the Primary Sort"
+26 SET DIR("L",1)="Select one of the following:"
+27 SET DIR("L",2)=""
+28 SET DIR("L",3)="1 Payer Name"
+29 SET DIR("L",4)="2 Date"
+30 SET DIR("?",1)="Select how you wish to sort the entries on this report."
+31 SET DIR("?",2)=""
+32 SET DIR("?",3)="1 will sort the entries by Payer Name."
+33 SET DIR("?")="2 will sort the entries by 278 Transaction Date."
+34 WRITE !
DO ^DIR
KILL DIR
+35 IF $GET(DIRUT)
QUIT
+36 SET $PIECE(FILTERS(0),"^",6)=Y
+37 QUIT
End DoDot:1
IF $GET(DIRUT)
QUIT
+38 GOTO 4
+39 ;
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)=2
+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)=2
+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 ;
PAY ; Payer filter
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="S"
SET DIR("A")="Select(A)ll or (S)elected Payer(s)"
SET DIR("B")="All"
+3 SET DIR("?",1)="Enter 'A' to select all Payers."
+4 SET DIR("?")="Enter 'S' to select specific Payers."
+5 SET $PIECE(DIR(0),"^",2)="A:All Payers;S:Selected Payers"
+6 WRITE !
DO ^DIR
KILL DIR
+7 IF $GET(DIRUT)
QUIT 0
+8 SET X=$$UP^XLFSTR(X)
+9 SET $PIECE(FILTERS(0),"^",2)=$SELECT(Y="A":0,1:1)
+10 ; Set Payer
+11 IF $PIECE(FILTERS(0),"^",2)=1
DO ASKPAY(.FILTERS)
+12 QUIT
+13 ;
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 WRITE !!,"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^IBTRHRC"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - 278 Certification Report"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO END
+4 USE IO
+5 SET X=132
XECUTE ^%ZOSF("RM")
DQ DO PRINT
GOTO END
+1 QUIT
+2 ;
END ; -- Clean up
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 DO ^%ZISC
+3 KILL I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBPAG,IBHDT,IBDT,IBBDT,IBEDT,IBQUIT
+4 QUIT
+5 ;
PRINT ; -- print one billing report from ct
+1 WRITE !,"Compiling report data..."
+2 NEW SDT,EDT,IEN,NODE0,PATIEN,INSIEN,IBQUIT,IBPAG,CERT,AUTH,AUTH2,PATINS,STAFF,XREQ
+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 ;response message
IF $PIECE(NODE0,"^",20)'=2
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 IF $PIECE(FILTERS(0),"^",2)
Begin DoDot:5
+17 IF '$DATA(FILTERS(1,PATINS))
SET OK=0
QUIT
+18 QUIT
End DoDot:5
IF 'OK
QUIT
+19 QUIT
End DoDot:4
IF 'OK
QUIT
+20 IF $PIECE(FILTERS(0),"^")=2
Begin DoDot:4
+21 SET XREQ=$PIECE(NODE0,"^",13)
IF XREQ=""
SET OK=0
QUIT
+22 SET STAFF=$PIECE($GET(^IBT(356.22,XREQ,0)),"^",11)
IF STAFF=""
SET OK=0
QUIT
+23 IF $PIECE(FILTERS(0),"^",3)
Begin DoDot:5
+24 IF '$DATA(FILTERS(2,STAFF))
SET OK=0
QUIT
+25 QUIT
End DoDot:5
IF 'OK
QUIT
+26 QUIT
End DoDot:4
IF 'OK
QUIT
+27 IF $PIECE(FILTERS(0),"^")=3
Begin DoDot:4
+28 IF $PIECE(FILTERS(0),"^",4)
Begin DoDot:5
+29 IF '$DATA(FILTERS(3,PATIEN))
SET OK=0
QUIT
+30 QUIT
End DoDot:5
IF 'OK
QUIT
+31 QUIT
End DoDot:4
IF 'OK
QUIT
+32 SET CERT=$PIECE($GET(^IBT(356.22,IEN,103)),"^")
+33 SET AUTH=$PIECE($GET(^IBT(356.22,IEN,103)),"^",3)
SET AUTH2=$PIECE($GET(^(103)),"^",2)
+34 IF CERT
DO SET
End DoDot:3
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
+37 ;
PR ;
+1 DO HDR
+2 IF '$DATA(^TMP($JOB,"IBTRHRC"))
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,"IBTRHRC",Z1))
if Z1=""!($GET(IBQUIT))
QUIT
Begin DoDot:1
+7 SET Z2=""
FOR
SET Z2=$ORDER(^TMP($JOB,"IBTRHRC",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 !,Z1
IF $PIECE(FILTERS(0),"^",7)
IF $PIECE(FILTERS(0),"^")'=4
WRITE ?30,$EXTRACT(Z2,4,5),"/",$EXTRACT(Z2,6,7),"/",$SELECT($EXTRACT(Z2)=3:20,1:19),$EXTRACT(Z2,2,3)
+10 IF $PIECE(FILTERS(0),"^",6)=2
Begin DoDot:3
+11 IF $PIECE(FILTERS(0),"^")=4
WRITE !,$EXTRACT(Z1,4,5),"/",$EXTRACT(Z1,6,7),"/",$SELECT($EXTRACT(Z1)=3:20,1:19),$EXTRACT(Z1,2,3)
QUIT
+12 WRITE !,Z2,?30,$EXTRACT(Z1,4,5),"/",$EXTRACT(Z1,6,7),"/",$SELECT($EXTRACT(Z1)=3:20,1:19),$EXTRACT(Z1,2,3)
End DoDot:3
+13 WRITE ?49,$JUSTIFY($PIECE(DATA,"^"),3),?57,$JUSTIFY($PIECE(DATA,"^",2),3)
+14 WRITE ?67,$JUSTIFY($PIECE(DATA,"^",3),3),?77,$JUSTIFY($PIECE(DATA,"^",4),3),?87,$JUSTIFY($PIECE(DATA,"^",5),3),?97,$JUSTIFY($PIECE(DATA,"^",6),3)
+15 WRITE ?107,$JUSTIFY($PIECE(DATA,"^",7),3),?117,$JUSTIFY($PIECE(DATA,"^",8),3),?126,$JUSTIFY($PIECE(DATA,"^",9),4)
+16 IF $PIECE(FILTERS(0),"^",5)
IF $ORDER(^TMP($JOB,"IBTRHRC",Z1,Z2,""))'=""
Begin DoDot:3
+17 WRITE !?48,"Detail Autho/Review Decision Code:",?93,"----"
+18 SET Z3=""
FOR
SET Z3=$ORDER(^TMP($JOB,"IBTRHRC",Z1,Z2,1,Z3))
if Z3=""
QUIT
SET DDATA=$GET(^(Z3))
IF DDATA
Begin DoDot:4
+19 SET D1=$$GET1^DIQ(356.021,Z3_",",.01)
+20 SET D2=$$GET1^DIQ(356.021,Z3_",",.02)
+21 WRITE !?48,D1,"-",D2,?95,DDATA
End DoDot:4
+22 SET Z3=""
FOR
SET Z3=$ORDER(^TMP($JOB,"IBTRHRC",Z1,Z2,2,Z3))
if Z3=""
QUIT
SET DDATA=$GET(^(Z3))
IF DDATA
Begin DoDot:4
+23 WRITE !?48,Z3,?95,DDATA
+24 QUIT
End DoDot:4
End DoDot:3
+25 SET TOT1=$GET(TOT1)+$PIECE(DATA,"^")
SET TOT2=$GET(TOT2)+$PIECE(DATA,"^",2)
+26 SET TOT3=$GET(TOT3)+$PIECE(DATA,"^",3)
SET TOT4=$GET(TOT4)+$PIECE(DATA,"^",4)
+27 SET TOT5=$GET(TOT5)+$PIECE(DATA,"^",5)
SET TOT6=$GET(TOT6)+$PIECE(DATA,"^",6)
+28 SET TOT7=$GET(TOT7)+$PIECE(DATA,"^",7)
SET TOT8=$GET(TOT8)+$PIECE(DATA,"^",8)
+29 SET TOT9=$GET(TOT9)+$PIECE(DATA,"^",9)
End DoDot:2
+30 IF +$PIECE(FILTERS(0),"^",7)
Begin DoDot:2
+31 ;N CHK S CHK=$O(FILTERS(1,"")) I CHK'="",$O(FILTERS(1,CHK))="" Q
+32 ;S CHK=$O(FILTERS(2,"")) I CHK'="",$O(FILTERS(2,CHK))="" Q
+33 ;S CHK=$O(FILTERS(3,"")) I CHK'="",$O(FILTERS(2,CHK))="" Q
+34 WRITE !?48,$TRANSLATE($JUSTIFY(" ",84)," ","-")
+35 WRITE !," Total"
+36 WRITE ?48,$JUSTIFY(TOT1,4)
+37 FOR I=2:1:8
SET TAB=36+(10*I)
SET TAB="?"_TAB
SET TOT="TOT"_I
WRITE @TAB,$JUSTIFY(@TOT,4)
+38 WRITE ?126,$JUSTIFY(TOT9,4)
+39 WRITE !?29,$TRANSLATE($JUSTIFY(" ",103)," ","-")
End DoDot:2
+40 SET GTOT1=$GET(GTOT1)+$GET(TOT1)
SET GTOT2=$GET(GTOT2)+$GET(TOT2)
+41 SET GTOT3=$GET(GTOT3)+$GET(TOT3)
SET GTOT4=$GET(GTOT4)+$GET(TOT4)
+42 SET GTOT5=$GET(GTOT5)+$GET(TOT5)
SET GTOT6=$GET(GTOT6)+$GET(TOT6)
+43 SET GTOT7=$GET(GTOT7)+$GET(TOT7)
SET GTOT8=$GET(GTOT8)+$GET(TOT8)
+44 SET GTOT9=$GET(GTOT9)+$GET(TOT9)
+45 SET (TOT1,TOT2,TOT3,TOT4,TOT5,TOT6,TOT7,TOT8,TOT9)=""
+46 QUIT
End DoDot:1
if IBQUIT
QUIT
+47 IF '+$PIECE(FILTERS(0),"^",7)
WRITE !?29,$TRANSLATE($JUSTIFY(" ",103)," ","-")
+48 WRITE !,"Grand Total"
+49 WRITE ?48,$JUSTIFY(GTOT1,4)
+50 FOR I=2:1:9
SET TAB=36+(10*I)
SET TAB="?"_TAB
SET TOT="GTOT"_I
WRITE @TAB,$JUSTIFY(@TOT,4)
+51 WRITE !?29,$TRANSLATE($JUSTIFY(" ",103)," ","=")
+52 WRITE !
PR1 ;
+1 WRITE !?(132-$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 Certification Report",?55,IBHDT,?125,"Page: ",IBPAG
+6 WRITE !," Sort by: ",$SELECT($PIECE(FILTERS(0),"^",6)=1:$SELECT($PIECE(FILTERS(0),"^")=1:"Payer",$PIECE(FILTERS(0),"^")=2:"Staff",1:"Patient"),1:"Date"),?116,"Detail: ",$SELECT($PIECE(FILTERS(0),"^",7)=1:"Included",1:"Excluded")
+7 WRITE !?55,"Report Timeframe:"
+8 SET SDT=$PIECE(FILTERS(4),"^")
SET EDT=$PIECE(FILTERS(4),"^",2)
+9 WRITE !?52,$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 !?55,$SELECT($PIECE(FILTERS(0),"^",2)=1:"Selected",1:"All")," Payer(s)"
+12 IF $PIECE(FILTERS(0),"^")=2
WRITE !?55,$SELECT($PIECE(FILTERS(0),"^",3)=1:"Selected",1:"All")," Staff"
+13 IF $PIECE(FILTERS(0),"^")=3
WRITE !?55,$SELECT($PIECE(FILTERS(0),"^",4)=1:"Selected",1:"All")," Patient(s)"
+14 IF $PIECE(FILTERS(0),"^")=4
WRITE !?55,"Selected Dates"
+15 WRITE !
+16 WRITE !,$SELECT($PIECE(FILTERS(0),"^")=1:"Payer",$PIECE(FILTERS(0),"^")=2:"Staff",$PIECE(FILTERS(0),"^")=3:"Patient",1:"Date")
+17 WRITE ?30
+18 IF $PIECE(FILTERS(0),"^",7)
IF $PIECE(FILTERS(0),"^")'=4
WRITE "Date"
+19 WRITE ?48,"#278s",?58,"#A1",?68,"#A2",?78,"#A6",?88,"#A4",?98,"#A3",?108,"#C",?118,"CT",?128,"NA"
+20 WRITE !,$TRANSLATE($JUSTIFY(" ",132)," ","=")
+21 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
WRITE !!,"....task stopped at user request"
+22 QUIT
+23 ;
SET ; -- set tmp array
+1 NEW PIECE,ST1,ST2,INS,DATE,AUTH1,COUNT
+2 IF $PIECE(FILTERS(0),"^")=1
Begin DoDot:1
+3 IF $DATA(FILTERS(1,PATINS))
SET INS=FILTERS(1,PATINS)
+4 IF '$TEST
SET INS=$$GET1^DIQ(36,PATINS_",",.01)
SET FILTERS(1,PATINS)=INS
+5 IF INS=""
SET INS="UNKNOWN"
QUIT
End DoDot:1
+6 IF $PIECE(FILTERS(0),"^")=2
Begin DoDot:1
+7 IF $DATA(FILTERS(2,STAFF))
SET INS=FILTERS(2,STAFF)
+8 IF '$TEST
SET INS=$$GET1^DIQ(200,STAFF_",",.01)
SET FILTERS(2,STAFF)=INS
+9 IF INS=""
SET INS="UNKNOWN"
QUIT
End DoDot:1
+10 IF $PIECE(FILTERS(0),"^")=3
Begin DoDot:1
+11 IF $DATA(FILTERS(3,PATIEN))
SET INS=FILTERS(3,PATIEN)
+12 IF '$TEST
SET INS=$$GET1^DIQ(2,PATIEN_",",.01)
SET FILTERS(3,PATIEN)=INS
+13 IF INS=""
SET INS="UNKNOWN"
QUIT
End DoDot:1
+14 IF $PIECE(FILTERS(0),"^")=4
SET INS=$PIECE(SDT,".")
+15 IF $PIECE(FILTERS(0),"^",6)=1
SET ST1=INS
SET ST2=$PIECE(SDT,".")
IF '$PIECE(FILTERS(0),"^",7)
SET ST2=ST1
+16 IF $PIECE(FILTERS(0),"^",6)=2
SET ST1=$PIECE(SDT,".")
SET ST2=INS
+17 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
DO HDR
WRITE !!,"....task stopped at user request"
QUIT
+18 SET COUNT=$GET(^TMP($JOB,"IBTRHRC",ST1,ST2))
SET $PIECE(COUNT,"^")=$PIECE(COUNT,"^")+1
SET ^(ST2)=COUNT
+19 IF CERT
Begin DoDot:1
+20 SET CERT=$$GET1^DIQ(356.02,CERT_",",.01)
+21 SET PIECE=$SELECT(CERT="A1":2,CERT="A2":3,CERT="A6":4,CERT="A4":5,CERT="A3":6,CERT="C":7,CERT="CT":8,1:"9")
+22 SET $PIECE(COUNT,"^",PIECE)=$PIECE(COUNT,"^",PIECE)+1
+23 SET ^TMP($JOB,"IBTRHRC",ST1,ST2)=COUNT
End DoDot:1
+24 IF AUTH'=""
Begin DoDot:1
+25 SET AUTH1=$$GET1^DIQ(356.021,AUTH_",",.01)
+26 IF AUTH1=""
QUIT
+27 SET COUNT=$GET(^TMP($JOB,"IBTRHRC",ST1,ST2,1,AUTH))
+28 SET COUNT=COUNT+1
+29 SET ^TMP($JOB,"IBTRHRC",ST1,ST2,1,AUTH)=COUNT
End DoDot:1
+30 IF AUTH2'=""
Begin DoDot:1
+31 SET COUNT=$GET(^TMP($JOB,"IBTRHRC",ST1,ST2,2,AUTH2))
+32 SET COUNT=COUNT+1
+33 SET ^TMP($JOB,"IBTRHRC",ST1,ST2,2,AUTH2)=COUNT
End DoDot:1
+34 QUIT
+35 ;
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 ;
ASKPAY(FILTERS) ; Sets a list of patients
+1 ; the HCSR Worklist
+2 ; Input: FILTERS - Current Array of filter settings
+3 ; Output: FILTERS - Updated Array of filter settings
+4 NEW CLINS,DIC,DIR,DIRUT,DIVS,DUOUT,IBIENS,IEN,N,NM,NODE,WARDS,X,XX,Y
+5 SET DIC=36
SET DIC(0)="AEM"
+6 FOR
Begin DoDot:1
+7 ; One patient
DO ONE(.DIC,.IEN)
+8 if +IEN<1
QUIT
+9 SET FILTERS(1,$PIECE(IEN,"^"))=$PIECE(IEN,"^",2)
End DoDot:1
if +IEN<1
QUIT
+10 QUIT
+11 ;
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
