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

ABMM2PH3.m

Go to the documentation of this file. 
  1. ABMM2PH3 ;IHS/SD/SDR - MU Patient Volume Hospital Report ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**15**;NOV 12, 2009;Build 251
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT161159 - Changed PT LST to sort differently so there won't be duplicate vsts on pt lst.
  1.  ;IHS/SD/SDR - 2.6*15 - HEAT156874 - Change for <SUBSCR>PTDATA+16^ABMM2PV7.  Occurs when patient is missing from visit.
  1.  ;
  1. TRANS ;EP
  1.  S ABMTRIEN=0,ABMQFLG=0
  1.  F  S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMARIEN,ABMTRIEN)) Q:'ABMTRIEN  D  Q:ABMQFLG=1
  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 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 cnt 0 pymts or reversals
  1.  .D CALCDTS^ABMM2PV1
  1.  .S ABMDTFLG=0
  1.  .S ABMP("BDT")=ABMP("BSDT")
  1.  .F  D  Q:ABMDTFLG=1
  1.  ..I ABMITYP="D"!($D(ABMI("INS",ABMINS))) D
  1.  ...S ABMQFLG=1
  1.  ...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"))=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT")))+1
  1.  ...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC))+1
  1.  ...S ^XTMP("ABM-PVH2",$J,"LOC-NUM PD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
  1.  ...S ^XTMP("ABM-PVH2",$J,"LOC-NUM PD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
  1.  ...S ^XTMP("ABM-PVH2",$J,"LOC-VST",ABMVDFN)=""
  1.  ...I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ABMBILLF=1,^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN)=1
  1.  ..S ^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP))+1
  1.  ..S ^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMGRP))+1
  1.  ..I (ABMCNT#1000&(IOST["C")) U IO(0) W "."
  1.  ..S ABMCNT=+$G(ABMCNT)+1
  1.  ..D PTDATA
  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
  1. ZEROPD ;EP
  1.  D CALCDTS^ABMM2PV1
  1.  S ABMDTFLG=0
  1.  S ABMP("BDT")=ABMP("BSDT")
  1.  F  D  Q:ABMDTFLG=1
  1.  .I ABMITYP="D"!($D(ABMI("INS",ABMINS))) D
  1.  ..S ^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD BILLS",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
  1.  ..S ^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD DET",ABMP("BDT"),ABMGRP,ABMVDFN,ABMP("BDFN"))=""
  1.  .S ^XTMP("ABM-PVH2",$J,"LOC-VST",ABMP("BDT"),ABMVDFN)=""
  1.  .I ABMITYP="D"!($D(ABMI("INS",ABMINS))) S ^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN)=1
  1.  .D PTDATA
  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.  ;
  1.  Q
  1. OTHERVST ;EP
  1.  S ABMPT=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5)
  1.  S (ABMDOS,ABMDOSSV)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
  1.  F  S ABMDOS=$O(^XTMP("ABM-PVH2",$J,"PT VSTS",ABMPT,ABMDOS)) Q:'ABMDOS!($P(ABMDOS,".")>$P(ABMDOSSV,"."))  D
  1.  .S ABMVCHK=0
  1.  .F  S ABMVCHK=$O(^XTMP("ABM-PVH2",$J,"PT VSTS",ABMPT,ABMDOS,ABMVCHK)) Q:'ABMVCHK  D
  1.  ..Q:^XTMP("ABM-PVH2",$J,"VISITS",ABMVCHK)=1  ;already cnted vst
  1.  ..Q:$D(^XTMP("ABM-PVH2",$J,"LOC-VST",ABMVCHK))
  1.  ..D CALCDTS^ABMM2PV1
  1.  ..S ABMDTFLG=0
  1.  ..S ABMP("BDT")=ABMP("BSDT")
  1.  ..F  D  Q:ABMDTFLG=1
  1.  ...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"))=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT")))+1
  1.  ...S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC)=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMP("BDT"),ABMVLOC))+1
  1.  ...S ^XTMP("ABM-PVH2",$J,"VISITS",ABMVCHK)=1
  1.  ...S X1=ABMP("BDT")
  1.  ...S X2=1
  1.  ...D C^%DTC
  1.  ...I X>ABMDOS S ABMDTFLG=1 Q
  1.  ...S ABMP("BDT")=X
  1.  Q
  1. PTDATA ;EP
  1.  S ABMPNM=$$GET1^DIQ(2,ABMPT,.01,"E")
  1.  I '$D(^DPT(ABMPT))!(ABMPNM="") Q  ;abm*2.6*15 HEAT156874
  1.  S ABMINSO=$S(+$G(ABMINS):$$GET1^DIQ(9999999.18,ABMINS,.01,"E"),1:"NO BILL")
  1.  S:+$G(ABMBILLN)=0 ABMITYP="X"
  1.  S:$G(ABMTRIEN)="" ABMTRIEN="NOT PAID"
  1.  I +$G(ABMTRIEN)'=0 D
  1.  .S ABMRECPD=""
  1.  .I (+$G(ABMTRTYP)'=40)&("^113^114^121^132^137^138^139^"'[("^"_+$G(ABMADJT)_"^")) S ABMRECPD="" Q
  1.  .;I (ABMITYP="D")!($D(ABMI("INS",ABMINSO))) S ABMRECPD="*"  ;abm*2.6*15
  1.  .I (ABMITYP="D")!($D(ABMI("INS",ABMINS))) S ABMRECPD="*"  ;abm*2.6*15 HEAT161159
  1.  I +$G(ABMTRIEN)=0 S ABMTRIEN="NOT PAID",ABMRECPD=""
  1.  S ABMREC=ABMVDFN_U_ABMPT_U_$S($G(ABMRECPD)'="":$P($G(ABMTRIEN),"."),1:"")_U_ABMRECPD
  1.  S ABMREC=ABMREC_U_$G(ABMBILLN)_U_$S($G(ABMBILLN):+$G(ABMTRAMT),1:$G(ABMTRAMT))_U_$G(ABMDX)
  1.  S ABMREC=ABMREC_U_ABMITYP_U_ABMINSO_U_$P(ABMPNM,",")_U_$P(ABMPNM,",",2)_U_$P($G(^AUPNVSIT(ABMVDFN,0)),U)  ;abm*2.6*15 HEAT161159
  1.  ;S ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,ABMITYP,ABMINSO,$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC  ;abm*2.6*15 HEAT161159
  1.  S ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)=ABMREC  ;abm*2.6*15 HEAT161159
  1.  ;start old abm*2.6*15 HEAT161159
  1.  ;I (+$G(ABMBILLN)'=0)&$D(^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U))) D
  1.  ;.K ^XTMP("ABM-PVH2",$J,"PT LST",ABMP("BDT"),ABMVLOC,"X","NO BILL",$P(ABMPNM,","),$P(ABMPNM,",",2),$P($G(^AUPNVSIT(ABMVDFN,0)),U),ABMVDFN)
  1.  ;end old abm*2.6*15 HEAT161159
  1.  Q