Routine: BARRPVC

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.

 ;*****************************************

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

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")

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

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

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

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_" !",!

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

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

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

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

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

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

 ;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")_

BARRPVC.m