ABMMUPV1 ;IHS/SD/SDR - MU Patient Volume EP Report ;
;;2.6;IHS 3P BILLING SYSTEM;**7,8,10,11,12**;NOV 12, 2009;Build 187
;
COMPUTE ;EP - gather data report
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 CALC^ABMMUPV2
.D PRINT^ABMMUPV3
;
I ABMY("90")="C" D VISITS,BILLS,CALC^ABMMUPV2,PRINT^ABMMUPV3 Q
;
S (ABMY("SDT"),ABMP("SDT"))=(ABMY("QYR")-1700)_"0101"
S X1=ABMP("SDT")
S X2=89
D C^%DTC
S ABMP("EDT")=X
D VISITS
D BILLS
D CALC^ABMMUPV2
;start new abm*2.6*8
I ABMY("RTYP")="SEL" D
.S ABMPRV=0
.F S ABMPRV=$O(ABMPRVDR(ABMPRV)) Q:'ABMPRV D
..I +$G(^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV))>29.99 K ABMPRVDR(ABMPRV)
I ABMY("RTYP")="GRP",(+$G(^XTMP("ABM-PVP",$J,"PRV TOP"))>29.99) D PRINT^ABMMUPV3 Q
I ABMY("RTYP")="SEL",'$D(ABMPRVDR) D PRINT^ABMMUPV3 Q
;end new abm*2.6*8
S ABMQFLG=0
F D Q:ABMQFLG=1
.S X1=ABMP("SDT")
.S X2=1
.D C^%DTC
.S ABMP("SDT")=X
.S ABMDFLG=1
.S X1=ABMP("SDT")
.S X2=89
.D C^%DTC
.S ABMP("EDT")=X
.I ABMP("EDT")>((ABMY("QYR")-1700)_"1231")!(ABMP("EDT")>DT) S ABMQFLG=1 Q
.K ^XTMP("ABM-PVP",$J,"VISITS")
.D VISITS
.D BILLS
.D CALC^ABMMUPV2
.;start new abm*2.6*8
.I ABMY("RTYP")="SEL" D
..S ABMPRV=0
..F S ABMPRV=$O(ABMPRVDR(ABMPRV)) Q:'ABMPRV D
...I +$G(^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV))>29.99 K ABMPRVDR(ABMPRV)
.I ABMY("RTYP")="SEL",'$D(ABMPRVDR) Q
.I ABMY("RTYP")="GRP",(+$G(^XTMP("ABM-PVP",$J,"PRV TOP"))>29.99)
.;end new abm*2.6*8
D PRINT^ABMMUPV3
K ABMY("EDT")
Q
VISITS ;
S ABMSDT=ABMP("SDT")
S ABMEDT=ABMP("EDT")+.999999
;start new abm*2.6*8
S ABMINS=0,ABMOINS="NO BILL"
S ABMITYP="X"
;end new abm*2.6*8
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
..S ABMSCAT=$$GET1^DIQ(9000010,ABMVDFN,.07,"I") ;service cat
..S ABMCLNC=$$GET1^DIQ(9000010,ABMVDFN,.08,"I") ;clinic
..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*8
..S ABMPT=$$GET1^DIQ(9000010,ABMVDFN,.05,"I") ;patient
..;if SEL report type, service cat MUST be S,O,R, or (A w/clinic'=30)
..I "^H^I^C^T^N^E^D^X^R^"[("^"_ABMSCAT_"^") Q ;abm*2.6*8
..I (ABMSCAT="A")&(ABMCLNC=30) Q ;abm*2.6*8
..S ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,.06,"I")
..Q:ABMVLOC="" ;abm*2.6*8
..I ($$GET1^DIQ(9000010,ABMVLOC,.12)'="")&(ABMSDT>$$GET1^DIQ(9000010,ABMVLOC,.12,"I")&($$GET1^DIQ(9000010,ABMVLOC,1111,"I")'="R")) Q
..Q:'$D(ABMF(ABMVLOC)) ;not a selected location
..I ABMY("RTYP")="GRP" D GRPVST Q ;abm*2.6*8
..S ABMPIEN=0
..K ABMPRVC ;abm*2.6*12 HEAT124020
..F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D
...S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
...Q:'$D(ABMPRVDR(ABMPRV))
...;start new abm*2.6*12 HEAT124020
...;skip provider if on visit more than once
...Q:$D(ABMPRVC(ABMPRV))
...S ABMPRVC(ABMPRV)=1
...;end new HEAT124020
...;I $D(^ABMMUPRM(1,1,"B",ABMVLOC)) S ABMFQ=$O(^ABMMUPRM(1,1,"B",ABMVLOC,0)) I $$GET1^DIQ(200,ABMPRV,53.5,"E")="PHYSICIAN ASSISTANT",$P($G(^ABMMUPRM(1,1,ABMFQ,0)),U,2)'=1 Q
...S ^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT"),ABMPRV)=+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT"),ABMPRV))+1
...S ^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT"),ABMPRV,ABMVLOC)=+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT"),ABMPRV,ABMVLOC))+1
...S ^XTMP("ABM-PVP",$J,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)="" ;list of visits by patient,DOS
...S ^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN)="" ;list of visits to check for pymt
...S ^XTMP("ABM-PVP",$J,"VISIT CNT")=+$G(^XTMP("ABM-PVP",$J,"VISIT CNT"))+1 ;count of visits
...S ^XTMP("ABM-PVP",$J,"ALL VISITS",ABMVDFN)="" ;list of all visits looked at
...S ^XTMP("ABM-PVP",$J,"ALL VISIT CNT")=+$G(^XTMP("ABM-PVP",$J,"ALL VISIT CNT"))+1 ;count of all visits
...I (^XTMP("ABM-PVP",$J,"ALL VISIT CNT")#1000&(IOST["C")) W "." U 0 W "."
...K ABMITYP
...D PTDATA
Q
;start new abm*2.6*8
GRPVST ;
S ABMPIEN=0
K ABMPRVC ;abm*2.6*12 HEAT124020
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*12 HEAT124020
.;skip provider if on visit more than once
.Q:$D(ABMPRVC(ABMPRV))
.S ABMPRVC(ABMPRV)=1
.;end new HEAT124020
.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)=""
;I $D(^ABMMUPRM(1,1,"B",ABMVLOC)) S ABMFQ=$O(^ABMMUPRM(1,1,"B",ABMVLOC,0)) I $$GET1^DIQ(200,ABMPRV,53.5,"E")="PHYSICIAN ASSISTANT",$P($G(^ABMMUPRM(1,1,ABMFQ,0)),U,2)'=1 Q
S ^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT"))=+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT")))+1
S ^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMP("SDT"),ABMVLOC))+1
S ^XTMP("ABM-PVP",$J,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)="" ;list of visits by patient,DOS
S ^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN)="" ;list of visits to check for pymt
S ^XTMP("ABM-PVP",$J,"VISIT CNT")=+$G(^XTMP("ABM-PVP",$J,"VISIT CNT"))+1 ;count of visits
S ^XTMP("ABM-PVP",$J,"ALL VISITS",ABMVDFN)="" ;list of all visits looked at
S ^XTMP("ABM-PVP",$J,"ALL VISIT CNT")=+$G(^XTMP("ABM-PVP",$J,"ALL VISIT CNT"))+1 ;count of all visits
I (^XTMP("ABM-PVP",$J,"ALL VISIT CNT")#1000&(IOST["C")) W "." U 0 W "."
K ABMITYP
D GPTDATA
Q
;end new abm*2.6*8
BILLS ;EP
S ABMCNT=0
S ABMDUZ2=0
S ABMFOUND=0
F S ABMDUZ2=$O(^ABMDBILL(ABMDUZ2)) Q:'ABMDUZ2 D
.Q:'$D(^ABMDBILL(ABMDUZ2,0)) ;abm*2.6*11 HEAT96914
.S ABMVDFN=0
.F S ABMVDFN=$O(^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN)) Q:'ABMVDFN D
..S ABMBILLF=0 ;abm*2.6*8 HEAT47191
..Q:($G(^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN))=1) ;already counted this vst on report
..Q:'$D(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN)) ;visit not under this DUZ(2)
..S ABMP("BDFN")=0
..;F S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN,ABMP("BDFN"))) Q:'ABMP("BDFN") ;abm*2.6*8 HEAT47191
..F S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN,ABMP("BDFN"))) Q:'ABMP("BDFN") D Q:ABMBILLF ;abm*2.6*8 HEAT47191
...S (ABMBILLN,ABMSAV)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
...I $P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,4)="X" Q
...S ABMVLOC=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
...S ABMINS=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8)
...S ABMPT=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
...S (ABMBILLN,ABMSAV)=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
...S ABMBILLN=+ABMBILLN_" " ;abm*2.6*10 HEAT86634
...S ABMSAV=+ABMSAV ;abm*2.6*11 HEAT89722
...;F S ABMBILLN=$O(^BARBL(ABMPAR,"B",ABMBILLN)) Q:$G(ABMBILLN)=""!(ABMBILLN'[ABMSAV) D ;abm*2.6*8 HEAT47191
...F S ABMBILLN=$O(^BARBL(ABMPAR,"B",ABMBILLN)) Q:$G(ABMBILLN)=""!(ABMBILLN'[ABMSAV) D Q:ABMBILLF ;abm*2.6*8 HEAT47191
....S ABMARIEN=0
....S ABMHOLD=DUZ(2)
....S DUZ(2)=ABMPAR
....;F S ABMARIEN=$O(^BARBL(DUZ(2),"B",ABMBILLN,ABMARIEN)) Q:'ABMARIEN D ;abm*2.6*8 HEAT47191
....F S ABMARIEN=$O(^BARBL(DUZ(2),"B",ABMBILLN,ABMARIEN)) Q:'ABMARIEN D Q:ABMBILLF ;abm*2.6*8 HEAT47191
.....S ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"I") ;A/R BILL, A/R ACCOUNT
.....S D0=ABMARACT
.....S ABMITYP=$$VALI^BARVPM(8) ;GET 'VIP INSURER TYPE' CODE
.....S ABMGRP=$S(ABMITYP="D":"MCD",ABMITYP="K":"CHIP",1:"OTHR")
.....S ABMABILN=$P($G(^BARBL(DUZ(2),ABMARIEN,0)),U)
.....S ABMTRIEN=0
.....;F S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN)) Q:'ABMTRIEN D ;abm*2.6*8 HEAT47191
.....F S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN)) Q:'ABMTRIEN D Q:ABMBILLF ;abm*2.6*8 HEAT47191
......S ABMTRTYP=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U)
......S ABMADJT=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U,3) ;abm*2.6*8
......;I "^40^113^114^121^132^137^138^139^"'[("^"_ABMTRTYP_"^") Q ;payment or payment credit ;abm*2.6*8
......I (ABMTRTYP'=40)&("^113^114^121^132^137^138^139^"'[("^"_ABMADJT_"^")) Q ;payment or payment credit ;abm*2.6*8
......I ($$GET1^DIQ(90050.03,ABMTRIEN,3.5))<(.01) Q ;don't count 0 pymts or reversals
......I ABMY("RTYP")="GRP" D GRPBILL Q ;abm*2.6*8
......S ABMPIEN=0
......;F S ABMPIEN=$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),41,ABMPIEN)) Q:'ABMPIEN D
......;.S ABMPRV=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),41,ABMPIEN,0)),U)
......;F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D ;abm*2.6*8 HEAT47191
......F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D Q:ABMBILLF ;abm*2.6*8 HEAT47191
.......S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,".01","I")
.......Q:'$D(ABMPRVDR(ABMPRV))
.......;I $D(^ABMMUPRM(1,1,"B",ABMVLOC)) S ABMFQ=$O(^ABMMUPRM(1,1,"B",ABMVLOC,0)) I $$GET1^DIQ(200,ABMPRV,53.5,"E")="PHYSICIAN ASSISTANT",$P($G(^ABMMUPRM(1,1,ABMFQ,0)),U,2)'=1 Q
.......I ABMITYP="D"!((ABMITYP="K")&$D(^ABMMUPRM(1,1,"B",ABMVLOC))) D
........S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV)=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV))+1
........S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC)=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC))+1
........S ABMBILLF=1 ;abm*2.6*11 HEAT89722
.......S ^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMVLOC,ABMGRP))+1
.......S ^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMGRP)=+$G(^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMGRP))+1
.......S ^XTMP("ABM-PVP",$J,"PRV-VST",ABMVDFN,ABMPRV)="",^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN)=1
.......;S ABMBILLF=1 ;abm*2.6*8 HEAT47191 ;abm*2.6*11 HEAT89722
.......I (ABMCNT#1000&(IOST["C")) W "."
.......S ABMCNT=+$G(ABMCNT)+1
.......D PTDATA
.....S DUZ(2)=ABMHOLD
...I +$G(ABMFOUND)=1 D OTHERVST ;check for other visits on DOS to mark as paid
Q
;start new abm*2.6*8
GRPBILL ;
Q:($G(^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN))=1) ;abm*2.6*8
I ABMITYP="D"!((ABMITYP="K")&$D(^ABMMUPRM(1,1,"B",ABMVLOC))) D
.S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"))=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT")))+1
.S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMVLOC))+1
S ^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMVLOC,ABMGRP))+1
S ^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMGRP)=+$G(^XTMP("ABM-PVP",$J,"PRV ENC CNT",ABMP("SDT"),ABMGRP))+1
S ^XTMP("ABM-PVP",$J,"PRV-VST",ABMVDFN)="",^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN)=1
S ^XTMP("ABM-PVP",$J,"PRV-VST",ABMVDFN)="",^XTMP("ABM-PVP",$J,"VISITS",ABMVDFN)=1
I (ABMCNT#1000&(IOST["C")) W "."
S ABMCNT=+$G(ABMCNT)+1
D GPTDATA
S DUZ(2)=ABMHOLD
I +$G(ABMFOUND)=1 D GRPOTHVS ;check for other visits on DOS to mark as paid
Q
GRPOTHVS ;
S ABMPT=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
S (ABMDOS,ABMDOSSV)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
F S ABMDOS=$O(^XTMP("ABM-PVP",$J,"PT VSTS",ABMPT,ABMDOS)) Q:'ABMDOS!($P(ABMDOS,".")>$P(ABMDOSSV,".")) D
.S ABMVCHK=0
.F S ABMVCHK=$O(^XTMP("ABM-PVP",$J,"PT VSTS",ABMPT,ABMDOS,ABMVCHK)) Q:'ABMVCHK D
..Q:^XTMP("ABM-PVP",$J,"VISITS",ABMVCHK)=1 ;already counted this visit
..S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"))=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT")))+1
..S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMVLOC))+1
..S ^XTMP("ABM-PVP",$J,"VISITS",ABMVCHK)=1
Q
;end new abm*2.6*8
OTHERVST ;EP
S ABMPT=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
S (ABMDOS,ABMDOSSV)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
F S ABMDOS=$O(^XTMP("ABM-PVP",$J,"PT VSTS",ABMPT,ABMDOS)) Q:'ABMDOS!($P(ABMDOS,".")>$P(ABMDOSSV,".")) D
.S ABMVCHK=0
.F S ABMVCHK=$O(^XTMP("ABM-PVP",$J,"PT VSTS",ABMPT,ABMDOS,ABMVCHK)) Q:'ABMVCHK D
..Q:^XTMP("ABM-PVP",$J,"VISITS",ABMVCHK)=1 ;already counted this visit
..S ABMPIEN=0
..F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVCHK,ABMPIEN)) Q:'ABMPIEN D
...S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
...Q:'$D(ABMPRVDR(ABMPRV))
...Q:$D(^XTMP("ABM-PVP",$J,"PRV-VST",ABMVCHK,ABMPRV))
...S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV)=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV))+1
...S ^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC)=+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC))+1
...S ^XTMP("ABM-PVP",$J,"VISITS",ABMVCHK)=1
Q
GPTDATA ;EP
S ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
I +$G(ABMINS) S ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
S:$G(ABMITYP)="" ABMITYP="X"
S:$G(ABMTRIEN)="" ABMTRIEN="NOT PAID"
S ABMREC=ABMVDFN_U_ABMPT_U_$P(ABMTRIEN,".")_U_$S(ABMITYP="D"!((ABMITYP="K")&$D(^ABMMUPRM(1,1,"B",ABMVLOC))):"*",1:"")
S ^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMVLOC,ABMITYP,ABMOINS,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC
I ($G(ABMTRIEN)'="NOT PAID"),$D(^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)) D
.K ^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
Q
PTDATA ;EP
S ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
I +$G(ABMINS) S ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
I +$G(ABMARACT) S ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"E") ;A/R BILL, A/R ACCOUNT ;abm*2.6*11 HEAT89722
S:$G(ABMITYP)="" ABMITYP="X"
S:$G(ABMTRIEN)="" ABMTRIEN="NOT PAID"
S ABMREC=ABMVDFN_U_ABMPT_U_$P(ABMTRIEN,".")_U_$S(ABMITYP="D"!((ABMITYP="K")&$D(^ABMMUPRM(1,1,"B",ABMVLOC))):"*",1:"")
;S ^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,ABMITYP,ABMOINS,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*11 HEAT89722
S ^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,ABMITYP,$S($G(ABMARACT)'="":ABMARACT,1:ABMOINS),$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*11 HEAT89722
I ($G(ABMTRIEN)'="NOT PAID"),$D(^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)) D
.K ^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
Q
ABMMUPV1 ;IHS/SD/SDR - MU Patient Volume EP Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**7,8,10,11,12**;NOV 12, 2009;Build 187
+2 ;
COMPUTE ;EP - gather data report
+1 IF ABMY("90")="B"
Begin DoDot:1
+2 SET X1=ABMY("SDT")
+3 SET X2=89
+4 DO C^%DTC
+5 SET (ABMY("EDT"),ABMP("EDT"))=X
+6 DO VISITS
+7 DO BILLS
+8 DO CALC^ABMMUPV2
+9 DO PRINT^ABMMUPV3
End DoDot:1
QUIT
+10 ;
+11 IF ABMY("90")="C"
DO VISITS
DO BILLS
DO CALC^ABMMUPV2
DO PRINT^ABMMUPV3
QUIT
+12 ;
+13 SET (ABMY("SDT"),ABMP("SDT"))=(ABMY("QYR")-1700)_"0101"
+14 SET X1=ABMP("SDT")
+15 SET X2=89
+16 DO C^%DTC
+17 SET ABMP("EDT")=X
+18 DO VISITS
+19 DO BILLS
+20 DO CALC^ABMMUPV2
+21 ;start new abm*2.6*8
+22 IF ABMY("RTYP")="SEL"
Begin DoDot:1
+23 SET ABMPRV=0
+24 FOR
SET ABMPRV=$ORDER(ABMPRVDR(ABMPRV))
IF 'ABMPRV
QUIT
Begin DoDot:2
+25 IF +$GET(^XTMP("ABM-PVP",$JOB,"PRV TOP",ABMPRV))>29.99
KILL ABMPRVDR(ABMPRV)
End DoDot:2
End DoDot:1
+26 IF ABMY("RTYP")="GRP"
IF (+$GET(^XTMP("ABM-PVP",$JOB,"PRV TOP"))>29.99)
DO PRINT^ABMMUPV3
QUIT
+27 IF ABMY("RTYP")="SEL"
IF '$DATA(ABMPRVDR)
DO PRINT^ABMMUPV3
QUIT
+28 ;end new abm*2.6*8
+29 SET ABMQFLG=0
+30 FOR
Begin DoDot:1
+31 SET X1=ABMP("SDT")
+32 SET X2=1
+33 DO C^%DTC
+34 SET ABMP("SDT")=X
+35 SET ABMDFLG=1
+36 SET X1=ABMP("SDT")
+37 SET X2=89
+38 DO C^%DTC
+39 SET ABMP("EDT")=X
+40 IF ABMP("EDT")>((ABMY("QYR")-1700)_"1231")!(ABMP("EDT")>DT)
SET ABMQFLG=1
QUIT
+41 KILL ^XTMP("ABM-PVP",$JOB,"VISITS")
+42 DO VISITS
+43 DO BILLS
+44 DO CALC^ABMMUPV2
+45 ;start new abm*2.6*8
+46 IF ABMY("RTYP")="SEL"
Begin DoDot:2
+47 SET ABMPRV=0
+48 FOR
SET ABMPRV=$ORDER(ABMPRVDR(ABMPRV))
IF 'ABMPRV
QUIT
Begin DoDot:3
+49 IF +$GET(^XTMP("ABM-PVP",$JOB,"PRV TOP",ABMPRV))>29.99
KILL ABMPRVDR(ABMPRV)
End DoDot:3
End DoDot:2
+50 IF ABMY("RTYP")="SEL"
IF '$DATA(ABMPRVDR)
QUIT
+51 IF ABMY("RTYP")="GRP"
IF (+$GET(^XTMP("ABM-PVP",$JOB,"PRV TOP"))>29.99)
+52 ;end new abm*2.6*8
End DoDot:1
IF ABMQFLG=1
QUIT
+53 DO PRINT^ABMMUPV3
+54 KILL ABMY("EDT")
+55 QUIT
VISITS ;
+1 SET ABMSDT=ABMP("SDT")
+2 SET ABMEDT=ABMP("EDT")+.999999
+3 ;start new abm*2.6*8
+4 SET ABMINS=0
SET ABMOINS="NO BILL"
+5 SET ABMITYP="X"
+6 ;end new abm*2.6*8
+7 FOR
SET ABMSDT=$ORDER(^AUPNVSIT("B",ABMSDT))
IF 'ABMSDT!(ABMSDT>ABMEDT)
QUIT
Begin DoDot:1
+8 SET ABMVDFN=0
+9 FOR
SET ABMVDFN=$ORDER(^AUPNVSIT("B",ABMSDT,ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:2
+10 ;service cat
SET ABMSCAT=$$GET1^DIQ(9000010,ABMVDFN,.07,"I")
+11 ;clinic
SET ABMCLNC=$$GET1^DIQ(9000010,ABMVDFN,.08,"I")
+12 ;exclude clinics ;abm*2.6*8
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,"E")_"^")&(ABMY("RTYP")="SEL")
QUIT
+13 ;patient
SET ABMPT=$$GET1^DIQ(9000010,ABMVDFN,.05,"I")
+14 ;if SEL report type, service cat MUST be S,O,R, or (A w/clinic'=30)
+15 ;abm*2.6*8
IF "^H^I^C^T^N^E^D^X^R^"[("^"_ABMSCAT_"^")
QUIT
+16 ;abm*2.6*8
IF (ABMSCAT="A")&(ABMCLNC=30)
QUIT
+17 SET ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,.06,"I")
+18 ;abm*2.6*8
IF ABMVLOC=""
QUIT
+19 IF ($$GET1^DIQ(9000010,ABMVLOC,.12)'="")&(ABMSDT>$$GET1^DIQ(9000010,ABMVLOC,.12,"I")&($$GET1^DIQ(9000010,ABMVLOC,1111,"I")'="R"))
QUIT
+20 ;not a selected location
IF '$DATA(ABMF(ABMVLOC))
QUIT
+21 ;abm*2.6*8
IF ABMY("RTYP")="GRP"
DO GRPVST
QUIT
+22 SET ABMPIEN=0
+23 ;abm*2.6*12 HEAT124020
KILL ABMPRVC
+24 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:3
+25 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+26 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+27 ;start new abm*2.6*12 HEAT124020
+28 ;skip provider if on visit more than once
+29 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+30 SET ABMPRVC(ABMPRV)=1
+31 ;end new HEAT124020
+32 ;I $D(^ABMMUPRM(1,1,"B",ABMVLOC)) S ABMFQ=$O(^ABMMUPRM(1,1,"B",ABMVLOC,0)) I $$GET1^DIQ(200,ABMPRV,53.5,"E")="PHYSICIAN ASSISTANT",$P($G(^ABMMUPRM(1,1,ABMFQ,0)),U,2)'=1 Q
+33 SET ^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT"),ABMPRV)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT"),ABMPRV))+1
+34 SET ^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT"),ABMPRV,ABMVLOC)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT"),ABMPRV,ABMVLOC))+1
+35 ;list of visits by patient,DOS
SET ^XTMP("ABM-PVP",$JOB,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)=""
+36 ;list of visits to check for pymt
SET ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN)=""
+37 ;count of visits
SET ^XTMP("ABM-PVP",$JOB,"VISIT CNT")=+$GET(^XTMP("ABM-PVP",$JOB,"VISIT CNT"))+1
+38 ;list of all visits looked at
SET ^XTMP("ABM-PVP",$JOB,"ALL VISITS",ABMVDFN)=""
+39 ;count of all visits
SET ^XTMP("ABM-PVP",$JOB,"ALL VISIT CNT")=+$GET(^XTMP("ABM-PVP",$JOB,"ALL VISIT CNT"))+1
+40 IF (^XTMP("ABM-PVP",$JOB,"ALL VISIT CNT")#1000&(IOST["C"))
WRITE "."
USE 0
WRITE "."
+41 KILL ABMITYP
+42 DO PTDATA
End DoDot:3
End DoDot:2
End DoDot:1
+43 QUIT
+44 ;start new abm*2.6*8
GRPVST ;
+1 SET ABMPIEN=0
+2 ;abm*2.6*12 HEAT124020
KILL ABMPRVC
+3 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:1
+4 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+5 ;start new abm*2.6*12 HEAT124020
+6 ;skip provider if on visit more than once
+7 IF $DATA(ABMPRVC(ABMPRV))
QUIT
+8 SET ABMPRVC(ABMPRV)=1
+9 ;end new HEAT124020
+10 SET ABMPRVCL=+$$GET1^DIQ(200,ABMPRV,53.5,"I")
+11 IF ABMPRVCL=0
SET ABMPRV("O",ABMPRV)=""
+12 IF ABMPRVCL'=0
Begin DoDot:2
+13 IF '$DATA(^ABMMUPRM(1,2,"B",ABMPRVCL))
SET ABMPRV("O",ABMPRV)=""
+14 IF $$GET1^DIQ(7,ABMPRVCL,9999999.01,"E")=11
Begin DoDot:3
+15 IF '$DATA(^ABMMUPRM(1,1,"B",ABMVLOC))
SET ABMPRV("O",ABMPRV)=""
+16 IF $DATA(^ABMMUPRM(1,1,"B",ABMVLOC))
Begin DoDot:4
+17 SET ABMVIEN=$ORDER(^ABMMUPRM(1,1,"B",ABMVLOC,0))
+18 IF $PIECE($GET(^ABMMUPRM(1,1,ABMVIEN,0)),U,2)=1
SET ABMPRV("E",ABMPRV)=""
+19 IF $PIECE($GET(^ABMMUPRM(1,1,ABMVIEN,0)),U,2)'=1
SET ABMPRV("O",ABMPRV)=""
End DoDot:4
End DoDot:3
+20 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
+21 ;I $D(^ABMMUPRM(1,1,"B",ABMVLOC)) S ABMFQ=$O(^ABMMUPRM(1,1,"B",ABMVLOC,0)) I $$GET1^DIQ(200,ABMPRV,53.5,"E")="PHYSICIAN ASSISTANT",$P($G(^ABMMUPRM(1,1,ABMFQ,0)),U,2)'=1 Q
+22 SET ^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT"))=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT")))+1
+23 SET ^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMP("SDT"),ABMVLOC))+1
+24 ;list of visits by patient,DOS
SET ^XTMP("ABM-PVP",$JOB,"PT VSTS",ABMPT,ABMSDT,ABMVDFN)=""
+25 ;list of visits to check for pymt
SET ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN)=""
+26 ;count of visits
SET ^XTMP("ABM-PVP",$JOB,"VISIT CNT")=+$GET(^XTMP("ABM-PVP",$JOB,"VISIT CNT"))+1
+27 ;list of all visits looked at
SET ^XTMP("ABM-PVP",$JOB,"ALL VISITS",ABMVDFN)=""
+28 ;count of all visits
SET ^XTMP("ABM-PVP",$JOB,"ALL VISIT CNT")=+$GET(^XTMP("ABM-PVP",$JOB,"ALL VISIT CNT"))+1
+29 IF (^XTMP("ABM-PVP",$JOB,"ALL VISIT CNT")#1000&(IOST["C"))
WRITE "."
USE 0
WRITE "."
+30 KILL ABMITYP
+31 DO GPTDATA
+32 QUIT
+33 ;end new abm*2.6*8
BILLS ;EP
+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 ;abm*2.6*11 HEAT96914
IF '$DATA(^ABMDBILL(ABMDUZ2,0))
QUIT
+6 SET ABMVDFN=0
+7 FOR
SET ABMVDFN=$ORDER(^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:2
+8 ;abm*2.6*8 HEAT47191
SET ABMBILLF=0
+9 ;already counted this vst on report
IF ($GET(^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN))=1)
QUIT
+10 ;visit not under this DUZ(2)
IF '$DATA(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN))
QUIT
+11 SET ABMP("BDFN")=0
+12 ;F S ABMP("BDFN")=$O(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN,ABMP("BDFN"))) Q:'ABMP("BDFN") ;abm*2.6*8 HEAT47191
+13 ;abm*2.6*8 HEAT47191
FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(ABMDUZ2,"AV",ABMVDFN,ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:3
+14 SET (ABMBILLN,ABMSAV)=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
+15 IF $PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,4)="X"
QUIT
+16 SET ABMVLOC=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,3)
+17 SET ABMINS=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,8)
+18 SET ABMPT=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U,5)
+19 SET (ABMBILLN,ABMSAV)=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
+20 ;abm*2.6*10 HEAT86634
SET ABMBILLN=+ABMBILLN_" "
+21 ;abm*2.6*11 HEAT89722
SET ABMSAV=+ABMSAV
+22 ;F S ABMBILLN=$O(^BARBL(ABMPAR,"B",ABMBILLN)) Q:$G(ABMBILLN)=""!(ABMBILLN'[ABMSAV) D ;abm*2.6*8 HEAT47191
+23 ;abm*2.6*8 HEAT47191
FOR
SET ABMBILLN=$ORDER(^BARBL(ABMPAR,"B",ABMBILLN))
IF $GET(ABMBILLN)=""!(ABMBILLN'[ABMSAV)
QUIT
Begin DoDot:4
+24 SET ABMARIEN=0
+25 SET ABMHOLD=DUZ(2)
+26 SET DUZ(2)=ABMPAR
+27 ;F S ABMARIEN=$O(^BARBL(DUZ(2),"B",ABMBILLN,ABMARIEN)) Q:'ABMARIEN D ;abm*2.6*8 HEAT47191
+28 ;abm*2.6*8 HEAT47191
FOR
SET ABMARIEN=$ORDER(^BARBL(DUZ(2),"B",ABMBILLN,ABMARIEN))
IF 'ABMARIEN
QUIT
Begin DoDot:5
+29 ;A/R BILL, A/R ACCOUNT
SET ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"I")
+30 SET D0=ABMARACT
+31 ;GET 'VIP INSURER TYPE' CODE
SET ABMITYP=$$VALI^BARVPM(8)
+32 SET ABMGRP=$SELECT(ABMITYP="D":"MCD",ABMITYP="K":"CHIP",1:"OTHR")
+33 SET ABMABILN=$PIECE($GET(^BARBL(DUZ(2),ABMARIEN,0)),U)
+34 SET ABMTRIEN=0
+35 ;F S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN)) Q:'ABMTRIEN D ;abm*2.6*8 HEAT47191
+36 ;abm*2.6*8 HEAT47191
FOR
SET ABMTRIEN=$ORDER(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN))
IF 'ABMTRIEN
QUIT
Begin DoDot:6
+37 SET ABMTRTYP=$PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,1)),U)
+38 ;abm*2.6*8
SET ABMADJT=$PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,1)),U,3)
+39 ;I "^40^113^114^121^132^137^138^139^"'[("^"_ABMTRTYP_"^") Q ;payment or payment credit ;abm*2.6*8
+40 ;payment or payment credit ;abm*2.6*8
IF (ABMTRTYP'=40)&("^113^114^121^132^137^138^139^"'[("^"_ABMADJT_"^"))
QUIT
+41 ;don't count 0 pymts or reversals
IF ($$GET1^DIQ(90050.03,ABMTRIEN,3.5))<(.01)
QUIT
+42 ;abm*2.6*8
IF ABMY("RTYP")="GRP"
DO GRPBILL
QUIT
+43 SET ABMPIEN=0
+44 ;F S ABMPIEN=$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),41,ABMPIEN)) Q:'ABMPIEN D
+45 ;.S ABMPRV=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),41,ABMPIEN,0)),U)
+46 ;F S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN D ;abm*2.6*8 HEAT47191
+47 ;abm*2.6*8 HEAT47191
FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:7
+48 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,".01","I")
+49 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+50 ;I $D(^ABMMUPRM(1,1,"B",ABMVLOC)) S ABMFQ=$O(^ABMMUPRM(1,1,"B",ABMVLOC,0)) I $$GET1^DIQ(200,ABMPRV,53.5,"E")="PHYSICIAN ASSISTANT",$P($G(^ABMMUPRM(1,1,ABMFQ,0)),U,2)'=1 Q
+51 IF ABMITYP="D"!((ABMITYP="K")&$DATA(^ABMMUPRM(1,1,"B",ABMVLOC)))
Begin DoDot:8
+52 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV))+1
+53 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC))+1
+54 ;abm*2.6*11 HEAT89722
SET ABMBILLF=1
End DoDot:8
+55 SET ^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMVLOC,ABMGRP))+1
+56 SET ^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMGRP)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMPRV,ABMGRP))+1
+57 SET ^XTMP("ABM-PVP",$JOB,"PRV-VST",ABMVDFN,ABMPRV)=""
SET ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN)=1
+58 ;S ABMBILLF=1 ;abm*2.6*8 HEAT47191 ;abm*2.6*11 HEAT89722
+59 IF (ABMCNT#1000&(IOST["C"))
WRITE "."
+60 SET ABMCNT=+$GET(ABMCNT)+1
+61 DO PTDATA
End DoDot:7
IF ABMBILLF
QUIT
End DoDot:6
IF ABMBILLF
QUIT
+62 SET DUZ(2)=ABMHOLD
End DoDot:5
IF ABMBILLF
QUIT
End DoDot:4
IF ABMBILLF
QUIT
+63 ;check for other visits on DOS to mark as paid
IF +$GET(ABMFOUND)=1
DO OTHERVST
End DoDot:3
IF ABMBILLF
QUIT
End DoDot:2
End DoDot:1
+64 QUIT
+65 ;start new abm*2.6*8
GRPBILL ;
+1 ;abm*2.6*8
IF ($GET(^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN))=1)
QUIT
+2 IF ABMITYP="D"!((ABMITYP="K")&$DATA(^ABMMUPRM(1,1,"B",ABMVLOC)))
Begin DoDot:1
+3 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"))=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT")))+1
+4 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMVLOC))+1
End DoDot:1
+5 SET ^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMVLOC,ABMGRP))+1
+6 SET ^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV ENC CNT",ABMP("SDT"),ABMGRP))+1
+7 SET ^XTMP("ABM-PVP",$JOB,"PRV-VST",ABMVDFN)=""
SET ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN)=1
+8 SET ^XTMP("ABM-PVP",$JOB,"PRV-VST",ABMVDFN)=""
SET ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVDFN)=1
+9 IF (ABMCNT#1000&(IOST["C"))
WRITE "."
+10 SET ABMCNT=+$GET(ABMCNT)+1
+11 DO GPTDATA
+12 SET DUZ(2)=ABMHOLD
+13 ;check for other visits on DOS to mark as paid
IF +$GET(ABMFOUND)=1
DO GRPOTHVS
+14 QUIT
GRPOTHVS ;
+1 SET ABMPT=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
+2 SET (ABMDOS,ABMDOSSV)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+3 FOR
SET ABMDOS=$ORDER(^XTMP("ABM-PVP",$JOB,"PT VSTS",ABMPT,ABMDOS))
IF 'ABMDOS!($PIECE(ABMDOS,".")>$PIECE(ABMDOSSV,"."))
QUIT
Begin DoDot:1
+4 SET ABMVCHK=0
+5 FOR
SET ABMVCHK=$ORDER(^XTMP("ABM-PVP",$JOB,"PT VSTS",ABMPT,ABMDOS,ABMVCHK))
IF 'ABMVCHK
QUIT
Begin DoDot:2
+6 ;already counted this visit
IF ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVCHK)=1
QUIT
+7 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"))=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT")))+1
+8 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMVLOC))+1
+9 SET ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVCHK)=1
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;end new abm*2.6*8
OTHERVST ;EP
+1 SET ABMPT=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
+2 SET (ABMDOS,ABMDOSSV)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
+3 FOR
SET ABMDOS=$ORDER(^XTMP("ABM-PVP",$JOB,"PT VSTS",ABMPT,ABMDOS))
IF 'ABMDOS!($PIECE(ABMDOS,".")>$PIECE(ABMDOSSV,"."))
QUIT
Begin DoDot:1
+4 SET ABMVCHK=0
+5 FOR
SET ABMVCHK=$ORDER(^XTMP("ABM-PVP",$JOB,"PT VSTS",ABMPT,ABMDOS,ABMVCHK))
IF 'ABMVCHK
QUIT
Begin DoDot:2
+6 ;already counted this visit
IF ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVCHK)=1
QUIT
+7 SET ABMPIEN=0
+8 FOR
SET ABMPIEN=$ORDER(^AUPNVPRV("AD",ABMVCHK,ABMPIEN))
IF 'ABMPIEN
QUIT
Begin DoDot:3
+9 SET ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
+10 IF '$DATA(ABMPRVDR(ABMPRV))
QUIT
+11 IF $DATA(^XTMP("ABM-PVP",$JOB,"PRV-VST",ABMVCHK,ABMPRV))
QUIT
+12 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV))+1
+13 SET ^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC)=+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMP("SDT"),ABMPRV,ABMVLOC))+1
+14 SET ^XTMP("ABM-PVP",$JOB,"VISITS",ABMVCHK)=1
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
GPTDATA ;EP
+1 SET ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
+2 IF +$GET(ABMINS)
SET ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
+3 IF $GET(ABMITYP)=""
SET ABMITYP="X"
+4 IF $GET(ABMTRIEN)=""
SET ABMTRIEN="NOT PAID"
+5 SET ABMREC=ABMVDFN_U_ABMPT_U_$PIECE(ABMTRIEN,".")_U_$SELECT(ABMITYP="D"!((ABMITYP="K")&$DATA(^ABMMUPRM(1,1,"B",ABMVLOC))):"*",1:"")
+6 SET ^XTMP("ABM-PVP",$JOB,"PT LST",ABMP("SDT"),ABMVLOC,ABMITYP,ABMOINS,$PIECE(ABMPNM,","),$PIECE(ABMPNM,",",2),$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC
+7 IF ($GET(ABMTRIEN)'="NOT PAID")
IF $DATA(^XTMP("ABM-PVP",$JOB,"PT LST",ABMP("SDT"),ABMVLOC,"X","NO BILL",$PIECE(ABMPNM,","),$PIECE(ABMPNM,",",2),$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN))
Begin DoDot:1
+8 KILL ^XTMP("ABM-PVP",$JOB,"PT LST",ABMP("SDT"),ABMVLOC,"X","NO BILL",$PIECE(ABMPNM,","),$PIECE(ABMPNM,",",2),$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
End DoDot:1
+9 QUIT
PTDATA ;EP
+1 SET ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
+2 IF +$GET(ABMINS)
SET ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
+3 ;A/R BILL, A/R ACCOUNT ;abm*2.6*11 HEAT89722
IF +$GET(ABMARACT)
SET ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"E")
+4 IF $GET(ABMITYP)=""
SET ABMITYP="X"
+5 IF $GET(ABMTRIEN)=""
SET ABMTRIEN="NOT PAID"
+6 SET ABMREC=ABMVDFN_U_ABMPT_U_$PIECE(ABMTRIEN,".")_U_$SELECT(ABMITYP="D"!((ABMITYP="K")&$DATA(^ABMMUPRM(1,1,"B",ABMVLOC))):"*",1:"")
+7 ;S ^XTMP("ABM-PVP",$J,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,ABMITYP,ABMOINS,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*11 HEAT89722
+8 ;abm*2.6*11 HEAT89722
SET ^XTMP("ABM-PVP",$JOB,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,ABMITYP,$SELECT($GET(ABMARACT)'="":ABMARACT,1:ABMOINS),$PIECE(ABMPNM,","),$PIECE(ABMPNM,",",2),$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC
+9 IF ($GET(ABMTRIEN)'="NOT PAID")
IF $DATA(^XTMP("ABM-PVP",$JOB,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,"X","NO BILL",$PIECE(ABMPNM,","),$PIECE(ABMPNM,",",2),$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN))
Begin DoDot:1
+10 KILL ^XTMP("ABM-PVP",$JOB,"PT LST",ABMP("SDT"),ABMPRV,ABMVLOC,"X","NO BILL",$PIECE(ABMPNM,","),$PIECE(ABMPNM,",",2),$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
End DoDot:1
+11 QUIT
