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

BQIGPRA2.m

Go to the documentation of this file. 
  1. BQIGPRA2 ;PRXM/HC/ALA - GPRA (continued) ; 13 Jan 2006  5:48 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
  1.  ;
  1.  Q
  1.  ;
  1. SNG(DATA,DFN,YEAR) ;  EP -- BQI GET PATIENT GPRA DETAIL
  1.  NEW UID,II,BQIH,BQIYR,BQIINDG,BQIINDT,BQIMEASG,BQIND,BQMEAS,CURR,DEN,NUM,FDT,TDT,VALUE
  1.  NEW DA,IENS,BQIN,BQIMEASF,BQIINDF,TITLE,CAT,ORDER,ORN,RPERIOD,STATUS,TMGLB,TWTEN,X
  1.  NEW NAFLG,SUM,GPCODE,CLIN,GPIEN,TIT,CLN,GPMEAS,PIND,VER
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIGPSNG",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  I $O(^BQIPAT(DFN,30,0))="" S BMXSEC="Patient's Natl Measures not available" Q
  1.  ;
  1.  ;  get the current year for CRS
  1.  S YEAR=$G(YEAR,"")
  1.  I YEAR="" S YEAR=$P($G(^BQIPAT(DFN,0)),U,2)
  1.  S BQIH=$$SPM^BQIGPUTL()
  1.  I YEAR="" S YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")
  1.  S BQIYR=$$LKP^BQIGPUTL(YEAR)
  1.  I BQIYR<1 S BMXSEC="Natl Measures Year does not exist" Q
  1.  ;
  1.  S DA(1)=BQIH,DA=BQIYR
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BQIINDF=$$GET1^DIQ(90508.01,IENS,.02,"E")
  1.  S BQIMEASF=$$GET1^DIQ(90508.01,IENS,.03,"E")
  1.  S BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
  1.  S BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
  1.  ;
  1.  S TMGLB=$NA(^TMP("BQIGPDFN",UID))
  1.  K @TMGLB
  1.  S BQIND=""
  1.  F  S BQIND=$O(^BQI(90506.1,"AC","G",BQIND)) Q:BQIND=""  D
  1.  . ; if inactive, quit
  1.  . I $P(^BQI(90506.1,BQIND,0),U,10)=1 Q
  1.  . S GPCODE=$P(^BQI(90506.1,BQIND,0),U,1)
  1.  . ; if it is not the right GPRA year, quit
  1.  . I $P(GPCODE,"_",1)'=YEAR Q
  1.  . S BQMEAS=$P(GPCODE,"_",2)
  1.  . S VER=$$VERSION^XPDUTL("BGP")
  1.  . S CAT=$$GET1^DIQ(90506.1,BQIND_",",3.03,"E")
  1.  . S CLIN=$$GET1^DIQ(90506.1,BQIND_",",3.02,"E")
  1.  . S TITLE=$$GET1^DIQ(90506.1,BQIND_",",.03,"E")
  1.  . I VER>7.0 D
  1.  .. S NAFLG=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
  1.  .. S IPC=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1707,"I")
  1.  .. I IPC=1,$$CIPC^BQIIPCUT(GPCODE) D
  1.  ... S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(GPCODE)
  1.  ... I CLIN="" S CLIN=$$GET1^DIQ(90506.1,BQIND_",",3.02,"E")
  1.  .. S NAFLG=$S(NAFLG="Y":1,1:0)
  1.  .. S @TMGLB@(CAT,CLIN,TITLE,BQIND)=$S(NAFLG=1:0,1:"N/A")_"^"_CAT_"^"_CLIN_"^"_GPCODE_"^"_BQIND_"^"_TITLE_"^"
  1.  . ;
  1.  . I VER<8.0 D
  1.  .. S PIND=$O(^BQI(90508,BQIH,20,BQIYR,20,"B",BQMEAS,""))
  1.  .. S NAFLG=+$P(^BQI(90508,BQIH,20,BQIYR,20,PIND,0),U,4)
  1.  .. S ORDER=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1406,"E"),SUM="NA"
  1.  .. I ORDER="" S ORDER=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1506,"E"),SUM="NN"
  1.  .. S @TMGLB@(CAT,CLIN,TITLE,BQIND)=$S(NAFLG=1:0,1:"N/A")_"^"_CAT_"^"_CLIN_"^"_GPCODE_"^"_BQIND_"^"_TITLE_"^"
  1.  ;
  1.  S @DATA@(II)="T00025REPORT_PERIOD^D00030LAST_UPDATE^T00003STATUS^T00030CATEGORY^T00030CLIN_GROUP^T00015CODE^I00010MEAS_IEN^T00040TEXT^T00020ADHERENCE_VAL"_$C(30)
  1.  ;
  1.  S FDT=$$GET1^DIQ(90507.5,DFN_",",.03,"I")
  1.  S TDT=$$GET1^DIQ(90507.5,DFN_",",.04,"I")
  1.  S BQIINDT=$$FMTE^BQIUL1($$GET1^DIQ(90507.5,DFN_",",.05,"I"))
  1.  S RPERIOD=$$FMTE^XLFDT(FDT,1)_"-"_$$FMTE^XLFDT(TDT,1)
  1.  ;
  1.  S BQIND=0
  1.  F  S BQIND=$O(^BQIPAT(DFN,30,BQIND)) Q:'BQIND  D
  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.  . S GPCODE=BQMEAS,GPMEAS=$P(BQMEAS,"_",2)
  1.  . S GPIEN=$O(^BQI(90506.1,"B",BQMEAS,""))
  1.  . I $P(^BQI(90506.1,GPIEN,0),"^",10)=1 Q
  1.  . S TITLE=$P(^BQI(90506.1,GPIEN,0),U,3)
  1.  . ;
  1.  . I VER>7.0 D
  1.  .. S NAFLG=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1704,"I")
  1.  .. S NAFLG=$S(NAFLG="Y":1,1:0)
  1.  . ;
  1.  . I VER<8.0 D
  1.  .. S PIND=$O(^BQI(90508,BQIH,20,BQIYR,20,"B",GPMEAS,""))
  1.  .. S NAFLG=+$P(^BQI(90508,BQIH,20,BQIYR,20,PIND,0),U,4)
  1.  .. S ORDER=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1406,"E"),SUM="NA"
  1.  .. I ORDER="" S ORDER=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1506,"E"),SUM="NN"
  1.  . ;
  1.  . S TWTEN=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1403,"E")
  1.  . I TWTEN="" S TWTEN=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1503,"E")
  1.  . S CURR=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1402,"E")
  1.  . I CURR="" S CURR=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1502,"E")
  1.  . S CURR=$$STRIP^XLFSTR(CURR," @#&!")
  1.  . ;
  1.  . S CAT=$$GET1^DIQ(90506.1,GPIEN_",",3.03,"E")
  1.  . S CLIN=$$GET1^DIQ(90506.1,GPIEN_",",3.02,"E")
  1.  . S IPC=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1707,"I")
  1.  . I IPC=1,$$CIPC^BQIIPCUT(GPCODE) D
  1.  .. S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(GPCODE)
  1.  .. I CLIN="" S CLIN=$$GET1^DIQ(90506.1,GPIEN_",",3.02,"E")
  1.  . ;
  1.  . I '+DEN&('NAFLG) Q
  1.  . S STATUS=$S(NUM>0&(NAFLG):NUM,NUM<1&(NAFLG):0,NUM>0:"YES",1:"NO")
  1.  . I VER<8.0 D
  1.  .. S @TMGLB@(CAT,CLIN,TITLE,GPIEN)=STATUS_"^"_CAT_"^"_CLIN_"^"_BQMEAS_"^"_GPIEN_"^"_TITLE_"^"_$P(VALUE,"|||",2)
  1.  . I VER>7.0 D
  1.  .. S @TMGLB@(CAT,CLIN,TITLE,GPIEN)=STATUS_"^"_CAT_"^"_CLIN_"^"_BQMEAS_"^"_GPIEN_"^"_TITLE_"^"_$P(VALUE,"|||",2)
  1.  ;
  1.  S CAT=""
  1.  F  S CAT=$O(@TMGLB@(CAT)) Q:CAT=""  D
  1.  . S CLN=""
  1.  . F  S CLN=$O(@TMGLB@(CAT,CLN)) Q:CLN=""  D
  1.  .. S TIT=""
  1.  .. F  S TIT=$O(@TMGLB@(CAT,CLN,TIT)) Q:TIT=""  D
  1.  ... S ORN=""
  1.  ... F  S ORN=$O(@TMGLB@(CAT,CLN,TIT,ORN)) Q:ORN=""  D
  1.  .... S II=II+1,@DATA@(II)=RPERIOD_"^"_BQIINDT_"^"_@TMGLB@(CAT,CLN,TIT,ORN)_$C(30)
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q