ABMM2PV1 ;IHS/SD/SDR - MU Patient Volume EP Report ; 20 Feb 2014 6:04 AM
;;2.6;IHS 3P BILLING SYSTEM;**11,12,15**;NOV 12, 2009;Build 251
;IHS/SD/SDR - 2.6*15 - HEAT161159 - Removed DEMO,PATIENT from report. Also added record indicator.
;IHS/SD/SDR - 2.6*15 - HEAT156874 - fix for programming error <SUBSCR>OTHERVST+23^ABMM2PV7. Flag wasn't getting reset from previous visit where it was looking for
; other visits on the same DOS.
;IHS/SD/SDR - 2.6*15 - HEAT171490 - Added code to put visit location NPI and TIN on patient list. Also added record indicator to label visits on pt list
; as to what grouping they were counted in.
;IHS/SD/SDR - 2.6*15 - HEAT174501 - Added primary provider NPI to group report.
;
COMPUTE ;EP - gather data
;spec. 90-day
I ABMY("90")="B" D Q
.S X1=ABMY("SDT")
.S X2=89
.D C^%DTC
.S (ABMY("EDT"),ABMP("EDT"))=X
.D VISITS
.D BILLS
.D ENROLL
.D CALC^ABMM2PV2
.D PRINT^ABMM2PV3
;
I ABMY("90")="E" D Q
.S X1=ABMY("SDT")
.S X2=89
.D C^%DTC
.S (ABMY("EDT"),ABMP("EDT"))=X
.D VISITS
.D BILLS
.D ENROLL
.D CALC^ABMM2PV2
.D PRINT^ABMM2PV3
;
;User specified
I ABMY("90")="C" D VISITS,BILLS,ENROLL,CALC^ABMM2PV2,PRINT^ABMM2PV3 Q
;
;auto
S (ABMY("SDT"),ABMP("SDT"))=(ABMY("QYR")-1700)_"0101"
S ABMP("EDT")=(ABMY("QYR")-1700)_"1231"
I +$G(ABMY("ADT"))'=0 D
.S ABMP("EDT")=ABMY("ADT")
.S X1=ABMY("ADT")
.S X2=-365
.D C^%DTC
.S (ABMY("SDT"),ABMP("SDT"))=X
D VISITS
D BILLS
D ENROLL
D CALC^ABMM2PV2
I ABMY("RTYP")="SEL",'$D(ABMPRVDR) Q
I ABMY("RTYP")="GRP",(+$G(^XTMP("ABM-PVP2",$J,"PRV TOP"))>29.99)
D PRINT^ABMM2PV3
K ABMY("EDT")
Q
VISITS ;
K ABMRIND ;make sure there is no record indicator for visits ;abm*2.6*15
S ABMSDT=ABMP("SDT")
S ABMEDT=ABMP("EDT")+.999999
S ABMINS=0,ABMOINS="NO BILL"
S ABMITYP="X"
F S ABMSDT=$O(^AUPNVSIT("B",ABMSDT)) Q:'ABMSDT!(ABMSDT>ABMEDT) D
.S ABMVDFN=0
.F S ABMVDFN=$O(^AUPNVSIT("B",ABMSDT,ABMVDFN)) Q:'ABMVDFN D
..Q:$$GET1^DIQ(9000010,ABMVDFN,".05","E")["DEMO,PATIENT" ;abm*2.6*15 HEAT161159 remove demo patients from list
..S ABMSCAT=$$GET1^DIQ(9000010,ABMVDFN,.07,"I") ;serv cat
..S ABMCLNC=$$GET1^DIQ(9000010,ABMVDFN,.08,"I") ;clinic
..S ABMP("VDT")=$P($$GET1^DIQ(9000010,ABMVDFN,.01,"I"),".") ;vst dt
..;Q:"^39^D1^D2^76^63^51^52^72^22^42^54^57^66^71^77^B5^C6^"[("^"_$$GET1^DIQ(40.7,$$GET1^DIQ(9000010,ABMVDFN,.08,"I"),1,"E")_"^")&(ABMY("RTYP")="SEL") ;exclude clinics ;abm*2.6*15 HEAT203662
..Q:"^39^D1^D2^76^63^51^52^72^22^42^54^57^66^71^77^B5^C6^"[("^"_$$GET1^DIQ(40.7,$$GET1^DIQ(9000010,ABMVDFN,.08,"I"),1,"I")_"^")&(ABMY("RTYP")="SEL") ;exclude clinics ;abm*2.6*15 HEAT203662
..S ABMPT=$$GET1^DIQ(9000010,ABMVDFN,.05,"I") ;pt
..;if SEL rpt type, serv cat MUST be S,O,R, or (A w/clinic'=30)
..I "^H^I^C^T^N^E^D^X^R^"[("^"_ABMSCAT_"^") Q
..I (ABMSCAT="A")&(ABMCLNC=30) Q
..S ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,.06,"I")
..Q:ABMVLOC=""
..I ($$GET1^DIQ(9000010,ABMVDFN,.12)'="")&(ABMSDT>$$GET1^DIQ(9000010,ABMVDFN,.12,"I")&($$GET1^DIQ(9000010,ABMVDFN,1111,"I")'="R")) Q
..Q:'$D(ABMF(ABMVLOC)) ;not a selected loc
..S ABMNPI=$S($P($$NPI^XUSNPI("Organization_ID",ABMVLOC),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMVLOC),U),1:"") ;abm*2.6*15 added
..S ABMTIN=$$GET1^DIQ(9999999.06,ABMVLOC,".21","E") ;abm*2.6*15 added
..I ABMY("RTYP")="GRP" D GRPVST Q
..S ABMPIEN=0
..K ABMPRVC
..F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D
...S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
...Q:'$D(ABMPRVDR(ABMPRV))
...;skip prv if on vst >1
...Q:$D(ABMPRVC(ABMPRV))
...S ABMPRVC(ABMPRV)=1
...D CALCDTS
...S ABMDTFLG=0
...S ABMP("BDT")=ABMP("BSDT")
...;Q:$D(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMSDT)) ;abm*2.6*15
...Q:$D(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)) ;make sure it hasn't counted this specific visit already ;abm*2.6*15
...F D Q:ABMDTFLG=1
....I ABMP("VDT")<ABMP("BSDT") Q ;vst is before 90-day
....S ^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT"),ABMPRV)=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT"),ABMPRV))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT"),ABMPRV,ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT"),ABMPRV,ABMVLOC))+1
....S ^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)="" ;list of vsts by pt,DOS
....S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)="" ;list of vsts to chk for pymt
....S ^XTMP("ABM-PVP2",$J,"VISIT CNT",ABMP("BDT"))=+$G(^XTMP("ABM-PVP2",$J,"VISIT CNT",ABMP("BDT")))+1 ;cnt vsts
....S ^XTMP("ABM-PVP2",$J,"ALL VISITS",ABMP("BDT"),ABMVDFN)="" ;list of all vsts looked at
....I (^XTMP("ABM-PVP2",$J,"VISIT CNT",ABMP("BDT"))#1000&(IOST["C")) W "." U 0 W "."
....K ABMITYP
....D PTDATA
....S X1=ABMP("BDT")
....S X2=1
....D C^%DTC
....I X>ABMP("BEDT") S ABMDTFLG=1 Q
....S ABMP("BDT")=X
;
Q
GRPVST ;EP
S ABMPIEN=0
K ABMPRVC
K ABMPNPI,ABMPRVN ;IHS/SD/SDR 9/5/14 HEAT174501
F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D
.S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
.;start new abm*2.6*15 HEAT174501
.S ABMPRVST=$$GET1^DIQ(9000010.06,ABMPIEN,".04","I")
.I ABMPRVST="P" D
..S ABMPNPI=$S($P($$NPI^XUSNPI("Individual_ID",+ABMPRV),U)>0:$P($$NPI^XUSNPI("Individual_ID",+ABMPRV),U),1:"")
..S ABMPRVN=$$GET1^DIQ(9000010.06,ABMPIEN,".01","E")
..S ^XTMP("ABM-PVP2",$J,"PRVS",ABMVDFN)=ABMPNPI_U_ABMPRVN
.;end new HEAT174501
.;skip prv if on vst >1
.Q:$D(ABMPRVC(ABMPRV))
.S ABMPRVC(ABMPRV)=1
.S ABMPRVCL=+$$GET1^DIQ(200,ABMPRV,53.5,"I")
.I ABMPRVCL=0 S ABMPRV("O",ABMPRV)=""
.I ABMPRVCL'=0 D
..I '$D(^ABMMUPRM(1,2,"B",ABMPRVCL)) S ABMPRV("O",ABMPRV)=""
..I $$GET1^DIQ(7,ABMPRVCL,9999999.01,"E")=11 D
...I '$D(^ABMMUPRM(1,1,"B",ABMVLOC)) S ABMPRV("O",ABMPRV)=""
...I $D(^ABMMUPRM(1,1,"B",ABMVLOC)) D
....S ABMVIEN=$O(^ABMMUPRM(1,1,"B",ABMVLOC,0))
....I $P($G(^ABMMUPRM(1,1,ABMVIEN,0)),U,2)=1 S ABMPRV("E",ABMPRV)=""
....I $P($G(^ABMMUPRM(1,1,ABMVIEN,0)),U,2)'=1 S ABMPRV("O",ABMPRV)=""
..I $$GET1^DIQ(7,ABMPRVCL,9999999.01,"E")'=11,$D(^ABMMUPRM(1,2,"B",ABMPRVCL)) S ABMPRV("E",ABMPRV)=""
D CALCDTS
S ABMDTFLG=0
S ABMP("BDT")=ABMP("BSDT")
Q:$D(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMSDT))
F D Q:ABMDTFLG=1
.S ^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT"))=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT")))+1
.S ^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMP("BDT"),ABMVLOC))+1
.S ^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)="" ;list of vsts by pt,DOS
.S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)="" ;list of vsts to chk for pymt
.S ^XTMP("ABM-PVP2",$J,"VISIT CNT",ABMP("BDT"))=+$G(^XTMP("ABM-PVP2",$J,"VISIT CNT",ABMP("BDT")))+1 ;cnt of vsts
.I (^XTMP("ABM-PVP2",$J,"VISIT CNT",ABMP("BDT"))#1000&(IOST["C")) W "." U 0 W "."
.D GPTDATA
.;
.S X1=ABMP("BDT")
.S X2=1
.D C^%DTC
.I X>ABMP("VDT") S ABMDTFLG=1 Q
.S ABMP("BDT")=X
.K ABMITYP
Q
CALCDTS ;EP
;Calc 90 days
S X1=$P(ABMSDT,".")
S X2=$P(ABMY("SDT"),".")
D ^%DTC
S X1=$P(ABMSDT,".")
S X2=$S(X<89:-X,1:-89)
D C^%DTC
S ABMP("BSDT")=X
S ABMP("BEDT")=ABMP("VDT")
Q
BILLS ;E
S ABMCNT=0
S ABMDUZ2=0
S ABMFOUND=0
F S ABMDUZ2=$O(^ABMDBILL(ABMDUZ2)) Q:'ABMDUZ2 D
.Q:'$D(^ABMDBILL(ABMDUZ2,0))
.S ABMVDFN=0
.F S ABMVDFN=$O(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)) Q:'ABMVDFN D
..S ABMBILLF=0
..S ABMFOUND=0 ;abm*2.6*15 HEAT156874
..S ABMRIND="" ;abm*2.6*15 HEAT161159 record indicator
..Q:($G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=1) ;already cnted this vst on rpt
..Q:'$D(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN)) ;vst not under DUZ(2)
..K ABMBILLN,ABMSAV
..S ABMP("BDFN")=0
..F S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN,ABMP("BDFN"))) Q:'ABMP("BDFN") D Q:ABMBILLF
...Q:($G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=1) ;already cnted this vst on rpt
...;S (ABMBILLN,ABMSAV)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U) ;abm*2.6*15 HEAT161159 record indicator
...S (ABMBILLN,ABMSAV,ABMBNUM)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U) ;abm*2.6*15 HEAT161159 record indicator
...I $P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,4)="X" Q
...S ABMSDT=$P($$GET1^DIQ(9000010,ABMVDFN,".01","I"),".")
...S ABMVLOC=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
...S ABMP("VDT")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U)
...S ABMINS=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8)
...;S ABMTSI=$P($G(^ABMNINS(ABMDUZ2,ABMINS,0)),U,11) ;abm*2.6*15 HEAT183289
...S ABMPT=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
...S (ABMDOS,ABMDOSSV)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U)
...;start new abm*2.6*15 HEAT171490
...S ABMVTYP=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,7)
...S ABMLNPI=$S($P($G(^ABMNINS(ABMVLOC,ABMINS,1,ABMVTYP,1)),U,8)'="":$P(^ABMNINS(ABMVLOC,ABMINS,1,ABMVTYP,1),U,8),$P($G(^ABMDPARM(ABMVLOC,1,2)),U,12)'="":$P(^ABMDPARM(ABMVLOC,1,2),U,12),1:ABMVLOC)
...S ABMNPI=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
...S ABMTIN=$$GET1^DIQ(9999999.06,ABMLNPI,".21","E")
...;end new HEAT171490
...K ABMDX
...D PRIMPOV^ABMM2PV7 ;get prim POV for bill
...D ARBILLS
...S ABMBILLN=ABMBNUM ;abm*2.6*15 HEAT161159 record indicator
...I +$G(ABMFOUND)=1 D OTHERVST ;check for other vsts on DOS to mark pd
..;
..S ABMRIND="" ;abm*2.6*15 HEAT161159 record indicator
..;look thru bills found & remove zero pays when pymt was found - GROUP PROVIDERS
..I ABMY("RTYP")="GRP" D Q
...S ABMP("BDT")=0
...F S ABMP("BDT")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"))) Q:'ABMP("BDT") D
....S ABMGRP=""
....F S ABMGRP=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMGRP)) Q:ABMGRP="" D
.....S ABMP("VDFN")=0 ;abm*2.6*12
.....F S ABMP("VDFN")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN"))) Q:'ABMP("VDFN") D
......I $D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN"))) D
.......K ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN"))
......S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMGRP))+1
......S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,ABMGRP))+1
......;I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="PD" ;abm*2.6*15 HEAT161159 record indicator
...K ^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS")
...S ABMP("BDT")=0
...F S ABMP("BDT")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"))) Q:'ABMP("BDT") D
....S ABMGRP=""
....F S ABMGRP=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP)) Q:ABMGRP="" D
.....S ABMP("VDFN")=0 ;abm*2.6*12
.....F S ABMP("VDFN")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN"))) Q:'ABMP("VDFN") D
......S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,ABMGRP))+1
......S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMGRP))+1
......;I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="ZPD" ;abm*2.6*15 HEAT161159 record indicator
...K ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS")
..;
..;look thru bills found & remove zero pays when pymt was found - INDIV PRVS
..S ABMP("BDT")=0
..F S ABMP("BDT")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"))) Q:'ABMP("BDT") D
...S ABMPRV=0
...F S ABMPRV=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV)) Q:'ABMPRV D
....S ABMGRP=""
....F S ABMGRP=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV,ABMGRP)) Q:ABMGRP="" D
.....S ABMP("VDFN")=0 ;abm*2.6*12
.....F S ABMP("VDFN")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN"))) Q:'ABMP("VDFN") D
......I $D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN"))) D
.......K ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN"))
......S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMGRP))+1
......S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
......S ^XTMP("ABM-PVP2",$J,"TEST","PD",ABMP("BDT"),ABMVDFN)=""
......;I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="PD" ;abm*2.6*15 HEAT161159 record indicator
..K ^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS")
..S ABMP("BDT")=0
..F S ABMP("BDT")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"))) Q:'ABMP("BDT") D
...S ABMPRV=0
...F S ABMPRV=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV)) Q:'ABMPRV D
....S ABMGRP=""
....F S ABMGRP=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP)) Q:ABMGRP="" D
.....S ABMP("VDFN")=0
.....F S ABMP("VDFN")=$O(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN"))) Q:'ABMP("VDFN") D
.....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
.....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMGRP))+1
.....S ^XTMP("ABM-PVP2",$J,"TEST","ZEROPD",ABMP("BDT"),ABMVDFN)=""
....;.I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="ZPD" ;abm*2.6*15 HEAT161159 record indicator
..K ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS")
Q
ARBILLS ;
D ARBILLS^ABMM2P12 ;abm*2.6*15 split routine due to size
Q
TRANS ;
D TRANS^ABMM2P12 ;abm*2.6*15 split routine due to size
Q
ZEROPD ;EP
D ZEROPD^ABMM2PV7
Q
GRPBILL ;
D GRPBILL^ABMM2PV7
Q
GRPOTHVS ;
D GRPOTHVS^ABMM2PV7
Q
OTHERVST ;EP
D OTHERVST^ABMM2PV7
Q
GPTDATA ;EP
D GPTDATA^ABMM2PV7
Q
PTDATA ;EP
D PTDATA^ABMM2PV7
Q
ENROLL ;EP
D ENROLL^ABMM2PV7
Q
ABMM2PV1 ;IHS/SD/SDR - MU Patient Volume EP Report ; 20 Feb 2014 6:04 AM
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,12,15**;NOV 12, 2009;Build 251
+2 ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Removed DEMO,PATIENT from report. Also added record indicator.
+3 ;IHS/SD/SDR - 2.6*15 - HEAT156874 - fix for programming error <SUBSCR>OTHERVST+23^ABMM2PV7. Flag wasn't getting reset from previous visit where it was looking for
+4 ; other visits on the same DOS.
+5 ;IHS/SD/SDR - 2.6*15 - HEAT171490 - Added code to put visit location NPI and TIN on patient list. Also added record indicator to label visits on pt list
+6 ; as to what grouping they were counted in.
+7 ;IHS/SD/SDR - 2.6*15 - HEAT174501 - Added primary provider NPI to group report.
+8 ;
COMPUTE ;EP - gather data
+1 ;spec. 90-day
+2 IF ABMY("90")="B"
Begin DoDot:1
+3 SET X1=ABMY("SDT")
+4 SET X2=89
+5 DO C^%DTC
+6 SET (ABMY("EDT"),ABMP("EDT"))=X
+7 DO VISITS
+8 DO BILLS
+9 DO ENROLL
+10 DO CALC^ABMM2PV2
+11 DO PRINT^ABMM2PV3
End DoDot:1
QUIT
+12 ;
+13 IF ABMY("90")="E"
Begin DoDot:1
+14 SET X1=ABMY("SDT")
+15 SET X2=89
+16 DO C^%DTC
+17 SET (ABMY("EDT"),ABMP("EDT"))=X
+18 DO VISITS
+19 DO BILLS
+20 DO ENROLL
+21 DO CALC^ABMM2PV2
+22 DO PRINT^ABMM2PV3
End DoDot:1
QUIT
+23 ;
+24 ;User specified
+25 IF ABMY("90")="C"
DO VISITS
DO BILLS
DO ENROLL
DO CALC^ABMM2PV2
DO PRINT^ABMM2PV3
QUIT
+26 ;
+27 ;auto
+28 SET (ABMY("SDT"),ABMP("SDT"))=(ABMY("QYR")-1700)_"0101"
+29 SET ABMP("EDT")=(ABMY("QYR")-1700)_"1231"
+30 IF +$GET(ABMY("ADT"))'=0
Begin DoDot:1
+31 SET ABMP("EDT")=ABMY("ADT")
+32 SET X1=ABMY("ADT")
+33 SET X2=-365
+34 DO C^%DTC
+35 SET (ABMY("SDT"),ABMP("SDT"))=X
End DoDot:1
+36 DO VISITS
+37 DO BILLS
+38 DO ENROLL
+39 DO CALC^ABMM2PV2
+40 IF ABMY("RTYP")="SEL"
IF '$DATA(ABMPRVDR)
QUIT
+41 IF ABMY("RTYP")="GRP"
IF (+$GET(^XTMP("ABM-PVP2",$JOB,"PRV TOP"))>29.99)
+42 DO PRINT^ABMM2PV3
+43 KILL ABMY("EDT")
+44 QUIT
VISITS ;
+1 ;make sure there is no record indicator for visits ;abm*2.6*15
KILL ABMRIND
+2 SET ABMSDT=ABMP("SDT")
+3 SET ABMEDT=ABMP("EDT")+.999999
+4 SET ABMINS=0
SET ABMOINS="NO BILL"
+5 SET ABMITYP="X"
+6 FOR
SET ABMSDT=$ORDER(^AUPNVSIT("B",ABMSDT))
IF 'ABMSDT!(ABMSDT>ABMEDT)
QUIT
Begin DoDot:1
+7 SET ABMVDFN=0
+8 FOR
SET ABMVDFN=$ORDER(^AUPNVSIT("B",ABMSDT,ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:2
+9 ;abm*2.6*15 HEAT161159 remove demo patients from list
IF $$GET1^DIQ(9000010,ABMVDFN,".05","E")["DEMO,PATIENT"
QUIT
+10 ;serv cat
SET ABMSCAT=$$GET1^DIQ(9000010,ABMVDFN,.07,"I")
+11 ;clinic
SET ABMCLNC=$$GET1^DIQ(9000010,ABMVDFN,.08,"I")
+12 ;vst dt
SET ABMP("VDT")=$PIECE($$GET1^DIQ(9000010,ABMVDFN,.01,"I"),".")
+13 ;Q:"^39^D1^D2^76^63^51^52^72^22^42^54^57^66^71^77^B5^C6^"[("^"_$$GET1^DIQ(40.7,$$GET1^DIQ(9000010,ABMVDFN,.08,"I"),1,"E")_"^")&(ABMY("RTYP")="SEL") ;exclude clinics ;abm*2.6*15 HEAT203662
+14 ;exclude clinics ;abm*2.6*15 HEAT203662
IF "^39^D1^D2^76^63^51^52^72^22^42^54^57^66^71^77^B5^C6^"[("^"_$$GET1^DIQ(40.7,$$GET1^DIQ(9000010,ABMVDFN,.08,"I"),1,"I")_"^")&(ABMY("RTYP")="SEL")
QUIT
+15 ;pt
SET ABMPT=$$GET1^DIQ(9000010,ABMVDFN,.05,"I")
+16 ;if SEL rpt type, serv cat MUST be S,O,R, or (A w/clinic'=30)
+17 IF "^H^I^C^T^N^E^D^X^R^"[("^"_ABMSCAT_"^")
QUIT
+18 IF (ABMSCAT="A")&(ABMCLNC=30)
QUIT
+19 SET ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,.06,"I")
+20 IF ABMVLOC=""
QUIT
+21 IF ($$GET1^DIQ(9000010,ABMVDFN,.12)'="")&(ABMSDT>$$GET1^DIQ(9000010,ABMVDFN,.12,"I")&($$GET1^DIQ(9000010,ABMVDFN,1111,"I")'="R"))
QUIT
+22 ;not a selected loc
IF '$DATA(ABMF(ABMVLOC))
QUIT
+23 ;abm*2.6*15 added
SET ABMNPI=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMVLOC),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",ABMVLOC),U),1:"")
+24 ;abm*2.6*15 added
SET ABMTIN=$$GET1^DIQ(9999999.06,ABMVLOC,".21","E")
+25 IF ABMY("RTYP")="GRP"
DO GRPVST
QUIT
+26 SET ABMPIEN=0
+27 KILL ABMPRVC
+28 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:3
+29 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+30 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+31 ;skip prv if on vst >1
+32 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+33 SET ABMPRVC(ABMPRV)=1
+34 DO CALCDTS
+35 SET ABMDTFLG=0
+36 SET ABMP("BDT")=ABMP("BSDT")
+37 ;Q:$D(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMSDT)) ;abm*2.6*15
+38 ;make sure it hasn't counted this specific visit already ;abm*2.6*15
IF $DATA(^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMSDT,ABMVDFN))
QUIT
+39 FOR
Begin DoDot:4
+40 ;vst is before 90-day
IF ABMP("VDT")<ABMP("BSDT")
QUIT
+41 SET ^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT"),ABMPRV)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT"),ABMPRV))+1
+42 SET ^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT"),ABMPRV,ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT"),ABMPRV,ABMVLOC))+1
+43 ;list of vsts by pt,DOS
SET ^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)=""
+44 ;list of vsts to chk for pymt
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=""
+45 ;cnt vsts
SET ^XTMP("ABM-PVP2",$JOB,"VISIT CNT",ABMP("BDT"))=+$GET(^XTMP("ABM-PVP2",$JOB,"VISIT CNT",ABMP("BDT")))+1
+46 ;list of all vsts looked at
SET ^XTMP("ABM-PVP2",$JOB,"ALL VISITS",ABMP("BDT"),ABMVDFN)=""
+47 IF (^XTMP("ABM-PVP2",$JOB,"VISIT CNT",ABMP("BDT"))#1000&(IOST["C"))
WRITE "."
USE 0
WRITE "."
+48 KILL ABMITYP
+49 DO PTDATA
+50 SET X1=ABMP("BDT")
+51 SET X2=1
+52 DO C^%DTC
+53 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+54 SET ABMP("BDT")=X
End DoDot:4
IF ABMDTFLG=1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+55 ;
+56 QUIT
GRPVST ;EP
+1 SET ABMPIEN=0
+2 KILL ABMPRVC
+3 ;IHS/SD/SDR 9/5/14 HEAT174501
KILL ABMPNPI,ABMPRVN
+4 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:1
+5 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+6 ;start new abm*2.6*15 HEAT174501
+7 SET ABMPRVST=$$GET1^DIQ(9000010.06,ABMPIEN,".04","I")
+8 IF ABMPRVST="P"
Begin DoDot:2
+9 SET ABMPNPI=$SELECT($PIECE($$NPI^XUSNPI("Individual_ID",+ABMPRV),U)>0:$PIECE($$NPI^XUSNPI("Individual_ID",+ABMPRV),U),1:"")
+10 SET ABMPRVN=$$GET1^DIQ(9000010.06,ABMPIEN,".01","E")
+11 SET ^XTMP("ABM-PVP2",$JOB,"PRVS",ABMVDFN)=ABMPNPI_U_ABMPRVN
End DoDot:2
+12 ;end new HEAT174501
+13 ;skip prv if on vst >1
+14 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+15 SET ABMPRVC(ABMPRV)=1
+16 SET ABMPRVCL=+$$GET1^DIQ(200,ABMPRV,53.5,"I")
+17 IF ABMPRVCL=0
SET ABMPRV("O",ABMPRV)=""
+18 IF ABMPRVCL'=0
Begin DoDot:2
+19 IF '$DATA(^ABMMUPRM(1,2,"B",ABMPRVCL))
SET ABMPRV("O",ABMPRV)=""
+20 IF $$GET1^DIQ(7,ABMPRVCL,9999999.01,"E")=11
Begin DoDot:3
+21 IF '$DATA(^ABMMUPRM(1,1,"B",ABMVLOC))
SET ABMPRV("O",ABMPRV)=""
+22 IF $DATA(^ABMMUPRM(1,1,"B",ABMVLOC))
Begin DoDot:4
+23 SET ABMVIEN=$ORDER(^ABMMUPRM(1,1,"B",ABMVLOC,0))
+24 IF $PIECE($GET(^ABMMUPRM(1,1,ABMVIEN,0)),U,2)=1
SET ABMPRV("E",ABMPRV)=""
+25 IF $PIECE($GET(^ABMMUPRM(1,1,ABMVIEN,0)),U,2)'=1
SET ABMPRV("O",ABMPRV)=""
End DoDot:4
End DoDot:3
+26 IF $$GET1^DIQ(7,ABMPRVCL,9999999.01,"E")'=11
IF $DATA(^ABMMUPRM(1,2,"B",ABMPRVCL))
SET ABMPRV("E",ABMPRV)=""
End DoDot:2
End DoDot:1
+27 DO CALCDTS
+28 SET ABMDTFLG=0
+29 SET ABMP("BDT")=ABMP("BSDT")
+30 IF $DATA(^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMSDT))
QUIT
+31 FOR
Begin DoDot:1
+32 SET ^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT"))=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT")))+1
+33 SET ^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMP("BDT"),ABMVLOC))+1
+34 ;list of vsts by pt,DOS
SET ^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)=""
+35 ;list of vsts to chk for pymt
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=""
+36 ;cnt of vsts
SET ^XTMP("ABM-PVP2",$JOB,"VISIT CNT",ABMP("BDT"))=+$GET(^XTMP("ABM-PVP2",$JOB,"VISIT CNT",ABMP("BDT")))+1
+37 IF (^XTMP("ABM-PVP2",$JOB,"VISIT CNT",ABMP("BDT"))#1000&(IOST["C"))
WRITE "."
USE 0
WRITE "."
+38 DO GPTDATA
+39 ;
+40 SET X1=ABMP("BDT")
+41 SET X2=1
+42 DO C^%DTC
+43 IF X>ABMP("VDT")
SET ABMDTFLG=1
QUIT
+44 SET ABMP("BDT")=X
+45 KILL ABMITYP
End DoDot:1
IF ABMDTFLG=1
QUIT
+46 QUIT
CALCDTS ;EP
+1 ;Calc 90 days
+2 SET X1=$PIECE(ABMSDT,".")
+3 SET X2=$PIECE(ABMY("SDT"),".")
+4 DO ^%DTC
+5 SET X1=$PIECE(ABMSDT,".")
+6 SET X2=$SELECT(X<89:-X,1:-89)
+7 DO C^%DTC
+8 SET ABMP("BSDT")=X
+9 SET ABMP("BEDT")=ABMP("VDT")
+10 QUIT
BILLS ;E
+1 SET ABMCNT=0
+2 SET ABMDUZ2=0
+3 SET ABMFOUND=0
+4 FOR
SET ABMDUZ2=$ORDER(^ABMDBILL(ABMDUZ2))
IF 'ABMDUZ2
QUIT
Begin DoDot:1
+5 IF '$DATA(^ABMDBILL(ABMDUZ2,0))
QUIT
+6 SET ABMVDFN=0
+7 FOR
SET ABMVDFN=$ORDER(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:2
+8 SET ABMBILLF=0
+9 ;abm*2.6*15 HEAT156874
SET ABMFOUND=0
+10 ;abm*2.6*15 HEAT161159 record indicator
SET ABMRIND=""
+11 ;already cnted this vst on rpt
IF ($GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=1)
QUIT
+12 ;vst not under DUZ(2)
IF '$DATA(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN))
QUIT
+13 KILL ABMBILLN,ABMSAV
+14 SET ABMP("BDFN")=0
+15 FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN,ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:3
+16 ;already cnted this vst on rpt
IF ($GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=1)
QUIT
+17 ;S (ABMBILLN,ABMSAV)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U) ;abm*2.6*15 HEAT161159 record indicator
+18 ;abm*2.6*15 HEAT161159 record indicator
SET (ABMBILLN,ABMSAV,ABMBNUM)=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
+19 IF $PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,4)="X"
QUIT
+20 SET ABMSDT=$PIECE($$GET1^DIQ(9000010,ABMVDFN,".01","I"),".")
+21 SET ABMVLOC=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
+22 SET ABMP("VDT")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U)
+23 SET ABMINS=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8)
+24 ;S ABMTSI=$P($G(^ABMNINS(ABMDUZ2,ABMINS,0)),U,11) ;abm*2.6*15 HEAT183289
+25 SET ABMPT=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
+26 SET (ABMDOS,ABMDOSSV)=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U)
+27 ;start new abm*2.6*15 HEAT171490
+28 SET ABMVTYP=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,7)
+29 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMVLOC,ABMINS,1,ABMVTYP,1)),U,8)'="":$PIECE(^ABMNINS(ABMVLOC,ABMINS,1,ABMVTYP,1),U,8),$PIECE($GET(^ABMDPARM(ABMVLOC,1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMVLOC,1,2),U,12),1:ABMVLOC)
+30 SET ABMNPI=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
+31 SET ABMTIN=$$GET1^DIQ(9999999.06,ABMLNPI,".21","E")
+32 ;end new HEAT171490
+33 KILL ABMDX
+34 ;get prim POV for bill
DO PRIMPOV^ABMM2PV7
+35 DO ARBILLS
+36 ;abm*2.6*15 HEAT161159 record indicator
SET ABMBILLN=ABMBNUM
+37 ;check for other vsts on DOS to mark pd
IF +$GET(ABMFOUND)=1
DO OTHERVST
End DoDot:3
IF ABMBILLF
QUIT
+38 ;
+39 ;abm*2.6*15 HEAT161159 record indicator
SET ABMRIND=""
+40 ;look thru bills found & remove zero pays when pymt was found - GROUP PROVIDERS
+41 IF ABMY("RTYP")="GRP"
Begin DoDot:3
+42 SET ABMP("BDT")=0
+43 FOR
SET ABMP("BDT")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT")))
IF 'ABMP("BDT")
QUIT
Begin DoDot:4
+44 SET ABMGRP=""
+45 FOR
SET ABMGRP=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT"),ABMGRP))
IF ABMGRP=""
QUIT
Begin DoDot:5
+46 ;abm*2.6*12
SET ABMP("VDFN")=0
+47 FOR
SET ABMP("VDFN")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN")))
IF 'ABMP("VDFN")
QUIT
Begin DoDot:6
+48 IF $DATA(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN")))
Begin DoDot:7
+49 KILL ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN"))
End DoDot:7
+50 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMGRP))+1
+51 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,ABMGRP))+1
+52 ;I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="PD" ;abm*2.6*15 HEAT161159 record indicator
End DoDot:6
End DoDot:5
End DoDot:4
+53 KILL ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS")
+54 SET ABMP("BDT")=0
+55 FOR
SET ABMP("BDT")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT")))
IF 'ABMP("BDT")
QUIT
Begin DoDot:4
+56 SET ABMGRP=""
+57 FOR
SET ABMGRP=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP))
IF ABMGRP=""
QUIT
Begin DoDot:5
+58 ;abm*2.6*12
SET ABMP("VDFN")=0
+59 FOR
SET ABMP("VDFN")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMP("VDFN")))
IF 'ABMP("VDFN")
QUIT
Begin DoDot:6
+60 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,ABMGRP))+1
+61 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMGRP))+1
+62 ;I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="ZPD" ;abm*2.6*15 HEAT161159 record indicator
End DoDot:6
End DoDot:5
End DoDot:4
+63 KILL ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS")
End DoDot:3
QUIT
+64 ;
+65 ;look thru bills found & remove zero pays when pymt was found - INDIV PRVS
+66 SET ABMP("BDT")=0
+67 FOR
SET ABMP("BDT")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT")))
IF 'ABMP("BDT")
QUIT
Begin DoDot:3
+68 SET ABMPRV=0
+69 FOR
SET ABMPRV=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV))
IF 'ABMPRV
QUIT
Begin DoDot:4
+70 SET ABMGRP=""
+71 FOR
SET ABMGRP=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV,ABMGRP))
IF ABMGRP=""
QUIT
Begin DoDot:5
+72 ;abm*2.6*12
SET ABMP("VDFN")=0
+73 FOR
SET ABMP("VDFN")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN")))
IF 'ABMP("VDFN")
QUIT
Begin DoDot:6
+74 IF $DATA(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN")))
Begin DoDot:7
+75 KILL ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN"))
End DoDot:7
+76 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMGRP))+1
+77 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
+78 SET ^XTMP("ABM-PVP2",$JOB,"TEST","PD",ABMP("BDT"),ABMVDFN)=""
+79 ;I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="PD" ;abm*2.6*15 HEAT161159 record indicator
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+80 KILL ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS")
+81 SET ABMP("BDT")=0
+82 FOR
SET ABMP("BDT")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT")))
IF 'ABMP("BDT")
QUIT
Begin DoDot:3
+83 SET ABMPRV=0
+84 FOR
SET ABMPRV=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV))
IF 'ABMPRV
QUIT
Begin DoDot:4
+85 SET ABMGRP=""
+86 FOR
SET ABMGRP=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP))
IF ABMGRP=""
QUIT
Begin DoDot:5
+87 SET ABMP("VDFN")=0
+88 FOR
SET ABMP("VDFN")=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMP("VDFN")))
IF 'ABMP("VDFN")
QUIT
Begin DoDot:6
End DoDot:6
+89 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
+90 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMGRP))+1
+91 SET ^XTMP("ABM-PVP2",$JOB,"TEST","ZEROPD",ABMP("BDT"),ABMVDFN)=""
End DoDot:5
+92 ;.I ABMGRP="MCD"!($D(ABMI("INS",ABMINS))) S ABMRIND="ZPD" ;abm*2.6*15 HEAT161159 record indicator
End DoDot:4
End DoDot:3
+93 KILL ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS")
End DoDot:2
End DoDot:1
+94 QUIT
ARBILLS ;
+1 ;abm*2.6*15 split routine due to size
DO ARBILLS^ABMM2P12
+2 QUIT
TRANS ;
+1 ;abm*2.6*15 split routine due to size
DO TRANS^ABMM2P12
+2 QUIT
ZEROPD ;EP
+1 DO ZEROPD^ABMM2PV7
+2 QUIT
GRPBILL ;
+1 DO GRPBILL^ABMM2PV7
+2 QUIT
GRPOTHVS ;
+1 DO GRPOTHVS^ABMM2PV7
+2 QUIT
OTHERVST ;EP
+1 DO OTHERVST^ABMM2PV7
+2 QUIT
GPTDATA ;EP
+1 DO GPTDATA^ABMM2PV7
+2 QUIT
PTDATA ;EP
+1 DO PTDATA^ABMM2PV7
+2 QUIT
ENROLL ;EP
+1 DO ENROLL^ABMM2PV7
+2 QUIT
