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

ABMMUPV2.m

Go to the documentation of this file.
  1. ABMMUPV2 ;IHS/SD/SDR - MU Patient Volume EP Report ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;**7,8**;NOV 12, 2009
  1. ;
  1. CALC ;EP
  1. I ABMY("RTYP")="GRP" D CALC2 Q ;abm*2.6*8
  1. S ABMSDT=0
  1. F S ABMSDT=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT)) Q:'ABMSDT D
  1. .S ABMPRV=0
  1. .F S ABMPRV=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV)) Q:'ABMPRV D
  1. ..S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMPRV))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV))))*100,0,1)
  1. ..S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMPRV)=ABMPERCT
  1. ..I '$D(^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)) S ^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)=ABMPERCT_"^"_ABMSDT
  1. ..I +$P($G(^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)),U)<ABMPERCT S ^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)=ABMPERCT_"^"_ABMSDT
  1. ..;
  1. ..S ABMVLOC=0
  1. ..F S ABMVLOC=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC)) Q:'ABMVLOC D
  1. ...I +$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC))=0 S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=0 Q
  1. ...S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC))))*100,0,1)
  1. ...S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=ABMPERCT
  1. Q
  1. ;start new code abm*2.6*8
  1. CALC2 ;EP
  1. S ABMSDT=0
  1. F S ABMSDT=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT)) Q:'ABMSDT D
  1. .S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT))))*100,0,1)
  1. .S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT)=ABMPERCT
  1. .I '$D(^XTMP("ABM-PVP",$J,"PRV TOP")) S ^XTMP("ABM-PVP",$J,"PRV TOP")=ABMPERCT_"^"_ABMSDT
  1. .I +$P($G(^XTMP("ABM-PVP",$J,"PRV TOP")),U)<ABMPERCT S ^XTMP("ABM-PVP",$J,"PRV TOP")=ABMPERCT_"^"_ABMSDT
  1. .;
  1. .S ABMVLOC=0
  1. .F S ABMVLOC=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMVLOC)) Q:'ABMVLOC D
  1. ..I +$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMVLOC))=0 S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMVLOC)=0 Q
  1. ..S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMVLOC))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMVLOC))))*100,0,1)
  1. ..S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMVLOC)=ABMPERCT
  1. Q
  1. ;end new code abm*2.6*8