BQIGPRA2 ;PRXM/HC/ALA - GPRA (continued) ; 13 Jan 2006 5:48 PM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
Q
;
SNG(DATA,DFN,YEAR) ; EP -- BQI GET PATIENT GPRA DETAIL
NEW UID,II,BQIH,BQIYR,BQIINDG,BQIINDT,BQIMEASG,BQIND,BQMEAS,CURR,DEN,NUM,FDT,TDT,VALUE
NEW DA,IENS,BQIN,BQIMEASF,BQIINDF,TITLE,CAT,ORDER,ORN,RPERIOD,STATUS,TMGLB,TWTEN,X
NEW NAFLG,SUM,GPCODE,CLIN,GPIEN,TIT,CLN,GPMEAS,PIND,VER
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIGPSNG",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I $O(^BQIPAT(DFN,30,0))="" S BMXSEC="Patient's Natl Measures not available" Q
;
; get the current year for CRS
S YEAR=$G(YEAR,"")
I YEAR="" S YEAR=$P($G(^BQIPAT(DFN,0)),U,2)
S BQIH=$$SPM^BQIGPUTL()
I YEAR="" S YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")
S BQIYR=$$LKP^BQIGPUTL(YEAR)
I BQIYR<1 S BMXSEC="Natl Measures Year does not exist" Q
;
S DA(1)=BQIH,DA=BQIYR
S IENS=$$IENS^DILF(.DA)
S BQIINDF=$$GET1^DIQ(90508.01,IENS,.02,"E")
S BQIMEASF=$$GET1^DIQ(90508.01,IENS,.03,"E")
S BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
S BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
;
S TMGLB=$NA(^TMP("BQIGPDFN",UID))
K @TMGLB
S BQIND=""
F S BQIND=$O(^BQI(90506.1,"AC","G",BQIND)) Q:BQIND="" D
. ; if inactive, quit
. I $P(^BQI(90506.1,BQIND,0),U,10)=1 Q
. S GPCODE=$P(^BQI(90506.1,BQIND,0),U,1)
. ; if it is not the right GPRA year, quit
. I $P(GPCODE,"_",1)'=YEAR Q
. S BQMEAS=$P(GPCODE,"_",2)
. S VER=$$VERSION^XPDUTL("BGP")
. S CAT=$$GET1^DIQ(90506.1,BQIND_",",3.03,"E")
. S CLIN=$$GET1^DIQ(90506.1,BQIND_",",3.02,"E")
. S TITLE=$$GET1^DIQ(90506.1,BQIND_",",.03,"E")
. I VER>7.0 D
.. S NAFLG=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
.. S IPC=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1707,"I")
.. I IPC=1,$$CIPC^BQIIPCUT(GPCODE) D
... S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(GPCODE)
... I CLIN="" S CLIN=$$GET1^DIQ(90506.1,BQIND_",",3.02,"E")
.. S NAFLG=$S(NAFLG="Y":1,1:0)
.. S @TMGLB@(CAT,CLIN,TITLE,BQIND)=$S(NAFLG=1:0,1:"N/A")_"^"_CAT_"^"_CLIN_"^"_GPCODE_"^"_BQIND_"^"_TITLE_"^"
. ;
. I VER<8.0 D
.. S PIND=$O(^BQI(90508,BQIH,20,BQIYR,20,"B",BQMEAS,""))
.. S NAFLG=+$P(^BQI(90508,BQIH,20,BQIYR,20,PIND,0),U,4)
.. S ORDER=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1406,"E"),SUM="NA"
.. I ORDER="" S ORDER=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1506,"E"),SUM="NN"
.. S @TMGLB@(CAT,CLIN,TITLE,BQIND)=$S(NAFLG=1:0,1:"N/A")_"^"_CAT_"^"_CLIN_"^"_GPCODE_"^"_BQIND_"^"_TITLE_"^"
;
S @DATA@(II)="T00025REPORT_PERIOD^D00030LAST_UPDATE^T00003STATUS^T00030CATEGORY^T00030CLIN_GROUP^T00015CODE^I00010MEAS_IEN^T00040TEXT^T00020ADHERENCE_VAL"_$C(30)
;
S FDT=$$GET1^DIQ(90507.5,DFN_",",.03,"I")
S TDT=$$GET1^DIQ(90507.5,DFN_",",.04,"I")
S BQIINDT=$$FMTE^BQIUL1($$GET1^DIQ(90507.5,DFN_",",.05,"I"))
S RPERIOD=$$FMTE^XLFDT(FDT,1)_"-"_$$FMTE^XLFDT(TDT,1)
;
S BQIND=0
F S BQIND=$O(^BQIPAT(DFN,30,BQIND)) Q:'BQIND D
. 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)
. S GPCODE=BQMEAS,GPMEAS=$P(BQMEAS,"_",2)
. S GPIEN=$O(^BQI(90506.1,"B",BQMEAS,""))
. I $P(^BQI(90506.1,GPIEN,0),"^",10)=1 Q
. S TITLE=$P(^BQI(90506.1,GPIEN,0),U,3)
. ;
. I VER>7.0 D
.. S NAFLG=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1704,"I")
.. S NAFLG=$S(NAFLG="Y":1,1:0)
. ;
. I VER<8.0 D
.. S PIND=$O(^BQI(90508,BQIH,20,BQIYR,20,"B",GPMEAS,""))
.. S NAFLG=+$P(^BQI(90508,BQIH,20,BQIYR,20,PIND,0),U,4)
.. S ORDER=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1406,"E"),SUM="NA"
.. I ORDER="" S ORDER=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1506,"E"),SUM="NN"
. ;
. S TWTEN=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1403,"E")
. I TWTEN="" S TWTEN=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1503,"E")
. S CURR=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1402,"E")
. I CURR="" S CURR=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1502,"E")
. S CURR=$$STRIP^XLFSTR(CURR," @#&!")
. ;
. S CAT=$$GET1^DIQ(90506.1,GPIEN_",",3.03,"E")
. S CLIN=$$GET1^DIQ(90506.1,GPIEN_",",3.02,"E")
. S IPC=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1707,"I")
. I IPC=1,$$CIPC^BQIIPCUT(GPCODE) D
.. S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(GPCODE)
.. I CLIN="" S CLIN=$$GET1^DIQ(90506.1,GPIEN_",",3.02,"E")
. ;
. I '+DEN&('NAFLG) Q
. S STATUS=$S(NUM>0&(NAFLG):NUM,NUM<1&(NAFLG):0,NUM>0:"YES",1:"NO")
. I VER<8.0 D
.. S @TMGLB@(CAT,CLIN,TITLE,GPIEN)=STATUS_"^"_CAT_"^"_CLIN_"^"_BQMEAS_"^"_GPIEN_"^"_TITLE_"^"_$P(VALUE,"|||",2)
. I VER>7.0 D
.. S @TMGLB@(CAT,CLIN,TITLE,GPIEN)=STATUS_"^"_CAT_"^"_CLIN_"^"_BQMEAS_"^"_GPIEN_"^"_TITLE_"^"_$P(VALUE,"|||",2)
;
S CAT=""
F S CAT=$O(@TMGLB@(CAT)) Q:CAT="" D
. S CLN=""
. F S CLN=$O(@TMGLB@(CAT,CLN)) Q:CLN="" D
.. S TIT=""
.. F S TIT=$O(@TMGLB@(CAT,CLN,TIT)) Q:TIT="" D
... S ORN=""
... F S ORN=$O(@TMGLB@(CAT,CLN,TIT,ORN)) Q:ORN="" D
.... S II=II+1,@DATA@(II)=RPERIOD_"^"_BQIINDT_"^"_@TMGLB@(CAT,CLN,TIT,ORN)_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
BQIGPRA2 ;PRXM/HC/ALA - GPRA (continued) ; 13 Jan 2006 5:48 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
+3 QUIT
+4 ;
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
+2 NEW DA,IENS,BQIN,BQIMEASF,BQIINDF,TITLE,CAT,ORDER,ORN,RPERIOD,STATUS,TMGLB,TWTEN,X
+3 NEW NAFLG,SUM,GPCODE,CLIN,GPIEN,TIT,CLN,GPMEAS,PIND,VER
+4 ;
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BQIGPSNG",UID))
+7 KILL @DATA
+8 ;
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER"
+11 ;
+12 IF $ORDER(^BQIPAT(DFN,30,0))=""
SET BMXSEC="Patient's Natl Measures not available"
QUIT
+13 ;
+14 ; get the current year for CRS
+15 SET YEAR=$GET(YEAR,"")
+16 IF YEAR=""
SET YEAR=$PIECE($GET(^BQIPAT(DFN,0)),U,2)
+17 SET BQIH=$$SPM^BQIGPUTL()
+18 IF YEAR=""
SET YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")
+19 SET BQIYR=$$LKP^BQIGPUTL(YEAR)
+20 IF BQIYR<1
SET BMXSEC="Natl Measures Year does not exist"
QUIT
+21 ;
+22 SET DA(1)=BQIH
SET DA=BQIYR
+23 SET IENS=$$IENS^DILF(.DA)
+24 SET BQIINDF=$$GET1^DIQ(90508.01,IENS,.02,"E")
+25 SET BQIMEASF=$$GET1^DIQ(90508.01,IENS,.03,"E")
+26 SET BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
+27 SET BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
+28 ;
+29 SET TMGLB=$NAME(^TMP("BQIGPDFN",UID))
+30 KILL @TMGLB
+31 SET BQIND=""
+32 FOR
SET BQIND=$ORDER(^BQI(90506.1,"AC","G",BQIND))
IF BQIND=""
QUIT
Begin DoDot:1
+33 ; if inactive, quit
+34 IF $PIECE(^BQI(90506.1,BQIND,0),U,10)=1
QUIT
+35 SET GPCODE=$PIECE(^BQI(90506.1,BQIND,0),U,1)
+36 ; if it is not the right GPRA year, quit
+37 IF $PIECE(GPCODE,"_",1)'=YEAR
QUIT
+38 SET BQMEAS=$PIECE(GPCODE,"_",2)
+39 SET VER=$$VERSION^XPDUTL("BGP")
+40 SET CAT=$$GET1^DIQ(90506.1,BQIND_",",3.03,"E")
+41 SET CLIN=$$GET1^DIQ(90506.1,BQIND_",",3.02,"E")
+42 SET TITLE=$$GET1^DIQ(90506.1,BQIND_",",.03,"E")
+43 IF VER>7.0
Begin DoDot:2
+44 SET NAFLG=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
+45 SET IPC=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1707,"I")
+46 IF IPC=1
IF $$CIPC^BQIIPCUT(GPCODE)
Begin DoDot:3
+47 SET CAT="IPC"
SET CLIN=$$CLIN^BQIIPCUT(GPCODE)
+48 IF CLIN=""
SET CLIN=$$GET1^DIQ(90506.1,BQIND_",",3.02,"E")
End DoDot:3
+49 SET NAFLG=$SELECT(NAFLG="Y":1,1:0)
+50 SET @TMGLB@(CAT,CLIN,TITLE,BQIND)=$SELECT(NAFLG=1:0,1:"N/A")_"^"_CAT_"^"_CLIN_"^"_GPCODE_"^"_BQIND_"^"_TITLE_"^"
End DoDot:2
+51 ;
+52 IF VER<8.0
Begin DoDot:2
+53 SET PIND=$ORDER(^BQI(90508,BQIH,20,BQIYR,20,"B",BQMEAS,""))
+54 SET NAFLG=+$PIECE(^BQI(90508,BQIH,20,BQIYR,20,PIND,0),U,4)
+55 SET ORDER=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1406,"E")
SET SUM="NA"
+56 IF ORDER=""
SET ORDER=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1506,"E")
SET SUM="NN"
+57 SET @TMGLB@(CAT,CLIN,TITLE,BQIND)=$SELECT(NAFLG=1:0,1:"N/A")_"^"_CAT_"^"_CLIN_"^"_GPCODE_"^"_BQIND_"^"_TITLE_"^"
End DoDot:2
End DoDot:1
+58 ;
+59 SET @DATA@(II)="T00025REPORT_PERIOD^D00030LAST_UPDATE^T00003STATUS^T00030CATEGORY^T00030CLIN_GROUP^T00015CODE^I00010MEAS_IEN^T00040TEXT^T00020ADHERENCE_VAL"_$CHAR(30)
+60 ;
+61 SET FDT=$$GET1^DIQ(90507.5,DFN_",",.03,"I")
+62 SET TDT=$$GET1^DIQ(90507.5,DFN_",",.04,"I")
+63 SET BQIINDT=$$FMTE^BQIUL1($$GET1^DIQ(90507.5,DFN_",",.05,"I"))
+64 SET RPERIOD=$$FMTE^XLFDT(FDT,1)_"-"_$$FMTE^XLFDT(TDT,1)
+65 ;
+66 SET BQIND=0
+67 FOR
SET BQIND=$ORDER(^BQIPAT(DFN,30,BQIND))
IF 'BQIND
QUIT
Begin DoDot:1
+68 SET BQMEAS=$PIECE(^BQIPAT(DFN,30,BQIND,0),U,1)
SET VALUE=$PIECE(^(0),U,2)
SET NUM=$PIECE(^(0),U,3)
SET DEN=$PIECE(^(0),U,4)
+69 SET GPCODE=BQMEAS
SET GPMEAS=$PIECE(BQMEAS,"_",2)
+70 SET GPIEN=$ORDER(^BQI(90506.1,"B",BQMEAS,""))
+71 IF $PIECE(^BQI(90506.1,GPIEN,0),"^",10)=1
QUIT
+72 SET TITLE=$PIECE(^BQI(90506.1,GPIEN,0),U,3)
+73 ;
+74 IF VER>7.0
Begin DoDot:2
+75 SET NAFLG=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1704,"I")
+76 SET NAFLG=$SELECT(NAFLG="Y":1,1:0)
End DoDot:2
+77 ;
+78 IF VER<8.0
Begin DoDot:2
+79 SET PIND=$ORDER(^BQI(90508,BQIH,20,BQIYR,20,"B",GPMEAS,""))
+80 SET NAFLG=+$PIECE(^BQI(90508,BQIH,20,BQIYR,20,PIND,0),U,4)
+81 SET ORDER=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1406,"E")
SET SUM="NA"
+82 IF ORDER=""
SET ORDER=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1506,"E")
SET SUM="NN"
End DoDot:2
+83 ;
+84 SET TWTEN=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1403,"E")
+85 IF TWTEN=""
SET TWTEN=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1503,"E")
+86 SET CURR=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1402,"E")
+87 IF CURR=""
SET CURR=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1502,"E")
+88 SET CURR=$$STRIP^XLFSTR(CURR," @#&!")
+89 ;
+90 SET CAT=$$GET1^DIQ(90506.1,GPIEN_",",3.03,"E")
+91 SET CLIN=$$GET1^DIQ(90506.1,GPIEN_",",3.02,"E")
+92 SET IPC=$$GET1^DIQ(BQIMEASF,GPMEAS_",",1707,"I")
+93 IF IPC=1
IF $$CIPC^BQIIPCUT(GPCODE)
Begin DoDot:2
+94 SET CAT="IPC"
SET CLIN=$$CLIN^BQIIPCUT(GPCODE)
+95 IF CLIN=""
SET CLIN=$$GET1^DIQ(90506.1,GPIEN_",",3.02,"E")
End DoDot:2
+96 ;
+97 IF '+DEN&('NAFLG)
QUIT
+98 SET STATUS=$SELECT(NUM>0&(NAFLG):NUM,NUM<1&(NAFLG):0,NUM>0:"YES",1:"NO")
+99 IF VER<8.0
Begin DoDot:2
+100 SET @TMGLB@(CAT,CLIN,TITLE,GPIEN)=STATUS_"^"_CAT_"^"_CLIN_"^"_BQMEAS_"^"_GPIEN_"^"_TITLE_"^"_$PIECE(VALUE,"|||",2)
End DoDot:2
+101 IF VER>7.0
Begin DoDot:2
+102 SET @TMGLB@(CAT,CLIN,TITLE,GPIEN)=STATUS_"^"_CAT_"^"_CLIN_"^"_BQMEAS_"^"_GPIEN_"^"_TITLE_"^"_$PIECE(VALUE,"|||",2)
End DoDot:2
End DoDot:1
+103 ;
+104 SET CAT=""
+105 FOR
SET CAT=$ORDER(@TMGLB@(CAT))
IF CAT=""
QUIT
Begin DoDot:1
+106 SET CLN=""
+107 FOR
SET CLN=$ORDER(@TMGLB@(CAT,CLN))
IF CLN=""
QUIT
Begin DoDot:2
+108 SET TIT=""
+109 FOR
SET TIT=$ORDER(@TMGLB@(CAT,CLN,TIT))
IF TIT=""
QUIT
Begin DoDot:3
+110 SET ORN=""
+111 FOR
SET ORN=$ORDER(@TMGLB@(CAT,CLN,TIT,ORN))
IF ORN=""
QUIT
Begin DoDot:4
+112 SET II=II+1
SET @DATA@(II)=RPERIOD_"^"_BQIINDT_"^"_@TMGLB@(CAT,CLN,TIT,ORN)_$CHAR(30)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+113 ;
+114 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+115 QUIT
