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

BQIIPPNL.m

Go to the documentation of this file. 
  1. BQIIPPNL ;GDIT/HS/ALA-Panel Aggregate ; 09 Sep 2011  12:17 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
  1.  ;
  1.  ;
  1. EN(DATA,OWNR,PLIEN,CRIPC,PLIST) ;EP - BQI GET IPC PROV AGG
  1.  ;Description - Entry point for the panel
  1.  ;Input Parameters
  1.  ;  OWNR  - Owner of panel
  1.  ;  PLIEN - Panel IEN
  1.  ;  CRIPC = IPC Version
  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,GOAL,TNDA,CAT2
  1.  NEW STAB,MSN,NA,TAB,BQIDOD,CNT,DCAT,EXEC,GP,I,ORD,QFL,TAG,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)="I00010TOTAL_PATIENTS^I00010TOTAL_NDA^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 TOTP=$G(@TDATA@("TOTP")),TNDA=0
  1.  S DFN="" F  S DFN=$O(@TDATA@("NDA",DFN)) Q:DFN=""  S TNDA=$G(TNDA)+1
  1.  S ORD=""
  1.  F  S ORD=$O(@TDATA@(ORD)) Q:ORD=""  D
  1.  . S MSN=$O(^BQI(90508,1,22,CRN,1,"C",ORD,"")) Q:MSN=""
  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@(ORD,"NUM"))
  1.  . S DEN=$G(@TDATA@(ORD,"DEN"))
  1.  . S DEC=$G(@TDATA@(ORD,"DEC"))
  1.  . ;S NDA=$G(@TDATA@(ORD,"NDA"))
  1.  . ;I $P(IDATA,U,5)'="B" S DEN=DEN+NDA
  1.  . I $P(IDATA,U,5)'="B" S DEN=DEN
  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.  . 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)=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.  I '$$HRN^BQIUL1(DFN) Q
  1.  S PROV=$P($G(^AUPNPAT(DFN,0)),U,14)
  1.  S @TDATA@("TOTP")=$G(@TDATA@("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@(ORD,"DEC")=$G(@TDATA@(ORD,"DEC"))+1
  1.  .. I TYP="R",$P(IDATA,U,5)="B" D
  1.  ... K XX
  1.  ... I CODE="IPC_OUTC" D  Q
  1.  .... I DFN'="" S VAL=$$OPAT^BQIIPOTC(CRN,DFN)
  1.  .... D CK
  1.  ... I CODE["CTRL" D  Q
  1.  .... I DFN'="" S VAL=$$PAT^BQIIPOTC(CRN,DFN,CODE)
  1.  .... D CK
  1.  ... D  Q
  1.  .... D BUN^BQIIPBNL(CRN,MSN,.XX)
  1.  .... I DFN'="" S VAL=$$PAT^BQIIPBNL(DFN,.XX)
  1.  .... D CK
  1.  .. I TYP'="G" Q
  1.  .. S BQIND=$O(^BQIPAT(DFN,30,"B",CODE,"")) I BQIND="" D  Q
  1.  ... S @TDATA@("NDA",DFN)=1
  1.  ... S NDA=1,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),NDA=0
  1.  .. ;
  1.  .. D STOR(ORD)
  1.  Q
  1.  ;
  1. STOR(ORD) ;EP
  1.  S @TDATA@(ORD,"NUM")=$G(@TDATA@(ORD,"NUM"))+$G(NUM)
  1.  S @TDATA@(ORD,"DEN")=$G(@TDATA@(ORD,"DEN"))+$G(DEN)
  1.  S @TDATA@(ORD,"NDA")=$G(@TDATA@(ORD,"NDA"))+$G(NDA)
  1.  Q
  1.  ;
  1. CK ;Check and store
  1.  I VAL="N/A" S DEN=0,NUM=0 D STOR(ORD) Q
  1.  S CAT=CAT_"_1"
  1.  I VAL="NDA" S DEN=0,NUM=0 D STOR(ORD) Q
  1.  ;I VAL="NDA" Q
  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.  Q