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

BQIIPPRV.m

Go to the documentation of this file. 
  1. BQIIPPRV ;VNGT/HS/ALA-Get Provider Data ; 19 Jul 2011  2:39 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
  1.  ;
  1.  ;
  1. EN(DATA,OWNR,PLIEN,CRIPC,PLIST) ;EP - BQI GET IPC PROV DETAIL
  1.  ;Description - Entry point for the panel
  1.  ;Input Parameters
  1.  ;  OWNR  - Owner of panel
  1.  ;  PLIEN - Panel IEN
  1.  ;  PLIST - List of DFNs (optional) 
  1.  NEW UID,II,TDATA,XX,BQIND,BQMEAS,CAT,CODE,DEC,DEN,DFN,IDATA,MET,MSIEN
  1.  NEW NDA,NO,NUM,PROV,PRV,TITLE,TOTP,TYP,VAL,VALUE,XX,YES,TNDA,CAT2,CAT
  1.  NEW TAB,MSN,NA,BQIDOD,CNT,DCAT,EXEC,GP,I,ORD,QFL,TAG,STAB,GOAL,CRN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIIPPRV",UID)) K @DATA
  1.  S TDATA=$NA(^TMP("BQIPRVIP",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.  S CRIPC=$G(CRIPC,"")
  1.  I CRIPC="" S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
  1.  S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
  1.  S @DATA@(II)="T00035PROVIDER^I00010TOTAL_PATIENTS^I00010TOTAL_NDA^"
  1.  S @DATA@(II)=@DATA@(II)_"T00030CATEGORY^T00030CAT2^T00060TITLE^T00030ID^"
  1.  S @DATA@(II)=@DATA@(II)_"I00010NUMERATOR^I00010DENOMINATOR^I00010DECEASED^T00005PERCENT_MET^T00005PERCENT_GOAL"_$C(30)
  1.  ;
  1.  ; If a list of DFNs, process them instead of entire panel
  1.  I $D(PLIST)>0 D  G DONE
  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 DFN=$P(PLIST,$C(28),BQI) Q:DFN=""  D
  1.  .. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
  1.  .. D RPT(DFN)
  1.  ;
  1.  S DFN=0
  1.  I $O(^BQICARE(OWNR,1,PLIEN,40,DFN))="" G DONE
  1.  ;
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D
  1.  . I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
  1.  . D RPT(DFN)
  1.  ;
  1.  S PRV=""
  1.  F  S PRV=$O(@TDATA@(PRV)) Q:PRV=""  D
  1.  . S TOTP=$G(@TDATA@(PRV,"TOTP")),TNDA=0
  1.  . S DFN="" F  S DFN=$O(@TDATA@(PRV,"NDA",DFN)) Q:DFN=""  S TNDA=TNDA+1
  1.  . S ORD=""
  1.  . F  S ORD=$O(@TDATA@(PRV,ORD)) Q:'ORD  D
  1.  .. S MSN=$O(^BQI(90508,1,22,CRN,1,"C",ORD,"")) I MSN="" Q
  1.  .. S IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
  1.  .. I $P(IDATA,U,7)=1 Q
  1.  .. NEW DA,IENS
  1.  .. S DA(2)=1,DA(1)=CRN,DA=MSN,IENS=$$IENS^DILF(.DA)
  1.  .. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
  1.  .. S CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
  1.  .. I CRIPC="IPC4/IPC5" D
  1.  ... S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
  1.  ... I CAT="" D
  1.  .... S RIEN=$O(^BQI(90506.1,"B",CODE,""))
  1.  .... S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
  1.  ... S CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
  1.  .. I CRIPC="IPCMH" D
  1.  ... S CAT1=$$GET1^DIQ(90508.221,IENS,.03,"E")
  1.  ... S ICAT=$$GET1^DIQ(90508.221,IENS,.03,"I")
  1.  ... S CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
  1.  ... I CAT2="" S CAT2=$$GET1^DIQ(90506.8,ICAT_",",.04,"E")
  1.  ... S CAT=CAT2,CAT2=CAT1
  1.  .. S TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
  1.  .. S STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
  1.  .. I TAB="A" Q
  1.  .. S CODE=$P(IDATA,U,1),TITLE=$P(IDATA,U,4),GOAL=$P(IDATA,U,12)
  1.  .. S NUM=$G(@TDATA@(PRV,ORD,"NUM"))
  1.  .. S DEN=$G(@TDATA@(PRV,ORD,"DEN"))
  1.  .. S DEC=$G(@TDATA@(PRV,ORD,"DEC"))
  1.  .. I IDATA["Goal Set" S DEN=TOTP
  1.  .. I +DEN=0 S MET="0%"
  1.  .. I +DEN'=0,+NUM=0 S MET="0%"
  1.  .. I +NUM'=0 S MET=$J((NUM/DEN)*100,3,0),MET=$$TRIM^BQIUL1(MET," ")_"%"
  1.  .. I PRV'="~" D
  1.  ... S TRM=0
  1.  ... I $P($G(^VA(200,PRV,0)),U,13)'="" S TRM=1
  1.  ... S PROV=PRV_$C(28)_$S(TRM:"*",1:"")_$P($G(^VA(200,PRV,0)),U,1)
  1.  .. I PRV="~" S PROV="{NOT ASSIGNED}"
  1.  .. S DCAT=CAT
  1.  .. I DCAT["_1" S DCAT=$P(CAT,"_1",1)
  1.  .. I DCAT["_2" S DCAT=$P(CAT,"_2",1)
  1.  .. S II=II+1,@DATA@(II)=PROV_U_TOTP_U_$G(TNDA)_U_DCAT_U_CAT2_U_TITLE_U_CODE_U_NUM_U_DEN_U_DEC_U_MET_U_GOAL_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K @TDATA
  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. RPT(DFN) ;  Get the CRS Clinical Performance information
  1.  S PROV=$P($G(^AUPNPAT(DFN,0)),U,14) S:PROV="" PROV="~"
  1.  I '$$HRN^BQIUL1(DFN) Q
  1.  S @TDATA@(PROV,"TOTP")=$G(@TDATA@(PROV,"TOTP"))+1
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD=""  D
  1.  . S MSN=""
  1.  . F  S MSN=$O(^BQI(90508,1,22,CRN,1,"C",ORD,MSN)) Q:MSN=""  D
  1.  .. S IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
  1.  .. S CODE=$P(IDATA,U,1),TYP=$P(IDATA,U,2),TITLE=$P(IDATA,U,4)
  1.  .. ; If inactive, quit
  1.  .. I $P(IDATA,U,7)=1 Q
  1.  .. NEW DA,IENS
  1.  .. S DA(2)=1,DA(1)=CRN,DA=MSN,IENS=$$IENS^DILF(.DA)
  1.  .. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
  1.  .. S MSIEN=$O(^BQI(90506.1,"B",CODE,""))
  1.  .. I CAT="",MSIEN'="" S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
  1.  .. I CAT="" S CAT="~"
  1.  .. I $P(IDATA,U,5)'="B" S CAT=CAT_"_2"
  1.  .. S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1.  .. I $G(BQIDOD)'="" D  Q
  1.  ... I CAT'["_" S CAT=CAT_"_1"
  1.  ... S @TDATA@(PROV,ORD,"DEC")=$G(@TDATA@(PROV,ORD,"DEC"))+1
  1.  .. I TYP="R",$P(IDATA,U,5)="B" D
  1.  ... K XX
  1.  ... I CODE="IPC_OUTC" D
  1.  .... I DFN'="" S VAL=$$OPAT^BQIIPOTC(CRN,DFN)
  1.  ... I CODE["CTRL" D
  1.  .... I DFN'="" S VAL=$$PAT^BQIIPOTC(CRN,DFN,CODE)
  1.  ... I CODE'="IPC_OUTC",CODE'["CTRL" D
  1.  .... D BUN^BQIIPBNL(CRN,MSN,.XX)
  1.  .... I DFN'="" S VAL=$$PAT^BQIIPBNL(DFN,.XX)
  1.  ... I VAL="N/A"!(VAL="NDA") S NUM=0,DEN=0 D STOR(ORD) Q
  1.  ... ;I VAL="N/A" Q
  1.  ... I $P(IDATA,U,5)="B" S CAT=CAT_"_1"
  1.  ... I VAL="NDA" D  Q
  1.  .... S DEN=0,NUM=0 D STOR(ORD)
  1.  .... S @TDATA@(PROV,"NDA",DFN)=1
  1.  ... I VAL="NO" S DEN=1,NUM=0 D STOR(ORD) Q
  1.  ... I VAL="YES" S DEN=1,NUM=1 D STOR(ORD) Q
  1.  .. I TYP'="G" Q
  1.  .. S BQIND=$O(^BQIPAT(DFN,30,"B",CODE,"")) I BQIND="" D  Q
  1.  ... S @TDATA@(PROV,"NDA",DFN)=1
  1.  ... ;S DEN=1,NUM=0 D STOR(ORD)
  1.  ... S DEN=0,NUM=0 D STOR(ORD)
  1.  .. S BQMEAS=$P(^BQIPAT(DFN,30,BQIND,0),U,1),VALUE=$P(^(0),U,2),NUM=$P(^(0),U,3),DEN=$P(^(0),U,4)
  1.  .. ;
  1.  .. D STOR(ORD)
  1.  Q
  1.  ;
  1. STOR(ORD) ;EP
  1.  S @TDATA@(PROV,ORD,"NUM")=$G(@TDATA@(PROV,ORD,"NUM"))+NUM
  1.  S @TDATA@(PROV,ORD,"DEN")=$G(@TDATA@(PROV,ORD,"DEN"))+DEN
  1.  ;S @TDATA@(PROV,CAT,TITLE,MSN,"NUM")=$G(@TDATA@(PROV,CAT,TITLE,MSN,"NUM"))+NUM
  1.  ;S @TDATA@(PROV,CAT,TITLE,MSN,"DEN")=$G(@TDATA@(PROV,CAT,TITLE,MSN,"DEN"))+DEN
  1.  Q