BARRSL2 ; IHS/SD/LSL - Selective Report Parameters-PART 3 ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**6,19,23**;OCT 26, 2005
;
; IHS/SD/PKD - 5/10/10 - V1.8 patch 19
; ADDED TAG CANC PTYP for CANCELLATION REPORT
; IHS/ASDS/LSL - 04/10/02 - Routine created
;
; IHS/SD/LSL - 02/20/02 - V1.7 Patch 1
; Add DSCHSVC line tag to sort reports by Discharge Service
; MAR 2013 P.OTTIS ADDED NEW VA billing
Q
; *********************************************************************
;
ARACCT ; EP
; Select A/R Accounts to sort by
K BARY("ARACCT")
S DIC="^BARAC(DUZ(2),"
S DIC(0)="AEMQ"
S DIC("A")="Select A/R Account: ALL// "
F D Q:+Y<0
. I $D(BARY("ARACCT")) S DIC("A")="Select Another A/R Account: "
. D ^DIC
. Q:+Y<0
. S BARY("ARACCT",+Y)=""
I '$D(BARY("ARACCT")) D
. I $D(DUOUT) K BARY("SORT") Q
. W "ALL"
K DIC
Q
; *********************************************************************
;
DSCHSVC ;EP
; Select Discharge Service to sort by (really comes from the
; FACILITY TREATING SPECIALTY File ^DIC(45.7)
K BARY("DSCH")
S DIC="^DIC(45.7,"
S DIC(0)="AEMQ"
S DIC("A")="Select Discharge Service: ALL// "
F D Q:+Y<0
. I $D(BARY("DSCH")) S DIC("A")="Select Another Discharge Service: "
. D ^DIC
. Q:+Y<0
. S BARY("DSCH",+Y)=""
I '$D(BARY("DSCH")) D
. I $D(DUOUT) K BARY("SORT") Q
. W "ALL"
K DIC
Q
; ********************************************************************
;
CONVERT(BARA) ;EP
; Convert Allowance Categories from numbers to letters
; Where BARA is the number needing conversion
I '$D(BARA) Q "O"
S BARTMP="O"
S:BARA=1 BARTMP="R"
S:BARA=2 BARTMP="D"
S:BARA=3 BARTMP="P"
S:BARA=4 BARTMP="V" ;P.OTT
S:BARA=5 BARTMP="O" ;
S BARA=BARTMP
K BARTMP
Q BARA
; START BAR*1.8*19 PKD 5/7/10
;
APPR ;EP Approving Official
CANC ;EP 3PB Cancelling Official
K BARY("CANC"),BARY("APPR")
W !
S DIC="^VA(200,"
S DIC(0)="QEAM"
D ^DIC
I +Y>0 D
. I BAR("OPT")="CXL" S BARY("CANC")=+Y Q
. I BAR("OPT")="PAY" S BARY("APPR")=+Y,BARY("APPR","NM")=$P(Y,U,2)
Q
;
; PKD BAR*1.8*19 5/7/10
PTYP ;EP Eligibility Question
K DIR
S DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"
S DIR("A")="Select the PATIENT ELIGIBILITY STATUS"
S DIR("?")="Selection of an Eligibility Status will restrict the report to only those visits in which the patient is of the type designated."
D ^DIR
K DIR
Q:$D(DIRUT)
S BARY("PTYP")=Y
S BARY("PTYP","NM")=Y(0)
Q
;
TDN ; Multiple TDN's can be entered IHS/BAR/PKD 1.8*19 6/1/10
;
I BAR("OPT")="TDN" K BARY("DT") ; Date Range OR TDN list
K BARY("TDN") N BARTDN
S DIC="^BARCOL(DUZ(2),"
S DIC(0)="AEQ"
S DIC("A")="Select TDN**: "
F D Q:+Y<0!(X="^")
. S D="E" ; Index to search
. I $D(BARY("TDN")) S DIC("A")="Select Another TDN: "
. D IX^DIC
. Q:+Y<0
. S BARTDN=X ; X is TDN
. S BARY("TDN",BARTDN)=""
. D DISP^BARRSEL
K DIC
Q
CLNC ; Clinic - One or All
K BARY("CLNC")
S DIC="^DIC(40.7,"
S DIC(0)="AEMQ"
S DIC("A")="Select Clinic: ALL// "
D ^DIC
Q:+Y<0
S BARY("CLNC",+Y)="",BARY("CLNC","NM")=$P(Y,U,2)
K DIC
Q
ADJTY ; Adjustment Type One or All
W !,"IN PROCESS ******************************************",*7
Q
BARRSL2 ; IHS/SD/LSL - Selective Report Parameters-PART 3 ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,19,23**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/PKD - 5/10/10 - V1.8 patch 19
+4 ; ADDED TAG CANC PTYP for CANCELLATION REPORT
+5 ; IHS/ASDS/LSL - 04/10/02 - Routine created
+6 ;
+7 ; IHS/SD/LSL - 02/20/02 - V1.7 Patch 1
+8 ; Add DSCHSVC line tag to sort reports by Discharge Service
+9 ; MAR 2013 P.OTTIS ADDED NEW VA billing
+10 QUIT
+11 ; *********************************************************************
+12 ;
ARACCT ; EP
+1 ; Select A/R Accounts to sort by
+2 KILL BARY("ARACCT")
+3 SET DIC="^BARAC(DUZ(2),"
+4 SET DIC(0)="AEMQ"
+5 SET DIC("A")="Select A/R Account: ALL// "
+6 FOR
Begin DoDot:1
+7 IF $DATA(BARY("ARACCT"))
SET DIC("A")="Select Another A/R Account: "
+8 DO ^DIC
+9 IF +Y<0
QUIT
+10 SET BARY("ARACCT",+Y)=""
End DoDot:1
IF +Y<0
QUIT
+11 IF '$DATA(BARY("ARACCT"))
Begin DoDot:1
+12 IF $DATA(DUOUT)
KILL BARY("SORT")
QUIT
+13 WRITE "ALL"
End DoDot:1
+14 KILL DIC
+15 QUIT
+16 ; *********************************************************************
+17 ;
DSCHSVC ;EP
+1 ; Select Discharge Service to sort by (really comes from the
+2 ; FACILITY TREATING SPECIALTY File ^DIC(45.7)
+3 KILL BARY("DSCH")
+4 SET DIC="^DIC(45.7,"
+5 SET DIC(0)="AEMQ"
+6 SET DIC("A")="Select Discharge Service: ALL// "
+7 FOR
Begin DoDot:1
+8 IF $DATA(BARY("DSCH"))
SET DIC("A")="Select Another Discharge Service: "
+9 DO ^DIC
+10 IF +Y<0
QUIT
+11 SET BARY("DSCH",+Y)=""
End DoDot:1
IF +Y<0
QUIT
+12 IF '$DATA(BARY("DSCH"))
Begin DoDot:1
+13 IF $DATA(DUOUT)
KILL BARY("SORT")
QUIT
+14 WRITE "ALL"
End DoDot:1
+15 KILL DIC
+16 QUIT
+17 ; ********************************************************************
+18 ;
CONVERT(BARA) ;EP
+1 ; Convert Allowance Categories from numbers to letters
+2 ; Where BARA is the number needing conversion
+3 IF '$DATA(BARA)
QUIT "O"
+4 SET BARTMP="O"
+5 IF BARA=1
SET BARTMP="R"
+6 IF BARA=2
SET BARTMP="D"
+7 IF BARA=3
SET BARTMP="P"
+8 ;P.OTT
IF BARA=4
SET BARTMP="V"
+9 ;
IF BARA=5
SET BARTMP="O"
+10 SET BARA=BARTMP
+11 KILL BARTMP
+12 QUIT BARA
+13 ; START BAR*1.8*19 PKD 5/7/10
+14 ;
APPR ;EP Approving Official
CANC ;EP 3PB Cancelling Official
+1 KILL BARY("CANC"),BARY("APPR")
+2 WRITE !
+3 SET DIC="^VA(200,"
+4 SET DIC(0)="QEAM"
+5 DO ^DIC
+6 IF +Y>0
Begin DoDot:1
+7 IF BAR("OPT")="CXL"
SET BARY("CANC")=+Y
QUIT
+8 IF BAR("OPT")="PAY"
SET BARY("APPR")=+Y
SET BARY("APPR","NM")=$PIECE(Y,U,2)
End DoDot:1
+9 QUIT
+10 ;
+11 ; PKD BAR*1.8*19 5/7/10
PTYP ;EP Eligibility Question
+1 KILL DIR
+2 SET DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"
+3 SET DIR("A")="Select the PATIENT ELIGIBILITY STATUS"
+4 SET DIR("?")="Selection of an Eligibility Status will restrict the report to only those visits in which the patient is of the type designated."
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET BARY("PTYP")=Y
+9 SET BARY("PTYP","NM")=Y(0)
+10 QUIT
+11 ;
TDN ; Multiple TDN's can be entered IHS/BAR/PKD 1.8*19 6/1/10
+1 ;
+2 ; Date Range OR TDN list
IF BAR("OPT")="TDN"
KILL BARY("DT")
+3 KILL BARY("TDN")
NEW BARTDN
+4 SET DIC="^BARCOL(DUZ(2),"
+5 SET DIC(0)="AEQ"
+6 SET DIC("A")="Select TDN**: "
+7 FOR
Begin DoDot:1
+8 ; Index to search
SET D="E"
+9 IF $DATA(BARY("TDN"))
SET DIC("A")="Select Another TDN: "
+10 DO IX^DIC
+11 IF +Y<0
QUIT
+12 ; X is TDN
SET BARTDN=X
+13 SET BARY("TDN",BARTDN)=""
+14 DO DISP^BARRSEL
End DoDot:1
IF +Y<0!(X="^")
QUIT
+15 KILL DIC
+16 QUIT
CLNC ; Clinic - One or All
+1 KILL BARY("CLNC")
+2 SET DIC="^DIC(40.7,"
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select Clinic: ALL// "
+5 DO ^DIC
+6 IF +Y<0
QUIT
+7 SET BARY("CLNC",+Y)=""
SET BARY("CLNC","NM")=$PIECE(Y,U,2)
+8 KILL DIC
+9 QUIT
ADJTY ; Adjustment Type One or All
+1 WRITE !,"IN PROCESS ******************************************",*7
+2 QUIT
