BARRPVC ; IHS/SD/SDR - Provider Visit Count Report ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92
;IHS/SD/SDR 1.8*28 CR8398 HEAT301053 - new routine. Report of MACRA reporting. Prompts for approval or visit date, date range,
; inpatient/outpatient/both, and providers. It will find all A/R Accounts with insurer type MEDICARE FI, and report
; a summary line with a breakdown by bill type, visit type for each.
;
Q
;*****************************************
EN ;
W !!,"NOTE: This report will contain data for all Visit Locations where a provider"
W !?7,"saw Medicare patients. There will be a summary line for each provider"
W !?7,"under each Visit Location, with detail lines underneath that breaks down"
W !?7,"the data further by bill type and visit type."
;
K ^TMP($J,"BAR-PVC-TEST"),^TMP($J,"BAR-PVC"),^TMP($J,"BAR-PVC-LOC")
S BARDONE=0
D:'$D(BARUSR) INIT^BARUTL ;Setup basic A/R variables
D DTYP ;approval or visit date
I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
D DATES ;prompt for dates
I '$D(BARY("DT"))!'$D(BARY("DT",1))!'$D(BARY("DT",2)) Q
D INOUTPT ;inpatient, outpatient, or both
I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
D PRVS ;what providers, default to ALL
I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
SEL ;Select device
S %ZIS="Q"
S %ZIS("A")="Enter DEVICE: "
D ^%ZIS Q:POP
I IO'=IO(0) D QUE,HOME^%ZIS S DIR(0)="E" D ^DIR K DIR Q
S IOP=ION D ^%ZIS
D PRINT
Q
DTYP ;EP
K BARY("DT"),BARSTART,BAREND
S DIR(0)="SO^1:Approval Date;2:Visit Date"
S DIR("A")="Select TYPE of DATE Desired"
D ^DIR
K DIR
I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
S BARY("DT")=$S(Y=1:"A",1:"V")
Q
DATES ;EP
; Ask beginning and ending Transaction Dates
W !!," ============ Entry of "_$S(BARY("DT")="A":"APPROVAL",1:"VISIT")_" DATE Range =============",!
K %D
S BARSTART=$$DATE^BARDUTL(1)
K %DT
I BARSTART<1 Q
S BAREND=$$DATE^BARDUTL(2)
K %DT
I BAREND<1 W ! G DATES
I BAREND<BARSTART D G DATES
.W *7
.W !!,"The END date must not be before the START date.",!
S BARY("DT",1)=BARSTART
S BARY("DT",2)=BAREND
Q
INOUTPT ;EP
K BARIOPT
S DIR(0)="SO^1:Inpatient;2:Outpatient;3:Both Inpatient and Outpatient"
S DIR("A")="Select Encounter Type Desired"
D ^DIR
K DIR
I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
S BARY("INOUTPT")=Y
Q
PRVS ;EP
; Select Provider Inclusion Parameter
K BARZ("PRV")
W !
F D Q:Y<0!(BARDONE)
.S DIC("A")="Select PROVIDER: "
.D PRV^BARRSL1 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
.;S DIC="^VA(200,"
.;S DIC("S")="I $D(^(""PS""))"
.;S DIC("A")="Select PROVIDER: "
.;I $D(BARY("PRV")) S DIC("A")="Select Another PROVIDER: "
.;S DIC(0)="QEAM"
.;D ^DIC
.I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
.K DIC
.S:+Y>0 BARZ("PRV",+Y)=""
.I +Y<0,$D(BARZ("PRV")) Q
.I +Y<0,'$D(BARZ("PRV")) D ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28 ADD TO REPLACE ABOVE
..W "ALL",!
..S I=""
..F S I=$O(^VA(200,"AK.PROVIDER",I)) Q:I="" D
...S J=""
...F S J=$O(^VA(200,"AK.PROVIDER",I,J)) Q:+J=0 D
....I $D(^VA(200,+J,"PS")) S BARZ("PRV",+J)="" ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28 END ADD TO REPLACE ABOVE
Q
QUE ;EP
K IO("Q")
S ZTRTN="PRINT^BARRPVC",ZTDESC="Provider Visit Count Report"
S ZTSAVE("BAR*")=""
D ^%ZTLOAD
D ^%ZISC
I $D(ZTSK)[0 W !!?5,"REPORT CANCELLED!"
E W !!?5,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!
Q
;
PRINT ;EP
D LOOP
;
S BAR("PG")=1
D WHD
S BARVLTOT("BILLS")=0
S BARVLTOT("AMT")=0
I $Y>(IOSL-5) D HD I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
S BAR("PRVN")=""
F S BAR("PRVN")=$O(^TMP($J,"BAR-PVC",BAR("PRVN"))) Q:BAR("PRVN")="" D I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
.;W !!,BAR("PRVN"),?30,$J(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U),10),?40,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,2),",",2),16),?58,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,3),",",2),16)
.;W !!,$E(BAR("PRVN"),1,35),?38,$J(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U),10),?40,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,2),",",2),16),?54,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,3),",",2),16)
.W !!,$E(BAR("PRVN"),1,35),?40,+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U),?54,$FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,2),",",2),?69,$FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,3),",",2)
.S BARVLTOT("BILLS")=+$G(BARVLTOT("BILLS"))+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U)
.S BARVLTOT("AMT")=+$G(BARVLTOT("AMT"))+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,2)
.S BAR("BTYP")=0
.S BAR("BTYPTEST")=0
.F S BAR("BTYP")=$O(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"))) Q:'BAR("BTYP") D I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
..S BAR("BTYPTEST")=1
..W !?3,"Bill Type: "_$S(BAR("BTYP")="999999":"UNK",1:BAR("BTYP")) ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
..S BAR("VTYP")=0
..S BAR("VTYPTEST")=0
..F S BAR("VTYP")=$O(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))) Q:'BAR("VTYP") D I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
...S BAR("VTYPTEST")=1
...W !?5,"Visit Type: ",BAR("VTYP")_" "_$E($$GET1^DIQ(9002274.8,BAR("VTYP"),".01","E"),1,16)
...W ?38,$J(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U),8)
...W ?50,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,2),",",2),16)
...W ?66,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,3),",",2),14)
...I $Y>(IOSL-5) D HD
...I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
W !!
;
NODATA ;
S I=""
F S I=$O(BARZ("PRV",I)) Q:I=""!BARDONE D
.I +$G(BARZ("PRV",I))=0 W !!,"No data for Provider "_$$GET1^DIQ(200,I,".01","E"),! ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
.I $Y>(IOSL-5) D HD
.I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
S I=""
F S I=$O(^TMP($J,"BAR-PVC-LOC",I)) Q:+I=0!BARDONE D
.I $Y>(IOSL-5) D HD
.W !!,"Total: "_$$GET1^DIQ(90052.05,I,.01,"E"),?40,$P(^TMP($J,"BAR-PVC-LOC",I),U,2),?54,$FN(+$P($G(^TMP($J,"BAR-PVC-LOC",I)),U,3),",",2),?69,$FN(+$P($G(^TMP($J,"BAR-PVC-LOC",I)),U,4),",",2),!
.I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
W !!,"REPORT COMPLETE"
D ^%ZISC
K ^TMP($J,"BAR-PVC")
D CLNUP
Q
;
LOOP ;EP
;find all A/R Accounts that are insurers with insurer type Medicare FI
K ^TMP($J,"BAR-PVC")
S BARACCT=0
F S BARACCT=$O(^BARAC(DUZ(2),BARACCT)) Q:'BARACCT D
.I $P($G(^BARAC(DUZ(2),BARACCT,0)),U)'["AUTNINS" Q ;insurers only
.S D0=BARACCT
.S BARITYP=$$VALI^BARVPM(8) ;GET 'VIP INSURER TYPE' CODE (NUMBER)
.I BARITYP'="R" Q
.S BARY("ACCT",BARACCT)=""
;now go find all A/R Bills with those A/R Accounts
S BARACCT=0
F S BARACCT=$O(BARY("ACCT",BARACCT)) Q:'BARACCT D
.S BAR=0
.F S BAR=$O(^BARBL(DUZ(2),"D",BARACCT,BAR)) Q:'BAR D
..D BILL
..Q:'BARP("HIT")
..S:(+BAR("PRV")'=0) BAR("PRVN")=$$GET1^DIQ(200,BAR("PRV"),".01","E")
..S:(+BAR("PRV")'=0) BARZ("PRV",BAR("PRV"))=BARZ("PRV",BAR("PRV"))+1 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
..D TRANS ;look for pymts, pymt credits on bill
..S $P(^TMP($J,"BAR-PVC",BAR("PRVN")),U)=+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U)+1
..S $P(^TMP($J,"BAR-PVC",BAR("PRVN")),U,2)=+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,2)+BAR("AMT")
..S $P(^TMP($J,"BAR-PVC",BAR("PRVN")),U,3)=+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,3)+BARTRAMT
..S $P(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP")),U)=+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U)+1
..S $P(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP")),U,2)=+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,2)+BAR("AMT")
..S $P(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP")),U,3)=+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,3)+BARTRAMT
..S $P(^TMP($J,"BAR-PVC-LOC",BAR("VLOC")),U,1)=BAR("VLOC")
..S $P(^TMP($J,"BAR-PVC-LOC",BAR("VLOC")),U,2)=$P(^TMP($J,"BAR-PVC-LOC",BAR("VLOC")),U,2)+1 ;VISIT LOCATION COUNT ;IHS/DIT/CPC CR8398 BAR*1.8*28
..S $P(^TMP($J,"BAR-PVC-LOC",BAR("VLOC")),U,3)=$P(^TMP($J,"BAR-PVC-LOC",BAR("VLOC")),U,3)+BAR("AMT") ;VISIT LOCATION BILLED ;IHS/DIT/CPC CR8398 BAR*1.8*28
..S $P(^TMP($J,"BAR-PVC-LOC",BAR("VLOC")),U,4)=$P(^TMP($J,"BAR-PVC-LOC",BAR("VLOC")),U,4)+BARTRAMT ;VISIT LOCATION PAID ;IHS/DIT/CPC CR8398 BAR*1.8*28
..I $G(BARDEBUG) S ^TMP($J,"BAR-PVC-TEST",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"),BAR("DOS"),BAR)=BAR("AMT")_U_BARTRAMT ;for validation
Q
BILL ;EP
; for checking Bill File data parameters
S BARP("HIT")=0
S BAR("QUIT")=0
S BAR(0)=$G(^BARBL(DUZ(2),BAR,0)) ;A/R Bill 0 node
S BAR(1)=$G(^BARBL(DUZ(2),BAR,1)) ;A/R Bill 1 node
S BAR("VTYP")=$P(BAR(1),U,14) ;Visit type (3P Visit Type)
S BAR("BTYP")=+$$GET1^DIQ(90050.01,BAR,27)
S:'BAR("BTYP") BAR("BTYP")="999999" ;Bill type unknown
S BAR("VLOC")=$P(BAR(1),U,8) ;Visit location (A/R Parent/Sat)
S BAR("ACC")=$P(BAR(0),U,3) ;A/R Account
S BAR("DOS")=$P(BAR(1),U,2) ;DOS Begin
S BAR("ADT")=$P(BAR(0),U,18) ;3P Approval date
S BAR("PRV")=$P(BAR(1),U,13) ;Provider (New Person)
S BAR("AMT")=$P(BAR(0),U,13) ;Amount Billed
;
;S BARDEBUG=1
I +BAR("PRV")=0 S BAR("PRVN")="NO PROVIDER" ;no provider on bill
I $D(BAR("PRV")),'$D(BARZ("PRV",+BAR("PRV"))) D Q ;Not a selected provider
.I $G(BARDEBUG) S ^TMP($J,"BAR-PVC-TEST","REASON REJECTED","NOT SELECTED PROVIDER",BAR)=""
;
I $G(BARY("DT"))="V" D Q:$G(BAR("QUIT")) ; Not chosen visit date
.S:BAR("DOS")<BARY("DT",1) BAR("QUIT")=1
.S:BAR("DOS")>BARY("DT",2) BAR("QUIT")=1
.I $G(BAR("QUIT")) I $G(BARDEBUG) S ^TMP($J,"BAR-PVC-TEST","REASON REJECTED","NOT CHOSEN VISIT DATE",BAR)=""
;
I $G(BARY("DT"))="A" D Q:$G(BAR("QUIT")) ; Not chosen approval dt
.S:BAR("ADT")<BARY("DT",1) BAR("QUIT")=1
.S:$P(BAR("ADT"),".")>BARY("DT",2) BAR("QUIT")=1
.I $G(BAR("QUIT")) I $G(BARDEBUG) S ^TMP($J,"BAR-PVC-TEST","REASON REJECTED","NOT CHOSEN APPROVAL DATE",BAR)=""
;
I "^11^12^71^72^"[("^"_$E(BAR("BTYP"),1,2)_"^"),BARY("INOUTPT")=2 Q ;inpt but user selected outpt for report
I "^11^12^71^72^"'[("^"_$E(BAR("BTYP"),1,2)_"^"),BARY("INOUTPT")=1 Q ;outpt but user selected inpt for report
;
S BARP("HIT")=1
Q
TRANS ;EP
S BARTRIEN=0
S BARTRAMT=0
F S BARTRIEN=$O(^BARTR(DUZ(2),"AC",BAR,BARTRIEN)) Q:'BARTRIEN D
.I (($P($G(^BARTR(DUZ(2),BARTRIEN,1)),U)'=40)&($P($G(^BARTR(DUZ(2),BARTRIEN,1)),U,2)'=20)) Q ;pymt or pymt credits only
.S BARTRAMT=+$G(BARTRAMT)+($$GET1^DIQ(90050.03,BARTRIEN,3.5,"E")) ;credit-debit
Q
HD ;
D PAZ^BARRUTL I $D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(DIRUT) S BARDONE=1 Q
WHD ;
; Set header Array
NEW I
S BAR("HD",0)="Provider Visit Count Report"
S BAR("HD",1)="For Medicare"
S BAR("HD",2)="at ALL Visit Locations under "_$P($G(^AUTTLOC(DUZ(2),0)),U,2)_" Billing Location"
S BAR("HD",3)="with "_$S(BARY("DT")="A":"APPROVAL",1:"VISIT")_ " DATES from "_$$SDT^BARDUTL(BARY("DT",1))_" to "_$$SDT^BARDUTL(BARY("DT",2))
S BAR("HD",4)="for "_$S(BARY("INOUTPT")=1:"INPATIENT",BARY("INOUTPT")=2:"OUTPATIENT",1:"ALL")_" BILL TYPES"
S BAR("LVL")=0
S BAR("CONJ")=""
D WHD^BARRHD
W !,"Provider",?40,"Bill Count",?54,"Amount Billed",?69,"Amount Paid",!
F I=1:1:80 W "="
S BAR("PG")=BAR("PG")+1
Q
CLNUP ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
K BAR,BAR3PLOC,BARACCT,BARDONE,BAREND,BARHOLD,BARITYP,BARP,BARSTART,BARTRAMT
K BARTRIEN,BARVLTOT,BARY,BARZ,D0,DIC,DIQ,DR,I,J,L,X,Y
Q
;EOR - IHS/DIT/CPC 1.8*28
BARRPVC ; IHS/SD/SDR - Provider Visit Count Report ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26, 2005;Build 92
+2 ;IHS/SD/SDR 1.8*28 CR8398 HEAT301053 - new routine. Report of MACRA reporting. Prompts for approval or visit date, date range,
+3 ; inpatient/outpatient/both, and providers. It will find all A/R Accounts with insurer type MEDICARE FI, and report
+4 ; a summary line with a breakdown by bill type, visit type for each.
+5 ;
+6 QUIT
+7 ;*****************************************
EN ;
+1 WRITE !!,"NOTE: This report will contain data for all Visit Locations where a provider"
+2 WRITE !?7,"saw Medicare patients. There will be a summary line for each provider"
+3 WRITE !?7,"under each Visit Location, with detail lines underneath that breaks down"
+4 WRITE !?7,"the data further by bill type and visit type."
+5 ;
+6 KILL ^TMP($JOB,"BAR-PVC-TEST"),^TMP($JOB,"BAR-PVC"),^TMP($JOB,"BAR-PVC-LOC")
+7 SET BARDONE=0
+8 ;Setup basic A/R variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+9 ;approval or visit date
DO DTYP
+10 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
+11 ;prompt for dates
DO DATES
+12 IF '$DATA(BARY("DT"))!'$DATA(BARY("DT",1))!'$DATA(BARY("DT",2))
QUIT
+13 ;inpatient, outpatient, or both
DO INOUTPT
+14 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
+15 ;what providers, default to ALL
DO PRVS
+16 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
SEL ;Select device
+1 SET %ZIS="Q"
+2 SET %ZIS("A")="Enter DEVICE: "
+3 DO ^%ZIS
IF POP
QUIT
+4 IF IO'=IO(0)
DO QUE
DO HOME^%ZIS
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+5 SET IOP=ION
DO ^%ZIS
+6 DO PRINT
+7 QUIT
DTYP ;EP
+1 KILL BARY("DT"),BARSTART,BAREND
+2 SET DIR(0)="SO^1:Approval Date;2:Visit Date"
+3 SET DIR("A")="Select TYPE of DATE Desired"
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
+7 SET BARY("DT")=$SELECT(Y=1:"A",1:"V")
+8 QUIT
DATES ;EP
+1 ; Ask beginning and ending Transaction Dates
+2 WRITE !!," ============ Entry of "_$SELECT(BARY("DT")="A":"APPROVAL",1:"VISIT")_" DATE Range =============",!
+3 KILL %D
+4 SET BARSTART=$$DATE^BARDUTL(1)
+5 KILL %DT
+6 IF BARSTART<1
QUIT
+7 SET BAREND=$$DATE^BARDUTL(2)
+8 KILL %DT
+9 IF BAREND<1
WRITE !
GOTO DATES
+10 IF BAREND<BARSTART
Begin DoDot:1
+11 WRITE *7
+12 WRITE !!,"The END date must not be before the START date.",!
End DoDot:1
GOTO DATES
+13 SET BARY("DT",1)=BARSTART
+14 SET BARY("DT",2)=BAREND
+15 QUIT
INOUTPT ;EP
+1 KILL BARIOPT
+2 SET DIR(0)="SO^1:Inpatient;2:Outpatient;3:Both Inpatient and Outpatient"
+3 SET DIR("A")="Select Encounter Type Desired"
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
+7 SET BARY("INOUTPT")=Y
+8 QUIT
PRVS ;EP
+1 ; Select Provider Inclusion Parameter
+2 KILL BARZ("PRV")
+3 WRITE !
+4 FOR
Begin DoDot:1
+5 SET DIC("A")="Select PROVIDER: "
+6 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
DO PRV^BARRSL1
+7 ;S DIC="^VA(200,"
+8 ;S DIC("S")="I $D(^(""PS""))"
+9 ;S DIC("A")="Select PROVIDER: "
+10 ;I $D(BARY("PRV")) S DIC("A")="Select Another PROVIDER: "
+11 ;S DIC(0)="QEAM"
+12 ;D ^DIC
+13 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
+14 KILL DIC
+15 IF +Y>0
SET BARZ("PRV",+Y)=""
+16 IF +Y<0
IF $DATA(BARZ("PRV"))
QUIT
+17 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28 ADD TO REPLACE ABOVE
IF +Y<0
IF '$DATA(BARZ("PRV"))
Begin DoDot:2
+18 WRITE "ALL",!
+19 SET I=""
+20 FOR
SET I=$ORDER(^VA(200,"AK.PROVIDER",I))
IF I=""
QUIT
Begin DoDot:3
+21 SET J=""
+22 FOR
SET J=$ORDER(^VA(200,"AK.PROVIDER",I,J))
IF +J=0
QUIT
Begin DoDot:4
+23 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28 END ADD TO REPLACE ABOVE
IF $DATA(^VA(200,+J,"PS"))
SET BARZ("PRV",+J)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
IF Y<0!(BARDONE)
QUIT
+24 QUIT
QUE ;EP
+1 KILL IO("Q")
+2 SET ZTRTN="PRINT^BARRPVC"
SET ZTDESC="Provider Visit Count Report"
+3 SET ZTSAVE("BAR*")=""
+4 DO ^%ZTLOAD
+5 DO ^%ZISC
+6 IF $DATA(ZTSK)[0
WRITE !!?5,"REPORT CANCELLED!"
+7 IF '$TEST
WRITE !!?5,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!
+8 QUIT
+9 ;
PRINT ;EP
+1 DO LOOP
+2 ;
+3 SET BAR("PG")=1
+4 DO WHD
+5 SET BARVLTOT("BILLS")=0
+6 SET BARVLTOT("AMT")=0
+7 IF $Y>(IOSL-5)
DO HD
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
+8 SET BAR("PRVN")=""
+9 FOR
SET BAR("PRVN")=$ORDER(^TMP($JOB,"BAR-PVC",BAR("PRVN")))
IF BAR("PRVN")=""
QUIT
Begin DoDot:1
+10 ;W !!,BAR("PRVN"),?30,$J(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U),10),?40,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,2),",",2),16),?58,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,3),",",2),16)
+11 ;W !!,$E(BAR("PRVN"),1,35),?38,$J(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U),10),?40,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,2),",",2),16),?54,$J($FN(+$P($G(^TMP($J,"BAR-PVC",BAR("PRVN"))),U,3),",",2),16)
+12 WRITE !!,$EXTRACT(BAR("PRVN"),1,35),?40,+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U),?54,$FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U,2),",",2),?69,$FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U,3),",",2)
+13 SET BARVLTOT("BILLS")=+$GET(BARVLTOT("BILLS"))+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U)
+14 SET BARVLTOT("AMT")=+$GET(BARVLTOT("AMT"))+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U,2)
+15 SET BAR("BTYP")=0
+16 SET BAR("BTYPTEST")=0
+17 FOR
SET BAR("BTYP")=$ORDER(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP")))
IF 'BAR("BTYP")
QUIT
Begin DoDot:2
+18 SET BAR("BTYPTEST")=1
+19 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
WRITE !?3,"Bill Type: "_$SELECT(BAR("BTYP")="999999":"UNK",1:BAR("BTYP"))
+20 SET BAR("VTYP")=0
+21 SET BAR("VTYPTEST")=0
+22 FOR
SET BAR("VTYP")=$ORDER(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP")))
IF 'BAR("VTYP")
QUIT
Begin DoDot:3
+23 SET BAR("VTYPTEST")=1
+24 WRITE !?5,"Visit Type: ",BAR("VTYP")_" "_$EXTRACT($$GET1^DIQ(9002274.8,BAR("VTYP"),".01","E"),1,16)
+25 WRITE ?38,$JUSTIFY(+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U),8)
+26 WRITE ?50,$JUSTIFY($FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,2),",",2),16)
+27 WRITE ?66,$JUSTIFY($FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,3),",",2),14)
+28 IF $Y>(IOSL-5)
DO HD
+29 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
End DoDot:3
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
End DoDot:2
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
+30 WRITE !!
+31 ;
NODATA ;
+1 SET I=""
+2 FOR
SET I=$ORDER(BARZ("PRV",I))
IF I=""!BARDONE
QUIT
Begin DoDot:1
+3 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
IF +$GET(BARZ("PRV",I))=0
WRITE !!,"No data for Provider "_$$GET1^DIQ(200,I,".01","E"),!
+4 IF $Y>(IOSL-5)
DO HD
+5 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
End DoDot:1
+6 SET I=""
+7 FOR
SET I=$ORDER(^TMP($JOB,"BAR-PVC-LOC",I))
IF +I=0!BARDONE
QUIT
Begin DoDot:1
+8 IF $Y>(IOSL-5)
DO HD
+9 WRITE !!,"Total: "_$$GET1^DIQ(90052.05,I,.01,"E"),?40,$PIECE(^TMP($JOB,"BAR-PVC-LOC",I),U,2),?54,$FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PVC-LOC",I)),U,3),",",2),?69,$FNUMBER(+$PIECE($GET(^TMP($JOB,"BAR-PVC-LOC",I)),U,4),",",2),!
+10 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
End DoDot:1
+11 WRITE !!,"REPORT COMPLETE"
+12 DO ^%ZISC
+13 KILL ^TMP($JOB,"BAR-PVC")
+14 DO CLNUP
+15 QUIT
+16 ;
LOOP ;EP
+1 ;find all A/R Accounts that are insurers with insurer type Medicare FI
+2 KILL ^TMP($JOB,"BAR-PVC")
+3 SET BARACCT=0
+4 FOR
SET BARACCT=$ORDER(^BARAC(DUZ(2),BARACCT))
IF 'BARACCT
QUIT
Begin DoDot:1
+5 ;insurers only
IF $PIECE($GET(^BARAC(DUZ(2),BARACCT,0)),U)'["AUTNINS"
QUIT
+6 SET D0=BARACCT
+7 ;GET 'VIP INSURER TYPE' CODE (NUMBER)
SET BARITYP=$$VALI^BARVPM(8)
+8 IF BARITYP'="R"
QUIT
+9 SET BARY("ACCT",BARACCT)=""
End DoDot:1
+10 ;now go find all A/R Bills with those A/R Accounts
+11 SET BARACCT=0
+12 FOR
SET BARACCT=$ORDER(BARY("ACCT",BARACCT))
IF 'BARACCT
QUIT
Begin DoDot:1
+13 SET BAR=0
+14 FOR
SET BAR=$ORDER(^BARBL(DUZ(2),"D",BARACCT,BAR))
IF 'BAR
QUIT
Begin DoDot:2
+15 DO BILL
+16 IF 'BARP("HIT")
QUIT
+17 IF (+BAR("PRV")'=0)
SET BAR("PRVN")=$$GET1^DIQ(200,BAR("PRV"),".01","E")
+18 ;IHS/DIT/CPC - 20180419 CR8398 BAR*1.8*28
IF (+BAR("PRV")'=0)
SET BARZ("PRV",BAR("PRV"))=BARZ("PRV",BAR("PRV"))+1
+19 ;look for pymts, pymt credits on bill
DO TRANS
+20 SET $PIECE(^TMP($JOB,"BAR-PVC",BAR("PRVN")),U)=+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U)+1
+21 SET $PIECE(^TMP($JOB,"BAR-PVC",BAR("PRVN")),U,2)=+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U,2)+BAR("AMT")
+22 SET $PIECE(^TMP($JOB,"BAR-PVC",BAR("PRVN")),U,3)=+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"))),U,3)+BARTRAMT
+23 SET $PIECE(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP")),U)=+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U)+1
+24 SET $PIECE(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP")),U,2)=+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,2)+BAR("AMT")
+25 SET $PIECE(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP")),U,3)=+$PIECE($GET(^TMP($JOB,"BAR-PVC",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"))),U,3)+BARTRAMT
+26 SET $PIECE(^TMP($JOB,"BAR-PVC-LOC",BAR("VLOC")),U,1)=BAR("VLOC")
+27 ;VISIT LOCATION COUNT ;IHS/DIT/CPC CR8398 BAR*1.8*28
SET $PIECE(^TMP($JOB,"BAR-PVC-LOC",BAR("VLOC")),U,2)=$PIECE(^TMP($JOB,"BAR-PVC-LOC",BAR("VLOC")),U,2)+1
+28 ;VISIT LOCATION BILLED ;IHS/DIT/CPC CR8398 BAR*1.8*28
SET $PIECE(^TMP($JOB,"BAR-PVC-LOC",BAR("VLOC")),U,3)=$PIECE(^TMP($JOB,"BAR-PVC-LOC",BAR("VLOC")),U,3)+BAR("AMT")
+29 ;VISIT LOCATION PAID ;IHS/DIT/CPC CR8398 BAR*1.8*28
SET $PIECE(^TMP($JOB,"BAR-PVC-LOC",BAR("VLOC")),U,4)=$PIECE(^TMP($JOB,"BAR-PVC-LOC",BAR("VLOC")),U,4)+BARTRAMT
+30 ;for validation
IF $GET(BARDEBUG)
SET ^TMP($JOB,"BAR-PVC-TEST",BAR("PRVN"),BAR("BTYP"),BAR("VTYP"),BAR("DOS"),BAR)=BAR("AMT")_U_BARTRAMT
End DoDot:2
End DoDot:1
+31 QUIT
BILL ;EP
+1 ; for checking Bill File data parameters
+2 SET BARP("HIT")=0
+3 SET BAR("QUIT")=0
+4 ;A/R Bill 0 node
SET BAR(0)=$GET(^BARBL(DUZ(2),BAR,0))
+5 ;A/R Bill 1 node
SET BAR(1)=$GET(^BARBL(DUZ(2),BAR,1))
+6 ;Visit type (3P Visit Type)
SET BAR("VTYP")=$PIECE(BAR(1),U,14)
+7 SET BAR("BTYP")=+$$GET1^DIQ(90050.01,BAR,27)
+8 ;Bill type unknown
IF 'BAR("BTYP")
SET BAR("BTYP")="999999"
+9 ;Visit location (A/R Parent/Sat)
SET BAR("VLOC")=$PIECE(BAR(1),U,8)
+10 ;A/R Account
SET BAR("ACC")=$PIECE(BAR(0),U,3)
+11 ;DOS Begin
SET BAR("DOS")=$PIECE(BAR(1),U,2)
+12 ;3P Approval date
SET BAR("ADT")=$PIECE(BAR(0),U,18)
+13 ;Provider (New Person)
SET BAR("PRV")=$PIECE(BAR(1),U,13)
+14 ;Amount Billed
SET BAR("AMT")=$PIECE(BAR(0),U,13)
+15 ;
+16 ;S BARDEBUG=1
+17 ;no provider on bill
IF +BAR("PRV")=0
SET BAR("PRVN")="NO PROVIDER"
+18 ;Not a selected provider
IF $DATA(BAR("PRV"))
IF '$DATA(BARZ("PRV",+BAR("PRV")))
Begin DoDot:1
+19 IF $GET(BARDEBUG)
SET ^TMP($JOB,"BAR-PVC-TEST","REASON REJECTED","NOT SELECTED PROVIDER",BAR)=""
End DoDot:1
QUIT
+20 ;
+21 ; Not chosen visit date
IF $GET(BARY("DT"))="V"
Begin DoDot:1
+22 IF BAR("DOS")<BARY("DT",1)
SET BAR("QUIT")=1
+23 IF BAR("DOS")>BARY("DT",2)
SET BAR("QUIT")=1
+24 IF $GET(BAR("QUIT"))
IF $GET(BARDEBUG)
SET ^TMP($JOB,"BAR-PVC-TEST","REASON REJECTED","NOT CHOSEN VISIT DATE",BAR)=""
End DoDot:1
IF $GET(BAR("QUIT"))
QUIT
+25 ;
+26 ; Not chosen approval dt
IF $GET(BARY("DT"))="A"
Begin DoDot:1
+27 IF BAR("ADT")<BARY("DT",1)
SET BAR("QUIT")=1
+28 IF $PIECE(BAR("ADT"),".")>BARY("DT",2)
SET BAR("QUIT")=1
+29 IF $GET(BAR("QUIT"))
IF $GET(BARDEBUG)
SET ^TMP($JOB,"BAR-PVC-TEST","REASON REJECTED","NOT CHOSEN APPROVAL DATE",BAR)=""
End DoDot:1
IF $GET(BAR("QUIT"))
QUIT
+30 ;
+31 ;inpt but user selected outpt for report
IF "^11^12^71^72^"[("^"_$EXTRACT(BAR("BTYP"),1,2)_"^")
IF BARY("INOUTPT")=2
QUIT
+32 ;outpt but user selected inpt for report
IF "^11^12^71^72^"'[("^"_$EXTRACT(BAR("BTYP"),1,2)_"^")
IF BARY("INOUTPT")=1
QUIT
+33 ;
+34 SET BARP("HIT")=1
+35 QUIT
TRANS ;EP
+1 SET BARTRIEN=0
+2 SET BARTRAMT=0
+3 FOR
SET BARTRIEN=$ORDER(^BARTR(DUZ(2),"AC",BAR,BARTRIEN))
IF 'BARTRIEN
QUIT
Begin DoDot:1
+4 ;pymt or pymt credits only
IF (($PIECE($GET(^BARTR(DUZ(2),BARTRIEN,1)),U)'=40)&($PIECE($GET(^BARTR(DUZ(2),BARTRIEN,1)),U,2)'=20))
QUIT
+5 ;credit-debit
SET BARTRAMT=+$GET(BARTRAMT)+($$GET1^DIQ(90050.03,BARTRIEN,3.5,"E"))
End DoDot:1
+6 QUIT
HD ;
+1 DO PAZ^BARRUTL
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
SET BARDONE=1
QUIT
WHD ;
+1 ; Set header Array
+2 NEW I
+3 SET BAR("HD",0)="Provider Visit Count Report"
+4 SET BAR("HD",1)="For Medicare"
+5 SET BAR("HD",2)="at ALL Visit Locations under "_$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)_" Billing Location"
+6 SET BAR("HD",3)="with "_$SELECT(BARY("DT")="A":"APPROVAL",1:"VISIT")_
