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

BQIIPPRA.m

Go to the documentation of this file. 
  1. BQIIPPRA ;GDIT/HS/ALA-IPC Provider Monthly Aggregate ; 30 Nov 2011  11:17 AM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
  1.  ;
  1.  ;
  1. EN(DATA,PLIST) ;EP -- BQI GET IPC MON PROV AGG
  1.  ;Input Parameters
  1.  ;  PLIST - List of DFNs (optional) assumes Microsystem list of providers if PLIST is blank
  1.  NEW UID,II,TDATA,DTI,HDR,ORD,IDD,ID,BQMON,TIT,POS,Z,MEAS,MSDN,NUM,DEN
  1.  NEW PROV,BQI,CAT,GOAL,IDN,POS1,POS2,TAB,STAB
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIIPPRA",UID)) K @DATA
  1.  S TDATA=$NA(^TMP("BQIPRVMAG",UID)) K @TDATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPPRV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ;  get the current IPC definition
  1.  NEW CRIPC,CRN
  1.  S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
  1.  S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
  1.  ;
  1.  S HDR="T00050IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
  1.  K Z
  1.  S DTI="",POS=3
  1.  F  S DTI=$O(^BQI(90508,1,22,CRN,3,"B",DTI)) Q:DTI=""  D
  1.  . S BQMON=$E(DTI,4,5)
  1.  . S TIT=$P($T(MON+BQMON^BQIIPUTL),";;",2)_"_"_(1700+$E(DTI,1,3))
  1.  . S HDR=HDR_"T00010"_TIT_U_"T00045HIDE_"_TIT_U
  1.  . S POS=POS+1
  1.  . S Z(DTI)=POS_"^"_(POS+1)
  1.  . S POS=POS+1
  1.  ;
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD=""  D
  1.  . S IDD=""
  1.  . F  S IDD=$O(^BQI(90508,1,22,CRN,1,"C",ORD,IDD)) Q:IDD=""  D
  1.  .. S ID=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,1)
  1.  .. I $P(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1 Q
  1.  .. S DTI=""
  1.  .. F  S DTI=$O(^BQI(90508,1,22,CRN,3,"B",DTI)) Q:DTI=""  S @TDATA@(ID,DTI)="0^0"
  1.  ;
  1.  S @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$C(30)
  1.  ;
  1.  ; If a list of DFNs, process them instead of entire panel
  1.  I $D(PLIST)>0 D
  1.  . I $D(PLIST)>1 D
  1.  .. S LIST="",BN=""
  1.  .. F  S BN=$O(PLIST(BN)) Q:BN=""  S LIST=LIST_PLIST(BN)
  1.  .. K PLIST S PLIST=LIST
  1.  . F BQI=1:1 S PROV=$P(PLIST,$C(28),BQI) Q:PROV=""  D RTE(PROV)
  1.  ;
  1.  I $G(PLIST)="" S PROV="" F  S PROV=$O(^BQI(90508,1,22,CRN,2,"B",PROV)) Q:PROV=""  D RTE(PROV)
  1.  ;
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD=""  D
  1.  . S IDD=""
  1.  . F  S IDD=$O(^BQI(90508,1,22,CRN,1,"C",ORD,IDD)) Q:IDD=""  D
  1.  .. S ID=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,1)
  1.  .. I $P(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1 Q
  1.  .. I $G(@TDATA@(ID))="" Q
  1.  .. S FDATA=@TDATA@(ID)
  1.  .. S DATE=""
  1.  .. F  S DATE=$O(@TDATA@(ID,DATE)) Q:DATE=""  D
  1.  ... S DEN=$P(@TDATA@(ID,DATE),U,1),NUM=$P(@TDATA@(ID,DATE),U,2)
  1.  ... S POS1=$P(Z(DATE),U,1),POS2=$P(Z(DATE),U,2)
  1.  ... I ID="IPC_TOTP" D  Q
  1.  .... S $P(FDATA,U,POS1)=DEN,$P(FDATA,U,POS2)="Total Patients: "_DEN
  1.  ... I ID="IPC_REVG" D  Q
  1.  .... I DEN=0 S $P(FDATA,U,POS1)="$0.00",$P(FDATA,U,POS2)="Visits: "_DEN_" Billed: $0.00" Q
  1.  .... S $P(FDATA,U,POS1)=$$DOL(NUM/DEN),$P(FDATA,U,POS2)="Visits: "_DEN_" Billed: "_$$DOL(NUM)
  1.  ... I DEN=0 S $P(FDATA,U,POS1)="0%",$P(FDATA,U,POS2)="Numerator: 0 Denominator: 0" Q
  1.  ... I DEN'=0,NUM=0 S $P(FDATA,U,POS1)="0%",$P(FDATA,U,POS2)="Numerator: 0 Denominator: "_DEN Q
  1.  ... I NUM'=0 D
  1.  .... S VAL=$J((NUM/DEN)*100,3,0)
  1.  .... S VAL=$$TRIM^BQIUL1(VAL," ")_"%"
  1.  .... S $P(FDATA,U,POS1)=VAL,$P(FDATA,U,POS2)="Numerator: "_NUM_" Denominator: "_DEN
  1.  .. S DATE=""
  1.  .. F  S DATE=$O(Z(DATE)) Q:DATE=""  D
  1.  ... S POS1=$P(Z(DATE),U,1),POS2=$P(Z(DATE),U,2)
  1.  ... I $P(FDATA,U,POS1)="" S $P(FDATA,U,POS1)="N/A"
  1.  ... I $P(FDATA,U,POS2)="" S $P(FDATA,U,POS2)="Not Applicable"
  1.  .. S II=II+1,@DATA@(II)=FDATA_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. RTE(PRV) ;EP
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD=""  D
  1.  . S IDD=""
  1.  . F  S IDD=$O(^BQI(90508,1,22,CRN,1,"C",ORD,IDD)) Q:IDD=""  D
  1.  .. S ID=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,1),MEAS=$P(^(0),U,4),GOAL=$P(^(0),U,12)
  1.  .. I $P(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1 Q
  1.  .. NEW DA,IENS
  1.  .. S DA(2)=1,DA(1)=CRN,DA=IDD,IENS=$$IENS^DILF(.DA)
  1.  .. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
  1.  .. S TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
  1.  .. S STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
  1.  .. I TAB="A",STAB="F" Q
  1.  .. I CAT="" D
  1.  ... S CODE=ID
  1.  ... S RIEN=$O(^BQI(90506.1,"B",CODE,"")) I RIEN="" Q
  1.  ... S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
  1.  .. S @TDATA@(ID)=ID_$C(28)_MEAS_U_CAT_U_GOAL_U
  1.  .. S IDN=$O(^BQIPROV(PRV,30,"B",ID,"")) I IDN="" Q
  1.  .. S DTI=""
  1.  .. F  S DTI=$O(^BQI(90508,1,22,CRN,3,"B",DTI)) Q:DTI=""  D
  1.  ... S MSDN=$O(^BQIPROV(PRV,30,IDN,1,"B",DTI,""))
  1.  ... I MSDN="" S DEN=0,NUM=0
  1.  ... I MSDN'="" S DEN=+$P(^BQIPROV(PRV,30,IDN,1,MSDN,0),U,2),NUM=+$P(^BQIPROV(PRV,30,IDN,1,MSDN,0),U,3)
  1.  ... S $P(@TDATA@(ID,DTI),U,1)=$P($G(@TDATA@(ID,DTI)),U,1)+DEN,$P(@TDATA@(ID,DTI),U,2)=$P($G(@TDATA@(ID,DTI)),U,2)+NUM
  1.  Q
  1.  ;
  1. DOL(X) ;EP - Dollar formatter
  1.  S X2="2$" D COMMA^%DTC S X=X_$E("00",1,2-$L($P(X,".",2))) K X2
  1.  Q $$TKO^BQIUL1($$TRIM^BQIUL1(X," ")," ")