- ABMM2P11 ;IHS/SD/SDR - MU Patient Volume EP Report ; 12 Feb 2014 3:32 PM
- ;;2.6;IHS 3P BILLING SYSTEM;**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.
- ;
- GPTDATA ;EP
- I +$G(ABMP("VDFN"))'=0 D
- .S ABMVHLD=ABMVDFN
- .S ABMVDFN=ABMP("VDFN")
- S ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
- I '$D(^DPT(ABMPT))!(ABMPNM="") Q ;abm*2.6*15 HEAT156874
- I +$G(ABMINS)&(+$G(ABMEFLG)'=1) S ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
- E S ABMOINS="NO BILL"
- I +$G(ABMARACT) S ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"E")
- S:$G(ABMITYP)="" ABMITYP="X"
- I +$G(ABMTRIEN)'=0 D
- .S ABMRECPD=""
- .I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))),(+$G(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$G(ABMADJT)_"^")) S ABMRIND="ZPD" ;abm*2.6*15 HEAT161159
- .I (+$G(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$G(ABMADJT)_"^")) S ABMRECPD="" Q ;abm*2.6*14 HEAT161159
- .;I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))) S ABMRECPD="*",ABMFOUND=1 ;abm*2.6*15 HEAT161159
- .I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))) S ABMRECPD="*",ABMFOUND=1,ABMRIND="PD" ;abm*2.6*15 HEAT161159
- I +$G(ABMTRIEN)=0 S ABMTRIEN="NOT PAID",ABMRECPD=""
- S ABMREC=ABMVDFN_U_ABMPT_U_$S(+$G(ABMTRIEN)'=0:$P($G(ABMTRIEN),"."),1:"")_U_ABMRECPD
- S ABMREC=ABMREC_U_$G(ABMBILLN)_U_$S($G(ABMBILLN):+$G(ABMTRAMT),1:$G(ABMTRAMT))_U_$G(ABMDX)
- S ABMPNPI=$P($G(^XTMP("ABM-PVP2",$J,"PRVS",ABMVDFN)),U) ;abm*2.6*15 HEAT174501
- S ABMPRVN=$P($G(^XTMP("ABM-PVP2",$J,"PRVS",ABMVDFN)),U,2) ;abm*2.6*15 HEAT174501
- S ABMREC=ABMREC_U_ABMITYP_U_$S($G(ABMARACT)'="":ABMARACT,1:ABMOINS)_U_$P(ABMPNM,",")_U_$P(ABMPNM,",",2)_U_$G(ABMPNPI)_U_$G(ABMPRVN)_U_$P($G(^AUPNVSIT(ABMVDFN,0)),U) ;abm*2.6*15 HEAT161159 and HEAT174501
- S ABMREC=ABMREC_U_+$G(ABMNPI)_U_$G(ABMTIN)_U_$G(ABMRIND) ;abm*2.6*15 HEAT171490 AND HEAT161159
- ;S ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMVLOC,ABMITYP,$S($G(ABMARACT)'="":ABMARACT,1:ABMOINS),$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*15 HEAT161159
- S ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMVLOC,$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*15 HEAT161159
- ;start old abm*2.6*15 HEAT161159
- ;I (+$G(ABMBILLN)'=0)&$D(^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)) D ;abm*2.6*12
- ;.K ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
- ;end old abm*2.6*15 HEAT161159
- I +$G(ABMP("VDFN"))'=0 D
- .S ABMVDFN=ABMVHLD
- Q
- PTDATA ;EP
- I +$G(ABMP("VDFN"))'=0 D
- .S ABMVHLD=ABMVDFN
- .S ABMVDFN=ABMP("VDFN")
- S ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
- I '$D(^DPT(ABMPT))!(ABMPNM="") Q ;abm*2.6*15 HEAT156874
- I +$G(ABMINS)&(+$G(ABMEFLG)'=1) S ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
- E S ABMOINS="NO BILL"
- I +$G(ABMARACT) S ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"E")
- S:$G(ABMITYP)="" ABMITYP="X"
- I +$G(ABMTRIEN)'=0 D
- .S ABMRECPD=""
- .I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))),(+$G(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$G(ABMADJT)_"^")) S ABMRIND="ZPD" ;abm*2.6*15 HEAT161159
- .I (+$G(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$G(ABMADJT)_"^")) S ABMRECPD="" Q ;abm*2.6*14 HEAT161159
- .;I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))) S ABMRECPD="*",ABMFOUND=1 ;abm*2.6*15 HEAT161159
- .I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))) S ABMRECPD="*",ABMFOUND=1,ABMRIND="PD" ;abm*2.6*15 HEAT161159
- I +$G(ABMTRIEN)=0 S ABMTRIEN="NOT PAID",ABMRECPD=""
- S ABMREC=ABMVDFN_U_ABMPT_U_$S(+$G(ABMTRIEN)'=0:$P($G(ABMTRIEN),"."),1:"")_U_ABMRECPD
- S ABMREC=ABMREC_U_$G(ABMBILLN)_U_$S($G(ABMBILLN):+$G(ABMTRAMT),1:$G(ABMTRAMT))_U_$G(ABMDX)
- S ABMREC=ABMREC_U_ABMITYP_U_$S($G(ABMARACT)'="":ABMARACT,1:ABMOINS)_U_$P(ABMPNM,",")_U_$P(ABMPNM,",",2)_U_$P($G(^AUPNVSIT(ABMVDFN,0)),U) ;abm*2.6*15 HEAT161159
- S ABMREC=ABMREC_U_+$G(ABMNPI)_U_$G(ABMTIN)_U_$G(ABMRIND) ;abm*2.6*15 HEAT171490 AND HEAT161159
- ;S ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),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*15 HEAT161159
- S ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMPRV,ABMVLOC,$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*15 HEAT161159
- ;start old abm*2.6*15 HEAT161159
- ;I (+$G(ABMBILLN)'=0)&$D(^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMPRV,ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)) D
- ;.K ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMPRV,ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
- ;end old abm*2.6*15 HEAT161159
- I +$G(ABMP("VDFN"))'=0 D
- .S ABMVDFN=ABMVHLD
- Q
- GENROLL ;EP
- D CALCDTS^ABMM2PV1
- S ABMDTFLG=0
- S ABMP("BDT")=ABMP("BSDT")
- F D Q:ABMDTFLG=1
- .I ABMP("VDT")<ABMP("BSDT") Q ;vst is before 90-day window
- .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
- ..I ($G(ABMTSI)="Y") Q ;abm*2.6*15
- ..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,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC,ABMGRP))+1
- ..S ^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC))+1
- .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
- ....I $D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC)) D
- .....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,"OTHR")-1
- .....S ^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"),"OTHR")-1
- ....I '$D(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMP("BDT"))) D
- .....S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,"OTHR")-1
- .....S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),"OTHR")=^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMP("BDT"),"OTHR")-1
- ...;start new abm*2.6*15 HEAT161159
- ...S ABMINS=0
- ...S ABMRIND="" ;abm*2.6*15
- ...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"),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-NUM ENR",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMGRP))+1
- ...S ^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP))+1
- ...S ^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC))+1
- ...;I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))'=2 D GPTDATA ;abm*2.6*15
- ...I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))'=1 D GPTDATA ;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"),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
- ..S ^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),"TRIBSI")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMP("BDT"),"TRIBSI"))+1
- .;end new HEAT183289
- .;start new abm*2.6*15 uncomp care
- .I '$D(ABML) D
- ..Q:+$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=2
- ..S ^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),"UNCOMP")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),"UNCOMP"))+1
- ..S ^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC,"UNCOMP")=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC,"UNCOMP"))+1
- ..S ^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC))+1
- .;end new abm*2.6*15
- .S X1=ABMP("BDT")
- .S X2=1
- .D C^%DTC
- .I X>ABMP("BEDT") S ABMDTFLG=1 Q
- .S ABMP("BDT")=X
- Q
- ABMM2P11 ;IHS/SD/SDR - MU Patient Volume EP Report ; 12 Feb 2014 3:32 PM
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**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 ;
- GPTDATA ;EP
- +1 IF +$GET(ABMP("VDFN"))'=0
- Begin DoDot:1
- +2 SET ABMVHLD=ABMVDFN
- +3 SET ABMVDFN=ABMP("VDFN")
- End DoDot:1
- +4 SET ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
- +5 ;abm*2.6*15 HEAT156874
- IF '$DATA(^DPT(ABMPT))!(ABMPNM="")
- QUIT
- +6 IF +$GET(ABMINS)&(+$GET(ABMEFLG)'=1)
- SET ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
- +7 IF '$TEST
- SET ABMOINS="NO BILL"
- +8 IF +$GET(ABMARACT)
- SET ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"E")
- +9 IF $GET(ABMITYP)=""
- SET ABMITYP="X"
- +10 IF +$GET(ABMTRIEN)'=0
- Begin DoDot:1
- +11 SET ABMRECPD=""
- +12 ;abm*2.6*15 HEAT161159
- IF (ABMITYP="D")&(+$GET(ABMEFLG)=0)!($DATA(ABMI("INS",ABMINS)))
- IF (+$GET(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$GET(ABMADJT)_"^"))
- SET ABMRIND="ZPD"
- +13 ;abm*2.6*14 HEAT161159
- IF (+$GET(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$GET(ABMADJT)_"^"))
- SET ABMRECPD=""
- QUIT
- +14 ;I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))) S ABMRECPD="*",ABMFOUND=1 ;abm*2.6*15 HEAT161159
- +15 ;abm*2.6*15 HEAT161159
- IF (ABMITYP="D")&(+$GET(ABMEFLG)=0)!($DATA(ABMI("INS",ABMINS)))
- SET ABMRECPD="*"
- SET ABMFOUND=1
- SET ABMRIND="PD"
- End DoDot:1
- +16 IF +$GET(ABMTRIEN)=0
- SET ABMTRIEN="NOT PAID"
- SET ABMRECPD=""
- +17 SET ABMREC=ABMVDFN_U_ABMPT_U_$SELECT(+$GET(ABMTRIEN)'=0:$PIECE($GET(ABMTRIEN),"."),1:"")_U_ABMRECPD
- +18 SET ABMREC=ABMREC_U_$GET(ABMBILLN)_U_$SELECT($GET(ABMBILLN):+$GET(ABMTRAMT),1:$GET(ABMTRAMT))_U_$GET(ABMDX)
- +19 ;abm*2.6*15 HEAT174501
- SET ABMPNPI=$PIECE($GET(^XTMP("ABM-PVP2",$JOB,"PRVS",ABMVDFN)),U)
- +20 ;abm*2.6*15 HEAT174501
- SET ABMPRVN=$PIECE($GET(^XTMP("ABM-PVP2",$JOB,"PRVS",ABMVDFN)),U,2)
- +21 ;abm*2.6*15 HEAT161159 and HEAT174501
- SET ABMREC=ABMREC_U_ABMITYP_U_$SELECT($GET(ABMARACT)'="":ABMARACT,1:ABMOINS)_U_$PIECE(ABMPNM,",")_U_$PIECE(ABMPNM,",",2)_U_$GET(ABMPNPI)_U_$GET(ABMPRVN)_U_$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U)
- +22 ;abm*2.6*15 HEAT171490 AND HEAT161159
- SET ABMREC=ABMREC_U_+$GET(ABMNPI)_U_$GET(ABMTIN)_U_$GET(ABMRIND)
- +23 ;S ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMVLOC,ABMITYP,$S($G(ABMARACT)'="":ABMARACT,1:ABMOINS),$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC ;abm*2.6*15 HEAT161159
- +24 ;abm*2.6*15 HEAT161159
- SET ^XTMP("ABM-PVP2",$JOB,"PT LST",ABMP("BDT"),ABMVLOC,$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC
- +25 ;start old abm*2.6*15 HEAT161159
- +26 ;I (+$G(ABMBILLN)'=0)&$D(^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)) D ;abm*2.6*12
- +27 ;.K ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
- +28 ;end old abm*2.6*15 HEAT161159
- +29 IF +$GET(ABMP("VDFN"))'=0
- Begin DoDot:1
- +30 SET ABMVDFN=ABMVHLD
- End DoDot:1
- +31 QUIT
- PTDATA ;EP
- +1 IF +$GET(ABMP("VDFN"))'=0
- Begin DoDot:1
- +2 SET ABMVHLD=ABMVDFN
- +3 SET ABMVDFN=ABMP("VDFN")
- End DoDot:1
- +4 SET ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
- +5 ;abm*2.6*15 HEAT156874
- IF '$DATA(^DPT(ABMPT))!(ABMPNM="")
- QUIT
- +6 IF +$GET(ABMINS)&(+$GET(ABMEFLG)'=1)
- SET ABMOINS=$$GET1^DIQ(9999999.18,ABMINS,.01,"E")
- +7 IF '$TEST
- SET ABMOINS="NO BILL"
- +8 IF +$GET(ABMARACT)
- SET ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"E")
- +9 IF $GET(ABMITYP)=""
- SET ABMITYP="X"
- +10 IF +$GET(ABMTRIEN)'=0
- Begin DoDot:1
- +11 SET ABMRECPD=""
- +12 ;abm*2.6*15 HEAT161159
- IF (ABMITYP="D")&(+$GET(ABMEFLG)=0)!($DATA(ABMI("INS",ABMINS)))
- IF (+$GET(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$GET(ABMADJT)_"^"))
- SET ABMRIND="ZPD"
- +13 ;abm*2.6*14 HEAT161159
- IF (+$GET(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$GET(ABMADJT)_"^"))
- SET ABMRECPD=""
- QUIT
- +14 ;I (ABMITYP="D")&(+$G(ABMEFLG)=0)!($D(ABMI("INS",ABMINS))) S ABMRECPD="*",ABMFOUND=1 ;abm*2.6*15 HEAT161159
- +15 ;abm*2.6*15 HEAT161159
- IF (ABMITYP="D")&(+$GET(ABMEFLG)=0)!($DATA(ABMI("INS",ABMINS)))
- SET ABMRECPD="*"
- SET ABMFOUND=1
- SET ABMRIND="PD"
- End DoDot:1
- +16 IF +$GET(ABMTRIEN)=0
- SET ABMTRIEN="NOT PAID"
- SET ABMRECPD=""
- +17 SET ABMREC=ABMVDFN_U_ABMPT_U_$SELECT(+$GET(ABMTRIEN)'=0:$PIECE($GET(ABMTRIEN),"."),1:"")_U_ABMRECPD
- +18 SET ABMREC=ABMREC_U_$GET(ABMBILLN)_U_$SELECT($GET(ABMBILLN):+$GET(ABMTRAMT),1:$GET(ABMTRAMT))_U_$GET(ABMDX)
- +19 ;abm*2.6*15 HEAT161159
- SET ABMREC=ABMREC_U_ABMITYP_U_$SELECT($GET(ABMARACT)'="":ABMARACT,1:ABMOINS)_U_$PIECE(ABMPNM,",")_U_$PIECE(ABMPNM,",",2)_U_$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U)
- +20 ;abm*2.6*15 HEAT171490 AND HEAT161159
- SET ABMREC=ABMREC_U_+$GET(ABMNPI)_U_$GET(ABMTIN)_U_$GET(ABMRIND)
- +21 ;S ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),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*15 HEAT161159
- +22 ;abm*2.6*15 HEAT161159
- SET ^XTMP("ABM-PVP2",$JOB,"PT LST",ABMP("BDT"),ABMPRV,ABMVLOC,$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC
- +23 ;start old abm*2.6*15 HEAT161159
- +24 ;I (+$G(ABMBILLN)'=0)&$D(^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMPRV,ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)) D
- +25 ;.K ^XTMP("ABM-PVP2",$J,"PT LST",ABMP("BDT"),ABMPRV,ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
- +26 ;end old abm*2.6*15 HEAT161159
- +27 IF +$GET(ABMP("VDFN"))'=0
- Begin DoDot:1
- +28 SET ABMVDFN=ABMVHLD
- End DoDot:1
- +29 QUIT
- GENROLL ;EP
- +1 DO CALCDTS^ABMM2PV1
- +2 SET ABMDTFLG=0
- +3 SET ABMP("BDT")=ABMP("BSDT")
- +4 FOR
- Begin DoDot:1
- +5 ;vst is before 90-day window
- IF ABMP("VDT")<ABMP("BSDT")
- QUIT
- +6 IF (+$GET(ABML("MCD"))=0&(+$GET(ABML("CHIP"))=0))&(+$GET(ABML("OTHR"))=1)
- Begin DoDot:2
- +7 ;counted as pd; cnting here would be duplicate
- IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=2
- QUIT
- +8 ;abm*2.6*15
- IF ($GET(ABMTSI)="Y")
- QUIT
- +9 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMGRP))+1
- +10 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC,ABMGRP))+1
- +11 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM OELIG",ABMP("BDT"),ABMVLOC))+1
- End DoDot:2
- +12 IF (+$GET(ABML("MCD"))=1!(+$GET(ABML("CHIP"))=1))
- Begin DoDot:2
- +13 FOR ABMGRP="MCD","CHIP"
- Begin DoDot:3
- +14 IF +$GET(ABML(ABMGRP))'=1
- QUIT
- +15 IF ABMGRP="MCD"
- IF ((+$GET(ABML("MCD"))=1)&(+$GET(ABML("CHIP"))=1))
- QUIT
- +16 IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=2
- Begin DoDot:4
- +17 IF $DATA(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC))
- Begin DoDot:5
- +18 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),ABMVLOC,"OTHR")-1
- +19 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),"OTHR")=^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT"),"OTHR")-1
- End DoDot:5
- +20 IF '$DATA(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMP("BDT")))
- Begin DoDot:5
- +21 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,"OTHR")=^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),ABMVLOC,"OTHR")-1
- +22 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),"OTHR")=^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMP("BDT"),"OTHR")-1
- End DoDot:5
- End DoDot:4
- +23 ;start new abm*2.6*15 HEAT161159
- +24 SET ABMINS=0
- +25 ;abm*2.6*15
- SET ABMRIND=""
- +26 FOR
- SET ABMINS=$ORDER(ABMILST(ABMINS))
- IF 'ABMINS
- QUIT
- Begin DoDot:4
- +27 IF ABMGRP="MCD"!(ABMGRP="CHIP")!($DATA(ABMI("INS",ABMINS)))
- SET ABMRIND="ENR"
- End DoDot:4
- +28 ;end new HEAT161159
- +29 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
- +30 SET ^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV ENC CNT",ABMP("BDT"),ABMGRP))+1
- +31 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMGRP))+1
- +32 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP))+1
- +33 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMP("BDT"),ABMVLOC))+1
- +34 ;I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))'=2 D GPTDATA ;abm*2.6*15
- +35 ;abm*2.6*15
- IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))'=1
- DO GPTDATA
- +36 SET ^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN)=1
- +37 ;start new abm*2.6*15 HEAT183289
- End DoDot:3
- End DoDot:2
- +38 ;I +$G(^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN))=0,($G(ABMTSI)="Y"),(+$G(ABMICNT)=1) D ;abm*2.6*15
- +39 ;abm*2.6*15
- IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))'=1
- IF ($GET(ABMTSI)="Y")
- IF (+$GET(ABMICNT)=1)
- Begin DoDot:2
- +40 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
- +41 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
- +42 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),"TRIBSI")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM TRIBSI",ABMP("BDT"),"TRIBSI"))+1
- End DoDot:2
- +43 ;end new HEAT183289
- +44 ;start new abm*2.6*15 uncomp care
- +45 IF '$DATA(ABML)
- Begin DoDot:2
- +46 IF +$GET(^XTMP("ABM-PVP2",$JOB,"VISITS",ABMVDFN))=2
- QUIT
- +47 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),"UNCOMP")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),"UNCOMP"))+1
- +48 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC,"UNCOMP")=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC,"UNCOMP"))+1
- +49 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC)=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMP("BDT"),ABMVLOC))+1
- End DoDot:2
- +50 ;end new abm*2.6*15
- +51 SET X1=ABMP("BDT")
- +52 SET X2=1
- +53 DO C^%DTC
- +54 IF X>ABMP("BEDT")
- SET ABMDTFLG=1
- QUIT
- +55 SET ABMP("BDT")=X
- End DoDot:1
- IF ABMDTFLG=1
- QUIT
- +56 QUIT
