ABMM2PV7 ;IHS/SD/SDR - MU Patient Volume EP Report ; 12 Feb 2014 3:32 PM
;;2.6;IHS 3P BILLING SYSTEM;**11,12,15**;NOV 12, 2009;Build 251
;IHS/SD/SDR - 2.6*15 - HEAT161159 - Changed PT LST to sort differently so there won't be duplicate vsts on pt lst. Also added record indicator.
;IHS/SD/SDR - 2.6*15 - HEAT157235 - Code change to stop <UNDEF>ENROLL+39^ABMM2PV7
;IHS/SD/SDR - 2.6*15 - HEAT157688 - Code change to stop <UNDEF>OTHRVST+1^ABMM2PV7
;IHS/SD/SDR - 2.6*15 - HEAT156874 - Code for <SUBSCR>PTDATA+16^ABMM2PV7. Occurs when no patient on visit.
;IHS/SD/SDR - 2.6*15 - HEAT183289 - Added tribal self-insured counters.
;
ZEROPD ;EP
K ABMTRAMT
I ABMY("RTYP")="GRP" D Q
.D CALCDTS^ABMM2PV1
.S ABMDTFLG=0
.S ABMP("BDT")=ABMP("BSDT")
.F D Q:ABMDTFLG=1
..S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
..S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
..S ^XTMP("ABM-PVP2",$J,"PRV-VST",ABMP("BDT"),ABMVDFN)=""
..I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
..E S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=2
..I ABMY("RTYP")="GRP" D GPTDATA
..I ABMY("RTYP")="SEL" D PTDATA
..S X1=ABMP("BDT")
..S X2=1
..D C^%DTC
..I X>ABMP("BEDT") S ABMDTFLG=1 Q
..S ABMP("BDT")=X
;
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^ABMM2PV1
.S ABMDTFLG=0
.S ABMP("BDT")=ABMP("BSDT")
.F D Q:ABMDTFLG=1
..S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=""
..S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
..S ^XTMP("ABM-PVP2",$J,"PRV-VST",ABMP("BDT"),ABMVDFN,ABMPRV)=""
..I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
..E S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=2
..;I ABMY("RTYP")="GRP" D GPTDATA
..I ABMY("RTYP")="SEL" 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
GRPBILL ;EP
;S ABMBILLF=1 ;abm*2.6*15
D CALCDTS^ABMM2PV1
S ABMDTFLG=0
S ABMP("BDT")=ABMP("BSDT")
F D Q:ABMDTFLG=1
.S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
.S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=ABMTRAMT
.;S ABMBILLF=1 ;abm*2.6*15
.S ^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP))+1
.S ^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMGRP))+1
.S ^XTMP("ABM-PVP2",$J,"PRV-VST",ABMP("BDT"),ABMVDFN)=""
.I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ABMBILLF=1,^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
.I (ABMCNT#1000&(IOST["C")) W "."
.S ABMCNT=+$G(ABMCNT)+1
.D GPTDATA
.S X1=ABMP("BDT")
.S X2=1
.D C^%DTC
.I X>ABMP("BEDT") S ABMDTFLG=1 Q
.S ABMP("BDT")=X
S DUZ(2)=ABMHOLD
I +$G(ABMFOUND)=1 D GRPOTHVS ;chk for other vsts on DOS to mark as pd
Q
GRPOTHVS ;EP
S ABMDOS=ABMP("VDT")
F S ABMDOS=$O(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMDOS)) Q:'ABMDOS!($P(ABMDOS,".")>$P(ABMDOSSV,".")) D
.S ABMVCHK=0
.F S ABMVCHK=$O(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMDOS,ABMVCHK)) Q:'ABMVCHK D
..Q:^XTMP("ABM-PVP2",$J,"VISITS",ABMVCHK)=1 ;already cnted this vst
..D CALCDTS^ABMM2PV1
..S ABMDTFLG=0
..S ABMP("BDT")=ABMP("BSDT")
..F D Q:ABMDTFLG=1
...S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"))=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT")))+1
...S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMVLOC))+1
...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 (ABMCNT#1000&(IOST["C")) W "."
...S ABMCNT=+$G(ABMCNT)+1
...S ABMVSAVE=ABMVDFN
...S ABMVDFN=ABMVCHK
...D GPTDATA
...S ABMVDFN=ABMVSAVE
...S X1=ABMP("BDT")
...S X2=1
...D C^%DTC
...I X>ABMP("BEDT") S ABMDTFLG=1 Q
...S ABMP("BDT")=X
..S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVCHK)=1
Q
OTHERVST ;EP
S (ABMDOS,ABMDOSSV)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U) ;abm*2.6*15 HEAT157688
F S ABMDOS=$O(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMDOS)) Q:'ABMDOS!($P(ABMDOS,".")>$P(ABMDOSSV,".")) D
.S ABMVCHK=0
.F S ABMVCHK=$O(^XTMP("ABM-PVP2",$J,"PT VSTS",ABMPT,ABMDOS,ABMVCHK)) Q:'ABMVCHK D
..Q:(ABMVDFN=ABMVCHK)
..Q:^XTMP("ABM-PVP2",$J,"VISITS",ABMVCHK)=1 ;already cnted this vst
..;Q:^XTMP("ABM-PVP2",$J,"VISITS",ABMVCHK)=2 ;already cnted this vst
..S ABMPIEN=0
..K ABMPRVC
..F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVCHK,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^ABMM2PV1
...S ABMDTFLG=0
...S ABMP("BDT")=ABMP("BSDT")
...F D Q:ABMDTFLG=1
....I $D(^XTMP("ABM-PVP2",$J,"PRV-VST",ABMP("BDT"),ABMVCHK,ABMPRV)) S ABMDTFLG=1 Q
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC))+1
....S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVCHK)=1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMGRP))+1
....I ABMY("RTYP")="GRP" D GPTDATA
....I ABMY("RTYP")="SEL" D PTDATA
....S X1=ABMP("BDT")
....S X2=1
....D C^%DTC
....I X>ABMDOS S ABMDTFLG=1 Q
....S ABMP("BDT")=X
Q
GPTDATA ;EP
D GPTDATA^ABMM2P11 ;abm*2.6*15 split routine due to size
Q
PTDATA ;EP
D PTDATA^ABMM2P11 ;abm*2.6*15 split routine due to size
Q
ENROLL ;EP
K ABMBILLN,ABMTRAMT,ABMTRIEN,ABMDX,ABMITYP,ABMP("VDFN"),ABMINS
K ABMABILN,ABMADJT,ABMARACT,ABMCBAMT,ABMTRIEN,ABMTRTYP,ABMOINS,ABMPNM,ABMSAV,ABMVLOC,ABMPT,ABMDX,ABMDXIEN,ABMDXPRI
S ABMVDFN=0
F S ABMVDFN=$O(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)) Q:'ABMVDFN D
.K ABMRIND ;abm*2.6*15 HEAT161159
.Q:(+$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=1) ;MCD/CHIP bill was found for vst
.K ABML
.S ABMPT=$$GET1^DIQ(9000010,ABMVDFN,".05","I")
.S (ABMP("VDT"),ABMVDT,ABMSDT)=$P($$GET1^DIQ(9000010,ABMVDFN,".01","I"),".")
.S ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,".06","I")
.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
.;
.D ELIG^ABMM2PV8
.;
.I ABMY("RTYP")="GRP" D GENROLL Q
.K ABMPRVC
.S ABMPIEN=0
.F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D
..S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
..Q:'$D(ABMPRVDR(ABMPRV))
..Q:$D(ABMPRVC(ABMPRV))
..S ABMPRVC(ABMPRV)=1
..D CALCDTS^ABMM2PV1
..S ABMDTFLG=0
..S ABMP("BDT")=ABMP("BSDT")
..F D Q:ABMDTFLG=1
...I ABMP("VDT")<ABMP("BSDT") S ABMDTFLG=1 Q ;vst is before 90-day window
...;start new abm*2.6*15 uncomp care
...I '$D(ABML) D
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,"UNCOMP")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,"UNCOMP"))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC,"UNCOMP")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC,"UNCOMP"))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC))+1
...;end new abm*2.6*15
...I (+$G(ABML("MCD"))=0&(+$G(ABML("CHIP"))=0))&(+$G(ABML("OTHR"))=1) D
....Q:+$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=2 ;counted as pd; cnting here would be duplicate
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMGRP))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP,ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP,ABMVLOC))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP))+1
....S ^XTMP("ABM-PVP2",$J,"TEST","ENR",ABMP("BDT"),ABMVDFN)=""
...I (+$G(ABML("MCD"))=1!(+$G(ABML("CHIP"))=1)) D
....F ABMGRP="MCD","CHIP" D
.....I +$G(ABML(ABMGRP))'=1 Q
.....I ABMGRP="MCD",((+$G(ABML("MCD"))=1)&(+$G(ABML("CHIP"))=1)) Q
.....I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=2 D
......;start old abm*2.6*15 HEAT157235
......;I $D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"))) D
......;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")-1
......;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR")-1
......;I '$D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"))) D
......;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")-1
......;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR")-1
......;end old start new HEAT157235
......I $D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"))) D
.......S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR"))-1
.......S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR"))-1
......I '$D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"))) D
.......S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR"))-1
.......S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR"))-1
......;end new HEAT157235
.....;start new abm*2.6*15 HEAT161159
.....S ABMINS=0
.....F S ABMINS=$O(ABMILST(ABMINS)) Q:'ABMINS D
......I ABMGRP="MCD"!(ABMGRP="CHIP")!($D(ABMI("INS",ABMINS))) S ABMRIND="ENR"
.....;end new HEAT161159
.....S ^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
.....S ^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP))+1
.....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMGRP))+1
.....S ^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP))+1
.....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
.....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC))+1
.....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMGRP))+1
.....;I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))'=2 D PTDATA ;abm*2.6*15
.....D PTDATA ;abm*2.6*15
.....S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
...;start new abm*2.6*15 HEAT183289
...;I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=0,($G(ABMTSI)="Y"),(+$G(ABMICNT)=1) D ;abm*2.6*15
...I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))'=1,($G(ABMTSI)="Y"),(+$G(ABMICNT)=1) D ;abm*2.6*15
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,ABMVLOC,"TRIBSI")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,ABMVLOC,"TRIBSI"))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,"TRIBSI")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,"TRIBSI"))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMGRP,ABMVLOC,"TRIBSI")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMGRP,ABMVLOC,"TRIBSI"))+1
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMVLOC,"TRIBSI")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),ABMVLOC,"TRIBSI"))+1
...;end new HEAT183289
...S X1=ABMP("BDT")
...S X2=1
...D C^%DTC
...I X>ABMP("BEDT") S ABMDTFLG=1 Q
...S ABMP("BDT")=X
Q
GENROLL ;EP
D GENROLL^ABMM2P11 ;abm*2.6*15 split routine due to size
Q
PRIMPOV ;
S ABMDXPRI=+$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),17,"C",0))
S:ABMDXPRI'=0 ABMDXIEN=+$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),17,"C",ABMDXPRI,0))
Q:ABMDXIEN=0
S ABMDX=$P($$DX^ABMCVAPI($P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),17,ABMDXIEN,0)),U),ABMSDT),U,2)
Q
ABMM2PV7 ;IHS/SD/SDR - MU Patient Volume EP Report ; 12 Feb 2014 3:32 PM
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,12,15**;NOV 12, 2009;Build 251
+2 ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Changed PT LST to sort differently so there won't be duplicate vsts on pt lst. Also added record indicator.
+3 ;IHS/SD/SDR - 2.6*15 - HEAT157235 - Code change to stop <UNDEF>ENROLL+39^ABMM2PV7
+4 ;IHS/SD/SDR - 2.6*15 - HEAT157688 - Code change to stop <UNDEF>OTHRVST+1^ABMM2PV7
+5 ;IHS/SD/SDR - 2.6*15 - HEAT156874 - Code for <SUBSCR>PTDATA+16^ABMM2PV7. Occurs when no patient on visit.
+6 ;IHS/SD/SDR - 2.6*15 - HEAT183289 - Added tribal self-insured counters.
+7 ;
ZEROPD ;EP
+1 KILL ABMTRAMT
+2 IF ABMY("RTYP")="GRP"
Begin DoDot:1
+3 DO CALCDTS^ABMM2PV1
+4 SET ABMDTFLG=0
+5 SET ABMP("BDT")=ABMP("BSDT")
+6 FOR
Begin DoDot:2
+7 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+8 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+9 SET ^XTMP("ABM-PVP2",$JOB,"PRV-VST",ABMP("BDT"),ABMVDFN)=""
+10 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=1
+11 IF '$TEST
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=2
+12 IF ABMY("RTYP")="GRP"
DO GPTDATA
+13 IF ABMY("RTYP")="SEL"
DO PTDATA
+14 SET X1=ABMP("BDT")
+15 SET X2=1
+16 DO C^%DTC
+17 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+18 SET ABMP("BDT")=X
End DoDot:2
IF ABMDTFLG=1
QUIT
End DoDot:1
QUIT
+19 ;
+20 SET ABMPIEN=0
+21 KILL ABMPRVC
+22 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:1
+23 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,".01","I")
+24 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+25 ;skip prv if on vst >1
+26 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+27 SET ABMPRVC(ABMPRV)=1
+28 DO CALCDTS^ABMM2PV1
+29 SET ABMDTFLG=0
+30 SET ABMP("BDT")=ABMP("BSDT")
+31 FOR
Begin DoDot:2
+32 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+33 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+34 SET ^XTMP("ABM-PVP2",$JOB,"PRV-VST",ABMP("BDT"),ABMVDFN,ABMPRV)=""
+35 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=1
+36 IF '$TEST
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=2
+37 ;I ABMY("RTYP")="GRP" D GPTDATA
+38 IF ABMY("RTYP")="SEL"
DO PTDATA
+39 SET X1=ABMP("BDT")
+40 SET X2=1
+41 DO C^%DTC
+42 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+43 SET ABMP("BDT")=X
End DoDot:2
IF ABMDTFLG=1
QUIT
End DoDot:1
+44 QUIT
GRPBILL ;EP
+1 ;S ABMBILLF=1 ;abm*2.6*15
+2 DO CALCDTS^ABMM2PV1
+3 SET ABMDTFLG=0
+4 SET ABMP("BDT")=ABMP("BSDT")
+5 FOR
Begin DoDot:1
+6 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
+7 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=ABMTRAMT
+8 ;S ABMBILLF=1 ;abm*2.6*15
+9 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP))+1
+10 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMGRP))+1
+11 SET ^XTMP("ABM-PVP2",$JOB,"PRV-VST",ABMP("BDT"),ABMVDFN)=""
+12 IF ABMITYP="D"!($DATA(ABMI("INS",ABMINS)))
SET ABMBILLF=1
SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=1
+13 IF (ABMCNT#1000&(IOST["C"))
WRITE "."
+14 SET ABMCNT=+$GET(ABMCNT)+1
+15 DO GPTDATA
+16 SET X1=ABMP("BDT")
+17 SET X2=1
+18 DO C^%DTC
+19 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+20 SET ABMP("BDT")=X
End DoDot:1
IF ABMDTFLG=1
QUIT
+21 SET DUZ(2)=ABMHOLD
+22 ;chk for other vsts on DOS to mark as pd
IF +$GET(ABMFOUND)=1
DO GRPOTHVS
+23 QUIT
GRPOTHVS ;EP
+1 SET ABMDOS=ABMP("VDT")
+2 FOR
SET ABMDOS=$ORDER(^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMDOS))
IF 'ABMDOS!($PIECE(ABMDOS,".")>$PIECE(ABMDOSSV,"."))
QUIT
Begin DoDot:1
+3 SET ABMVCHK=0
+4 FOR
SET ABMVCHK=$ORDER(^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMDOS,ABMVCHK))
IF 'ABMVCHK
QUIT
Begin DoDot:2
+5 ;already cnted this vst
IF ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVCHK)=1
QUIT
+6 DO CALCDTS^ABMM2PV1
+7 SET ABMDTFLG=0
+8 SET ABMP("BDT")=ABMP("BSDT")
+9 FOR
Begin DoDot:3
+10 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"))=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT")))+1
+11 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMVLOC))+1
+12 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMGRP))+1
+13 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
+14 IF (ABMCNT#1000&(IOST["C"))
WRITE "."
+15 SET ABMCNT=+$GET(ABMCNT)+1
+16 SET ABMVSAVE=ABMVDFN
+17 SET ABMVDFN=ABMVCHK
+18 DO GPTDATA
+19 SET ABMVDFN=ABMVSAVE
+20 SET X1=ABMP("BDT")
+21 SET X2=1
+22 DO C^%DTC
+23 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+24 SET ABMP("BDT")=X
End DoDot:3
IF ABMDTFLG=1
QUIT
+25 SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVCHK)=1
End DoDot:2
End DoDot:1
+26 QUIT
OTHERVST ;EP
+1 ;abm*2.6*15 HEAT157688
SET (ABMDOS,ABMDOSSV)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+2 FOR
SET ABMDOS=$ORDER(^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMDOS))
IF 'ABMDOS!($PIECE(ABMDOS,".")>$PIECE(ABMDOSSV,"."))
QUIT
Begin DoDot:1
+3 SET ABMVCHK=0
+4 FOR
SET ABMVCHK=$ORDER(^XTMP("ABM-PVP2",$JOB,"PT VSTS",ABMPT,ABMDOS,ABMVCHK))
IF 'ABMVCHK
QUIT
Begin DoDot:2
+5 IF (ABMVDFN=ABMVCHK)
QUIT
+6 ;already cnted this vst
IF ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVCHK)=1
QUIT
+7 ;Q:^XTMP("ABM-PVP2",$J,"VISITS",ABMVCHK)=2 ;already cnted this vst
+8 SET ABMPIEN=0
+9 KILL ABMPRVC
+10 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVCHK,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:3
+11 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+12 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+13 ;skip prv if on vst >1
+14 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+15 SET ABMPRVC(ABMPRV)=1
+16 DO CALCDTS^ABMM2PV1
+17 SET ABMDTFLG=0
+18 SET ABMP("BDT")=ABMP("BSDT")
+19 FOR
Begin DoDot:4
+20 IF $DATA(^XTMP("ABM-PVP2",$JOB,"PRV-VST",ABMP("BDT"),ABMVCHK,ABMPRV))
SET ABMDTFLG=1
QUIT
+21 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV))+1
+22 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC))+1
+23 SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVCHK)=1
+24 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMGRP))+1
+25 IF ABMY("RTYP")="GRP"
DO GPTDATA
+26 IF ABMY("RTYP")="SEL"
DO PTDATA
+27 SET X1=ABMP("BDT")
+28 SET X2=1
+29 DO C^%DTC
+30 IF X>ABMDOS
SET ABMDTFLG=1
QUIT
+31 SET ABMP("BDT")=X
End DoDot:4
IF ABMDTFLG=1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
GPTDATA ;EP
+1 ;abm*2.6*15 split routine due to size
DO GPTDATA^ABMM2P11
+2 QUIT
PTDATA ;EP
+1 ;abm*2.6*15 split routine due to size
DO PTDATA^ABMM2P11
+2 QUIT
ENROLL ;EP
+1 KILL ABMBILLN,ABMTRAMT,ABMTRIEN,ABMDX,ABMITYP,ABMP("VDFN"),ABMINS
+2 KILL ABMABILN,ABMADJT,ABMARACT,ABMCBAMT,ABMTRIEN,ABMTRTYP,ABMOINS,ABMPNM,ABMSAV,ABMVLOC,ABMPT,ABMDX,ABMDXIEN,ABMDXPRI
+3 SET ABMVDFN=0
+4 FOR
SET ABMVDFN=$ORDER(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:1
+5 ;abm*2.6*15 HEAT161159
KILL ABMRIND
+6 ;MCD/CHIP bill was found for vst
IF (+$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=1)
QUIT
+7 KILL ABML
+8 SET ABMPT=$$GET1^DIQ(9000010,ABMVDFN,".05","I")
+9 SET (ABMP("VDT"),ABMVDT,ABMSDT)=$PIECE($$GET1^DIQ(9000010,ABMVDFN,".01","I"),".")
+10 SET ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,".06","I")
+11 ;abm*2.6*15 added
SET ABMNPI=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMVLOC),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",ABMVLOC),U),1:"")
+12 ;abm*2.6*15 added
SET ABMTIN=$$GET1^DIQ(9999999.06,ABMVLOC,".21","E")
+13 ;
+14 DO ELIG^ABMM2PV8
+15 ;
+16 IF ABMY("RTYP")="GRP"
DO GENROLL
QUIT
+17 KILL ABMPRVC
+18 SET ABMPIEN=0
+19 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:2
+20 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+21 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+22 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+23 SET ABMPRVC(ABMPRV)=1
+24 DO CALCDTS^ABMM2PV1
+25 SET ABMDTFLG=0
+26 SET ABMP("BDT")=ABMP("BSDT")
+27 FOR
Begin DoDot:3
+28 ;vst is before 90-day window
IF ABMP("VDT")<ABMP("BSDT")
SET ABMDTFLG=1
QUIT
+29 ;start new abm*2.6*15 uncomp care
+30 IF '$DATA(ABML)
Begin DoDot:4
+31 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,"UNCOMP")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,"UNCOMP"))+1
+32 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC,"UNCOMP")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC,"UNCOMP"))+1
+33 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMPRV,ABMVLOC))+1
End DoDot:4
+34 ;end new abm*2.6*15
+35 IF (+$GET(ABML("MCD"))=0&(+$GET(ABML("CHIP"))=0))&(+$GET(ABML("OTHR"))=1)
Begin DoDot:4
+36 ;counted as pd; cnting here would be duplicate
IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=2
QUIT
+37 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMGRP))+1
+38 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
+39 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP,ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP,ABMVLOC))+1
+40 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP))+1
+41 SET ^XTMP("ABM-PVP2",$JOB,"TEST","ENR",ABMP("BDT"),ABMVDFN)=""
End DoDot:4
+42 IF (+$GET(ABML("MCD"))=1!(+$GET(ABML("CHIP"))=1))
Begin DoDot:4
+43 FOR ABMGRP="MCD","CHIP"
Begin DoDot:5
+44 IF +$GET(ABML(ABMGRP))'=1
QUIT
+45 IF ABMGRP="MCD"
IF ((+$GET(ABML("MCD"))=1)&(+$GET(ABML("CHIP"))=1))
QUIT
+46 IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=2
Begin DoDot:6
+47 ;start old abm*2.6*15 HEAT157235
+48 ;I $D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"))) D
+49 ;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")-1
+50 ;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR")-1
+51 ;I '$D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"))) D
+52 ;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")-1
+53 ;.S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR")-1
+54 ;end old start new HEAT157235
+55 IF $DATA(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT")))
Begin DoDot:7
+56 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR"))-1
+57 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMPRV,"OTHR"))-1
End DoDot:7
+58 IF '$DATA(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT")))
Begin DoDot:7
+59 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,ABMVLOC,"OTHR"))-1
+60 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMPRV,"OTHR"))-1
End DoDot:7
+61 ;end new HEAT157235
End DoDot:6
+62 ;start new abm*2.6*15 HEAT161159
+63 SET ABMINS=0
+64 FOR
SET ABMINS=$ORDER(ABMILST(ABMINS))
IF 'ABMINS
QUIT
Begin DoDot:6
+65 IF ABMGRP="MCD"!(ABMGRP="CHIP")!($DATA(ABMI("INS",ABMINS)))
SET ABMRIND="ENR"
End DoDot:6
+66 ;end new HEAT161159
+67 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
+68 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP))+1
+69 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMGRP))+1
+70 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMPRV,ABMGRP))+1
+71 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMPRV,ABMVLOC,ABMGRP))+1
+72 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC))+1
+73 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMGRP))+1
+74 ;I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))'=2 D PTDATA ;abm*2.6*15
+75 ;abm*2.6*15
DO PTDATA
+76 SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=1
End DoDot:5
End DoDot:4
+77 ;start new abm*2.6*15 HEAT183289
+78 ;I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=0,($G(ABMTSI)="Y"),(+$G(ABMICNT)=1) D ;abm*2.6*15
+79 ;abm*2.6*15
IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))'=1
IF ($GET(ABMTSI)="Y")
IF (+$GET(ABMICNT)=1)
Begin DoDot:4
+80 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,ABMVLOC,"TRIBSI")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,ABMVLOC,"TRIBSI"))+1
+81 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,"TRIBSI")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMPRV,"TRIBSI"))+1
+82 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMGRP,ABMVLOC,"TRIBSI")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMGRP,ABMVLOC,"TRIBSI"))+1
+83 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMVLOC,"TRIBSI")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),ABMVLOC,"TRIBSI"))+1
End DoDot:4
+84 ;end new HEAT183289
+85 SET X1=ABMP("BDT")
+86 SET X2=1
+87 DO C^%DTC
+88 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+89 SET ABMP("BDT")=X
End DoDot:3
IF ABMDTFLG=1
QUIT
End DoDot:2
End DoDot:1
+90 QUIT
GENROLL ;EP
+1 ;abm*2.6*15 split routine due to size
DO GENROLL^ABMM2P11
+2 QUIT
PRIMPOV ;
+1 SET ABMDXPRI=+$ORDER(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),17,"C",0))
+2 IF ABMDXPRI'=0
SET ABMDXIEN=+$ORDER(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),17,"C",ABMDXPRI,0))
+3 IF ABMDXIEN=0
QUIT
+4 SET ABMDX=$PIECE($$DX^ABMCVAPI($PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),17,ABMDXIEN,0)),U),ABMSDT),U,2)
+5 QUIT
