Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMM2P12

ABMM2P12.m

Go to the documentation of this file. 
  1. ABMM2P12 ;IHS/SD/SDR - MU Patient Volume EP Report ; 20 Feb 2014  6:04 AM
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**15**;NOV 12, 2009;Build 251
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Removed DEMO,PATIENT from report.  Also added record indicator.
  1.  ;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
  1.  ;  other visits on the same DOS.
  1.  ;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
  1.  ;  as to what grouping they were counted in.
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT174501 - Added primary provider NPI to group report.
  1.  ;
  1. ARBILLS ;
  1.  K ABMTRIEN
  1.  S ABMBILLN=+ABMBILLN_" "
  1.  S ABMSAV=+ABMSAV
  1.  F  S ABMBILLN=$O(^BARBL(ABMPAR,"B",ABMBILLN)) Q:$G(ABMBILLN)=""!(ABMBILLN'[ABMSAV)  D  Q:ABMBILLF
  1.  .S ABMARIEN=0
  1.  .S ABMHOLD=DUZ(2)
  1.  .S DUZ(2)=ABMPAR
  1.  .F  S ABMARIEN=$O(^BARBL(DUZ(2),"B",ABMBILLN,ABMARIEN)) Q:'ABMARIEN  D   Q:ABMBILLF
  1.  ..S ABMCBAMT=$$GET1^DIQ(90050.01,ABMARIEN_",",15,"I")  ;Current Bill Amount
  1.  ..S ABMARACT=$$GET1^DIQ(90050.01,ABMARIEN_",",3,"I")  ;A/R BILL, A/R ACCOUNT
  1.  ..I +$$GET1^DIQ(90050.02,ABMARACT,".01","I")'=ABMINS Q  ;abm*2.6*15  Only look at A/R bills with 3P Bill insurer
  1.  ..S D0=ABMARACT
  1.  ..S ABMITYP=$$VALI^BARVPM(8)   ;GET 'VIP INSURER TYPE' CODE
  1.  ..I ABMITYP="FPL" S ABMITYP="P"  ;change FPL to P abm*2.6*15 HEAT161159
  1.  ..I "^I^N^"[("^"_ABMITYP_"^") Q
  1.  ..;S ABMTSI=$P($G(^ABMNINS(DUZ(2),ABMINS,0)),U,11)  ;abm*2.6*15 HEAT183289
  1.  ..S ABMGRP=$S(ABMITYP="D":"MCD",($D(ABMI("INS",ABMINS))):"CHIP",1:"OTHR")
  1.  ..;I ABMTSI="Y"&($G(ABMFQHC)=1) S ABMGRP="TRIBSI"  ;abm*2.6*15 HEAT183289
  1.  ..S ABMABILN=$P($G(^BARBL(DUZ(2),ABMARIEN,0)),U)
  1.  ..;I "^MCD^CHIP^"'[("^"_ABMGRP_"^") Q
  1.  ..;S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
  1.  ..I "^MCD^CHIP^"[("^"_ABMGRP_"^") S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
  1.  ..I "^MCD^CHIP^"'[("^"_ABMGRP_"^") S ^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=2
  1.  ..;
  1.  ..D CALCDTS^ABMM2PV1
  1.  ..S ABMDTFLG=0
  1.  ..S ABMP("BDT")=ABMP("BSDT")
  1.  ..F  D  Q:ABMDTFLG=1
  1.  ...I (ABMCNT#1000&(IOST["C")) W "."
  1.  ...S ABMCNT=+$G(ABMCNT)+1
  1.  ...I ABMY("RTYP")="SEL" D
  1.  ....S ABMPIEN=0
  1.  ....K ABMPRVC
  1.  ....F  S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN  D
  1.  .....S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,.01,"I")
  1.  .....Q:'$D(ABMPRVDR(ABMPRV))
  1.  .....;skip prv if on vst >1
  1.  .....Q:$D(ABMPRVC(ABMPRV))
  1.  .....S ABMPRVC(ABMPRV)=1
  1.  .....D CALCDTS^ABMM2PV1
  1.  .....S ABMDTFLG=0
  1.  .....S ABMP("BDT")=ABMP("BSDT")
  1.  .....F  D  Q:ABMDTFLG=1
  1.  ......I ABMP("VDT")<ABMP("BSDT") S ABMDTFLG=1 Q  ;vst is before 90-day  ;abm*2.6*12 HEAT141419
  1.  ......D PTDATA^ABMM2PV1
  1.  ......S X1=ABMP("BDT")
  1.  ......S X2=1
  1.  ......D C^%DTC
  1.  ......I X>ABMP("BEDT") S ABMDTFLG=1 Q
  1.  ......S ABMP("BDT")=X
  1.  ...I ABMY("RTYP")="GRP" D GPTDATA^ABMM2PV1
  1.  ...S X1=ABMP("BDT")
  1.  ...S X2=1
  1.  ...D C^%DTC
  1.  ...I X>ABMP("BEDT") S ABMDTFLG=1 Q
  1.  ...S ABMP("BDT")=X
  1.  ..;I "^I^N^"[($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMINS,".211","I"),1,"I")) Q
  1.  ..D TRANS
  1.  .S DUZ(2)=ABMHOLD
  1.  Q
  1. TRANS ;
  1.  S ABMTRIEN=0
  1.  F  S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN)) Q:'ABMTRIEN  D  Q:ABMBILLF
  1.  .S ABMTRTYP=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U)
  1.  .S ABMADJT=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U,3)
  1.  .I (ABMTRTYP'=40)&("^113^114^121^132^137^138^139^"'[("^"_ABMADJT_"^")) D ZEROPD^ABMM2PV1 Q  ;pymt or pymt credit
  1.  .I ABMTRTYP=49 Q  ;skip BILL NEW
  1.  .I $P($G(^BARTR(DUZ(2),ABMTRIEN,0)),U,7)=1 Q  ;msg trans
  1.  .S ABMTRAMT=$$GET1^DIQ(90050.03,ABMTRIEN,3.5)  ;debit-credit field
  1.  .I ABMTRAMT<(.01) Q  ;don't count 0 pymts or reversals
  1.  .I ABMY("RTYP")="GRP" D GRPBILL^ABMM2PV1 Q
  1.  .S ABMPIEN=0
  1.  .K ABMPRVC
  1.  .F  S ABMPIEN=$O(^AUPNVPRV("AD",ABMVDFN,ABMPIEN)) Q:'ABMPIEN  D  Q:ABMBILLF
  1.  ..S ABMPRV=$$GET1^DIQ(9000010.06,ABMPIEN,".01","I")
  1.  ..Q:'$D(ABMPRVDR(ABMPRV))
  1.  ..;skip prv if on vst >1
  1.  ..Q:$D(ABMPRVC(ABMPRV))
  1.  ..S ABMPRVC(ABMPRV)=1
  1.  ..D CALCDTS^ABMM2PV1
  1.  ..S ABMDTFLG=0
  1.  ..S ABMP("BDT")=ABMP("BSDT")
  1.  ..F  D  Q:ABMDTFLG=1
  1.  ...S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD BILLS",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=""
  1.  ...S ^XTMP("ABM-PVP2",$J,"PRV-NUM PD DET",ABMP("BDT"),ABMPRV,ABMGRP,ABMVDFN,ABMP("BDFN"))=ABMTRAMT
  1.  ...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
  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
  1.  ...S ^XTMP("ABM-PVP2",$J,"PRV-VST",ABMP("BDT"),ABMVDFN,ABMPRV)=""
  1.  ...I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ABMBILLF=1,^XTMP("ABM-PVP2",$J,"VISITS",ABMVDFN)=1
  1.  ...I (ABMCNT#1000&(IOST["C")) W "."
  1.  ...S ABMCNT=+$G(ABMCNT)+1
  1.  ...D PTDATA^ABMM2PV1
  1.  ...S X1=ABMP("BDT")
  1.  ...S X2=1
  1.  ...D C^%DTC
  1.  ...I X>ABMP("BEDT") S ABMDTFLG=1 Q
  1.  ...S ABMP("BDT")=X
  1.  Q