BQIGPRA5 ;VNGT/HS/ALA-GPRA Aggregate Call ; 24 Oct 2005 1:11 PM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
Q
;
AGG(DATA,DIV,COMM) ; EP -- BQI GET GPRA AGG TOTAL
NEW UID,II,BQI,TDATA
S DIV=$G(DIV,""),COMM=$G(COMM,"")
S II=0,BQI=0
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
I DIV="",COMM="" S TDATA=$NA(^XTMP("BQIGPTOT")),DATA=$NA(^TMP("BQIGTOT",UID))
I DIV="",COMM'="" S TDATA=$NA(^XTMP("BQIGPCOM",COMM)),DATA=$NA(^TMP("BQIGTOT",UID))
I DIV'="" S TDATA=$NA(^XTMP("BQIGPDIV",DIV)),DATA=$NA(^TMP("BQIGTOT",UID))
K @DATA
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
I $G(@TDATA@(II))="" D
. S @DATA@(BQI)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
. S @DATA@(BQI)=@DATA@(BQI)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^I00010DENOMINATOR^"
. S @DATA@(BQI)=@DATA@(BQI)_"N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$C(30)
. S BQI=BQI+1
F S II=$O(@TDATA@(II)) Q:'II S @DATA@(BQI)=@TDATA@(II),BQI=BQI+1
;
DONE ;
S BQI=BQI+1,@DATA@(BQI)=$C(31)
Q
;
COML(DATA,FAKE) ;EP - BQI GET GPRA COMM LIST
NEW UID,II,BQI,TDATA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIGPC",UID)) K @DATA
S TDATA=$NA(^XTMP("BQIGPCOM"))
S II=0,BQI=0,HDR="I00010IEN^T00050COMMUNITY"
S @DATA@(II)=HDR_$C(30)
F S BQI=$O(@TDATA@(BQI)) Q:'BQI D
. S II=II+1,@DATA@(II)=BQI_U_$P(^AUTTCOM(BQI,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
COMP ;EP - Compile the CRS Aggregate for entire database
NEW UID,II,PLID,DFN,TOTP,BQIIND,BQICAT,MDESC,TWTEN,NCURR,NUM,DEN
NEW TITLE,ORDER,CAT,BQIYR,FDT,TDT,RPERIOD,BQIMEASF,BQIND,BQMEAS,BQIEN
NEW SUM,PER,VALUE,X,TDATA,YCURR,CLIN,BQICLN,MSIEN,PIND,YEAR,BQIY,BQIH
NEW BQIINDF,BQIINDG,BQIMEASG,NAFLG,TPERIOD,BMEAS,GDATA,GNUM,GDEN,TIT
NEW EXCEPT,GOAL,HDR,DIV,BQDV,DATA,DDATA,DDDATA,TDATA,VDATA,UDATA,IPC
S DFN=0,II=0
;S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S UID=$J
S DATA=$NA(^XTMP("BQIGPTOT")),TDATA=$NA(^TMP("BQIGTOT",UID))
S DDATA=$NA(^XTMP("BQIGPDIV")),VDATA=$NA(^TMP("BQIGDIV",UID))
S DDDATA=$NA(^XTMP("BQIGPCOM")),UDATA=$NA(^TMP("BQIGPCOM",UID))
K @DATA,@TDATA,@DDATA,@VDATA,@DDDATA,@UDATA
S @DATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate"
S @DDATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate by Division"
S @DDDATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate by Community"
S II=II+1
;
S @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
S @DATA@(II)=@DATA@(II)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^I00010DENOMINATOR^"
S @DATA@(II)=@DATA@(II)_"N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$C(30)
S HDR=@DATA@(II)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S YEAR=$$GET1^DIQ(90508,1_",",2,"E")
S BQIY=$$LKP^BQIGPUTL(YEAR)
D GFN^BQIGPUTL(BQIH,BQIY)
S BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
S BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
S VER=$$VERSION^XPDUTL("BGP")
;
S MSIEN=""
F S MSIEN=$O(^BQI(90506.1,"AC","G",MSIEN)) Q:MSIEN="" D
. I $P(^BQI(90506.1,MSIEN,0),U,10)=1 Q
. D INIT(.VER,.MSIEN)
;
S DFN=0,TOTP=0
F S DFN=$O(^BQIPAT(DFN)) Q:'DFN D RPT(.VER)
;
S CAT=""
F S CAT=$O(@TDATA@(CAT)) Q:CAT="" D
. S CLIN=""
. F S CLIN=$O(@TDATA@(CAT,CLIN)) Q:CLIN="" D
.. S TIT=""
.. F S TIT=$O(@TDATA@(CAT,CLIN,TIT)) Q:TIT="" D
... S BQIEN=""
... F S BQIEN=$O(@TDATA@(CAT,CLIN,TIT,BQIEN)) Q:BQIEN="" D
.... S GDATA=@TDATA@(CAT,CLIN,TIT,BQIEN)
.... S GNUM=$G(@TDATA@(CAT,CLIN,TIT,BQIEN,"NUM"))
.... S GDEN=$G(@TDATA@(CAT,CLIN,TIT,BQIEN,"DEN"))
.... D DEF(GDATA,GNUM,GDEN)
;
K @TDATA
;
S DIV=""
F S DIV=$O(@VDATA@(DIV)) Q:DIV="" D
. S TOTP=0,DFN=""
. F S DFN=$O(@VDATA@("TOTP",DIV,DFN)) Q:DFN="" S TOTP=TOTP+1
. K @VDATA@("TOTP",DIV)
. S CAT="",II=1,@VDATA@(DIV,II)=HDR
. F S CAT=$O(@VDATA@(DIV,CAT)) Q:CAT="" D
.. S CLIN=""
.. F S CLIN=$O(@VDATA@(DIV,CAT,CLIN)) Q:CLIN="" D
... S TIT=""
... F S TIT=$O(@VDATA@(DIV,CAT,CLIN,TIT)) Q:TIT="" D
.... S BQIEN=""
.... F S BQIEN=$O(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN)) Q:BQIEN="" D
..... S GDATA=@VDATA@(DIV,CAT,CLIN,TIT,BQIEN)
..... S GNUM=$G(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN,"NUM"))
..... S GDEN=$G(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN,"DEN"))
..... D DDEF(GDATA,GNUM,GDEN,DIV)
;
K @VDATA
;
S COMM=""
F S COMM=$O(@UDATA@(COMM)) Q:COMM="" D
. S TOTP=0,DFN=""
. F S DFN=$O(@UDATA@("TOTP",COMM,DFN)) Q:DFN="" S TOTP=TOTP+1
. K @UDATA@("TOTP",COMM)
. S CAT="",II=1,@UDATA@(COMM,II)=HDR
. F S CAT=$O(@UDATA@(COMM,CAT)) Q:CAT="" D
.. S CLIN=""
.. F S CLIN=$O(@UDATA@(COMM,CAT,CLIN)) Q:CLIN="" D
... S TIT=""
... F S TIT=$O(@UDATA@(COMM,CAT,CLIN,TIT)) Q:TIT="" D
.... S BQIEN=""
.... F S BQIEN=$O(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN)) Q:BQIEN="" D
..... S GDATA=@UDATA@(COMM,CAT,CLIN,TIT,BQIEN)
..... S GNUM=$G(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN,"NUM"))
..... S GDEN=$G(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN,"DEN"))
..... D DDDEF(GDATA,GNUM,GDEN,COMM)
Q
;
DEF(GDATA,GNUM,GDEN) ;EP
S BQICAT=$P(GDATA,"^",1)
S BQICLN=$P(GDATA,"^",2)
S BQMEAS=$P(GDATA,"^",3)
S MDESC=$P(GDATA,"^",4)
;S TWTEN=$P(GDATA,"^",5)
S NCURR=$P(GDATA,"^",5)
S YCURR=$P(GDATA,"^",6)
S RPERIOD=$P(GDATA,"^",7) S:RPERIOD="" RPERIOD=$G(TPERIOD)
S NAFLG=$P(GDATA,"^",9)
S GOAL=$P(GDATA,"^",10)
;
S NUM=+$G(GNUM)
S DEN=+$G(GDEN)
I DEN=0 S PER=-1
I NUM=0,DEN'=0 S PER=0
;I NUM=0,DEN=0 S PER=0
I NUM=0,DEN=0 S PER=-1
I NAFLG=1,PER=0 S PER=-1
I NUM'=0,DEN'=0 S PER=(NUM/DEN)*100,PER=$J(PER,3,1)
I NAFLG=1 S DEN="-"
S EXCEPT=$S(NAFLG=1:"Y",1:"N")
S II=II+1,@DATA@(II)=RPERIOD_U_TOTP_U_BQICAT_U_BQICLN_U_BQMEAS_U_NCURR_U_YCURR_U_MDESC_U_NUM_U_DEN_U_PER_U_EXCEPT_U_GOAL_$C(30)
Q
;
DDEF(GDATA,GNUM,GDEN,GDIV) ;
S BQICAT=$P(GDATA,"^",1)
S BQICLN=$P(GDATA,"^",2)
S BQMEAS=$P(GDATA,"^",3)
S MDESC=$P(GDATA,"^",4)
;S TWTEN=$P(GDATA,"^",5)
S NCURR=$P(GDATA,"^",5)
S YCURR=$P(GDATA,"^",6)
S RPERIOD=$P(GDATA,"^",7) S:RPERIOD="" RPERIOD=$G(TPERIOD)
S NAFLG=$P(GDATA,"^",9)
S GOAL=$P(GDATA,"^",10)
;
S NUM=+$G(GNUM)
S DEN=+$G(GDEN)
I DEN=0 S PER=-1
I NUM=0,DEN'=0 S PER=0
;I NUM=0,DEN=0 S PER=0
I NUM=0,DEN=0 S PER=-1
I NAFLG=1,PER=0 S PER=-1
I NUM'=0,DEN'=0 S PER=(NUM/DEN)*100,PER=$J(PER,3,1)
I NAFLG=1 S DEN="-"
S EXCEPT=$S(NAFLG=1:"Y",1:"N")
S II=II+1,@DDATA@(GDIV,II)=RPERIOD_U_TOTP_U_BQICAT_U_BQICLN_U_BQMEAS_U_NCURR_U_YCURR_U_MDESC_U_NUM_U_DEN_U_PER_U_EXCEPT_U_GOAL_$C(30)
Q
;
DDDEF(GDATA,GNUM,GDEN,GCOMM) ;
S BQICAT=$P(GDATA,"^",1)
S BQICLN=$P(GDATA,"^",2)
S BQMEAS=$P(GDATA,"^",3)
S MDESC=$P(GDATA,"^",4)
;S TWTEN=$P(GDATA,"^",5)
S NCURR=$P(GDATA,"^",5)
S YCURR=$P(GDATA,"^",6)
S RPERIOD=$P(GDATA,"^",7) S:RPERIOD="" RPERIOD=$G(TPERIOD)
S NAFLG=$P(GDATA,"^",9)
S GOAL=$P(GDATA,"^",10)
;
S NUM=+$G(GNUM)
S DEN=+$G(GDEN)
I DEN=0 S PER=-1
I NUM=0,DEN'=0 S PER=0
;I NUM=0,DEN=0 S PER=0
I NUM=0,DEN=0 S PER=-1
I NAFLG=1,PER=0 S PER=-1
I NUM'=0,DEN'=0 S PER=(NUM/DEN)*100,PER=$J(PER,3,1)
I NAFLG=1 S DEN="-"
S EXCEPT=$S(NAFLG=1:"Y",1:"N")
S II=II+1,@DDDATA@(GCOMM,II)=RPERIOD_U_TOTP_U_BQICAT_U_BQICLN_U_BQMEAS_U_NCURR_U_YCURR_U_MDESC_U_NUM_U_DEN_U_PER_U_EXCEPT_U_GOAL_$C(30)
Q
;
RPT(VER) ; Get the CRS Clinical Performance information
NEW BQIND,BQMEAS,VALUE,NUM,DEN,MSIEN,TITLE,CAT,CLIN,BMEAS,BQIYR,FDT,TDT,RPERIOD,SUM
NEW BQDV,BQCOMM
S BQIND=0
I $O(^BQIPAT(DFN,30,BQIND))'="" S TOTP=TOTP+1
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 MSIEN=$O(^BQI(90506.1,"B",BQMEAS,"")) I MSIEN="" Q
. I $P(^BQI(90506.1,MSIEN,0),U,10)=1 Q
. S TITLE=$P(^BQI(90506.1,MSIEN,0),U,3)
. S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
. S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
. S BMEAS=$P(BQMEAS,"_",2)
. ;
. S BQIYR=$P($G(^BQIPAT(DFN,0)),U,2)
. S FDT=$P($G(^BQIPAT(DFN,0)),U,3),TDT=$P($G(^BQIPAT(DFN,0)),U,4)
. S RPERIOD=$$FMTE^XLFDT(FDT,1)_"-"_$$FMTE^XLFDT(TDT,1)
. ;
. S SUM=$$GET1^DIQ(BQIMEASF,BMEAS_",",1706,"I")
. S IPC=$$GET1^DIQ(BQIMEASF,BMEAS_",",1707,"I")
. I IPC=1,$$CIPC^BQIIPCUT(BQCODE) D
.. S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(BQCODE)
.. I CLIN="" S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
. I '$D(@TDATA@(CAT,CLIN,TITLE,MSIEN)) D INIT(VER,MSIEN)
. S @TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM")=$G(@TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
. S @TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN")=$G(@TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
. S $P(@TDATA@(CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD S:RPERIOD'="" TPERIOD=RPERIOD
. S BQDV=0
. F S BQDV=$O(^AUPNPAT(DFN,41,BQDV)) Q:'BQDV D
.. I $P($G(^AUPNPAT(DFN,41,BQDV,0)),U,3)'="" Q
.. I '$D(^BQI(90508,1,25,"B",BQDV)) Q
.. S @VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"NUM")=$G(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
.. S @VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"DEN")=$G(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
.. S @VDATA@("TOTP",BQDV,DFN)=""
.. S $P(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD S:RPERIOD'="" TPERIOD=RPERIOD
. S BQCOMM=$P($G(^AUPNPAT(DFN,11)),U,17) I BQCOMM="" Q
. S @UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"NUM")=$G(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
. S @UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"DEN")=$G(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
. S @UDATA@("TOTP",BQCOMM,DFN)=""
. S $P(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD S:RPERIOD'="" TPERIOD=RPERIOD
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
INIT(VER,MSIEN) ; Initialize array
S BQMEAS=$P(^BQI(90506.1,MSIEN,0),U,1),TITLE=$P(^(0),U,3)
S BQCODE=BQMEAS,BQMEAS=$P(BQMEAS,"_",2)
;
S ORDER=TITLE
S NAFLG=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
S NAFLG=$S(NAFLG="Y":1,1:0)
S SUM=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1706,"I")
S IPC=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1707,"I")
;
S TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
I TWTEN="" S TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1503,"E")
S NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1402,"E")
I NCURR="" S NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1502,"E")
S NCURR=$$STRIP^XLFSTR(NCURR," @#&!")
S YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1408,"E")
I YCURR="" S YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1508,"E")
;
S GOAL=""
I $$VERSION^XPDUTL("BGP")>11 D
. S GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
. I GOAL="" S GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1903,"E")
;
S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
I IPC=1,$$CIPC^BQIIPCUT(BQCODE) D
. S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(BQCODE)
. I CLIN="" S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
;
S RPERIOD="",VALUE="",IPC=""
;
S @TDATA@(CAT,CLIN,TITLE,MSIEN)=CAT_U_CLIN_U_MSIEN_U_TITLE_U_NCURR_U_YCURR_U_RPERIOD_U_VALUE_U_NAFLG_U_GOAL
S DIV=""
F S DIV=$O(^BQI(90508,1,25,"B",DIV)) Q:DIV="" S @VDATA@(DIV,CAT,CLIN,TITLE,MSIEN)=CAT_U_CLIN_U_MSIEN_U_TITLE_U_NCURR_U_YCURR_U_RPERIOD_U_VALUE_U_NAFLG_U_GOAL
NEW COMM,DFN,CIEN
S COMM=""
F S COMM=$O(^AUPNPAT("AC",COMM)) Q:COMM="" D
. S DFN=""
. F S DFN=$O(^AUPNPAT("AC",COMM,DFN)) Q:DFN="" D
.. S CIEN=$P($G(^AUPNPAT(DFN,11)),"^",17) I CIEN="" Q
.. S @UDATA@(CIEN,CAT,CLIN,TITLE,MSIEN)=CAT_U_CLIN_U_MSIEN_U_TITLE_U_NCURR_U_YCURR_U_RPERIOD_U_VALUE_U_NAFLG_U_GOAL
Q
BQIGPRA5 ;VNGT/HS/ALA-GPRA Aggregate Call ; 24 Oct 2005 1:11 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
+3 QUIT
+4 ;
AGG(DATA,DIV,COMM) ; EP -- BQI GET GPRA AGG TOTAL
+1 NEW UID,II,BQI,TDATA
+2 SET DIV=$GET(DIV,"")
SET COMM=$GET(COMM,"")
+3 SET II=0
SET BQI=0
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 IF DIV=""
IF COMM=""
SET TDATA=$NAME(^XTMP("BQIGPTOT"))
SET DATA=$NAME(^TMP("BQIGTOT",UID))
+6 IF DIV=""
IF COMM'=""
SET TDATA=$NAME(^XTMP("BQIGPCOM",COMM))
SET DATA=$NAME(^TMP("BQIGTOT",UID))
+7 IF DIV'=""
SET TDATA=$NAME(^XTMP("BQIGPDIV",DIV))
SET DATA=$NAME(^TMP("BQIGTOT",UID))
+8 KILL @DATA
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER"
+10 IF $GET(@TDATA@(II))=""
Begin DoDot:1
+11 SET @DATA@(BQI)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
+12 SET @DATA@(BQI)=@DATA@(BQI)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^I00010DENOMINATOR^"
+13 SET @DATA@(BQI)=@DATA@(BQI)_"N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$CHAR(30)
+14 SET BQI=BQI+1
End DoDot:1
+15 FOR
SET II=$ORDER(@TDATA@(II))
IF 'II
QUIT
SET @DATA@(BQI)=@TDATA@(II)
SET BQI=BQI+1
+16 ;
DONE ;
+1 SET BQI=BQI+1
SET @DATA@(BQI)=$CHAR(31)
+2 QUIT
+3 ;
COML(DATA,FAKE) ;EP - BQI GET GPRA COMM LIST
+1 NEW UID,II,BQI,TDATA
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIGPC",UID))
KILL @DATA
+4 SET TDATA=$NAME(^XTMP("BQIGPCOM"))
+5 SET II=0
SET BQI=0
SET HDR="I00010IEN^T00050COMMUNITY"
+6 SET @DATA@(II)=HDR_$CHAR(30)
+7 FOR
SET BQI=$ORDER(@TDATA@(BQI))
IF 'BQI
QUIT
Begin DoDot:1
+8 SET II=II+1
SET @DATA@(II)=BQI_U_$PIECE(^AUTTCOM(BQI,0),U,1)_$CHAR(30)
End DoDot:1
+9 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+10 QUIT
+11 ;
COMP ;EP - Compile the CRS Aggregate for entire database
+1 NEW UID,II,PLID,DFN,TOTP,BQIIND,BQICAT,MDESC,TWTEN,NCURR,NUM,DEN
+2 NEW TITLE,ORDER,CAT,BQIYR,FDT,TDT,RPERIOD,BQIMEASF,BQIND,BQMEAS,BQIEN
+3 NEW SUM,PER,VALUE,X,TDATA,YCURR,CLIN,BQICLN,MSIEN,PIND,YEAR,BQIY,BQIH
+4 NEW BQIINDF,BQIINDG,BQIMEASG,NAFLG,TPERIOD,BMEAS,GDATA,GNUM,GDEN,TIT
+5 NEW EXCEPT,GOAL,HDR,DIV,BQDV,DATA,DDATA,DDDATA,TDATA,VDATA,UDATA,IPC
+6 SET DFN=0
SET II=0
+7 ;S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
+8 SET UID=$JOB
+9 SET DATA=$NAME(^XTMP("BQIGPTOT"))
SET TDATA=$NAME(^TMP("BQIGTOT",UID))
+10 SET DDATA=$NAME(^XTMP("BQIGPDIV"))
SET VDATA=$NAME(^TMP("BQIGDIV",UID))
+11 SET DDDATA=$NAME(^XTMP("BQIGPCOM"))
SET UDATA=$NAME(^TMP("BQIGPCOM",UID))
+12 KILL @DATA,@TDATA,@DDATA,@VDATA,@DDDATA,@UDATA
+13 SET @DATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate"
+14 SET @DDATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate by Division"
+15 SET @DDDATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate by Community"
+16 SET II=II+1
+17 ;
+18 SET @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
+19 SET @DATA@(II)=@DATA@(II)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^I00010DENOMINATOR^"
+20 SET @DATA@(II)=@DATA@(II)_"N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$CHAR(30)
+21 SET HDR=@DATA@(II)
+22 ;
+23 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER"
+24 SET YEAR=$$GET1^DIQ(90508,1_",",2,"E")
+25 SET BQIY=$$LKP^BQIGPUTL(YEAR)
+26 DO GFN^BQIGPUTL(BQIH,BQIY)
+27 SET BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
+28 SET BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
+29 SET VER=$$VERSION^XPDUTL("BGP")
+30 ;
+31 SET MSIEN=""
+32 FOR
SET MSIEN=$ORDER(^BQI(90506.1,"AC","G",MSIEN))
IF MSIEN=""
QUIT
Begin DoDot:1
+33 IF $PIECE(^BQI(90506.1,MSIEN,0),U,10)=1
QUIT
+34 DO INIT(.VER,.MSIEN)
End DoDot:1
+35 ;
+36 SET DFN=0
SET TOTP=0
+37 FOR
SET DFN=$ORDER(^BQIPAT(DFN))
IF 'DFN
QUIT
DO RPT(.VER)
+38 ;
+39 SET CAT=""
+40 FOR
SET CAT=$ORDER(@TDATA@(CAT))
IF CAT=""
QUIT
Begin DoDot:1
+41 SET CLIN=""
+42 FOR
SET CLIN=$ORDER(@TDATA@(CAT,CLIN))
IF CLIN=""
QUIT
Begin DoDot:2
+43 SET TIT=""
+44 FOR
SET TIT=$ORDER(@TDATA@(CAT,CLIN,TIT))
IF TIT=""
QUIT
Begin DoDot:3
+45 SET BQIEN=""
+46 FOR
SET BQIEN=$ORDER(@TDATA@(CAT,CLIN,TIT,BQIEN))
IF BQIEN=""
QUIT
Begin DoDot:4
+47 SET GDATA=@TDATA@(CAT,CLIN,TIT,BQIEN)
+48 SET GNUM=$GET(@TDATA@(CAT,CLIN,TIT,BQIEN,"NUM"))
+49 SET GDEN=$GET(@TDATA@(CAT,CLIN,TIT,BQIEN,"DEN"))
+50 DO DEF(GDATA,GNUM,GDEN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 KILL @TDATA
+53 ;
+54 SET DIV=""
+55 FOR
SET DIV=$ORDER(@VDATA@(DIV))
IF DIV=""
QUIT
Begin DoDot:1
+56 SET TOTP=0
SET DFN=""
+57 FOR
SET DFN=$ORDER(@VDATA@("TOTP",DIV,DFN))
IF DFN=""
QUIT
SET TOTP=TOTP+1
+58 KILL @VDATA@("TOTP",DIV)
+59 SET CAT=""
SET II=1
SET @VDATA@(DIV,II)=HDR
+60 FOR
SET CAT=$ORDER(@VDATA@(DIV,CAT))
IF CAT=""
QUIT
Begin DoDot:2
+61 SET CLIN=""
+62 FOR
SET CLIN=$ORDER(@VDATA@(DIV,CAT,CLIN))
IF CLIN=""
QUIT
Begin DoDot:3
+63 SET TIT=""
+64 FOR
SET TIT=$ORDER(@VDATA@(DIV,CAT,CLIN,TIT))
IF TIT=""
QUIT
Begin DoDot:4
+65 SET BQIEN=""
+66 FOR
SET BQIEN=$ORDER(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN))
IF BQIEN=""
QUIT
Begin DoDot:5
+67 SET GDATA=@VDATA@(DIV,CAT,CLIN,TIT,BQIEN)
+68 SET GNUM=$GET(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN,"NUM"))
+69 SET GDEN=$GET(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN,"DEN"))
+70 DO DDEF(GDATA,GNUM,GDEN,DIV)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+71 ;
+72 KILL @VDATA
+73 ;
+74 SET COMM=""
+75 FOR
SET COMM=$ORDER(@UDATA@(COMM))
IF COMM=""
QUIT
Begin DoDot:1
+76 SET TOTP=0
SET DFN=""
+77 FOR
SET DFN=$ORDER(@UDATA@("TOTP",COMM,DFN))
IF DFN=""
QUIT
SET TOTP=TOTP+1
+78 KILL @UDATA@("TOTP",COMM)
+79 SET CAT=""
SET II=1
SET @UDATA@(COMM,II)=HDR
+80 FOR
SET CAT=$ORDER(@UDATA@(COMM,CAT))
IF CAT=""
QUIT
Begin DoDot:2
+81 SET CLIN=""
+82 FOR
SET CLIN=$ORDER(@UDATA@(COMM,CAT,CLIN))
IF CLIN=""
QUIT
Begin DoDot:3
+83 SET TIT=""
+84 FOR
SET TIT=$ORDER(@UDATA@(COMM,CAT,CLIN,TIT))
IF TIT=""
QUIT
Begin DoDot:4
+85 SET BQIEN=""
+86 FOR
SET BQIEN=$ORDER(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN))
IF BQIEN=""
QUIT
Begin DoDot:5
+87 SET GDATA=@UDATA@(COMM,CAT,CLIN,TIT,BQIEN)
+88 SET GNUM=$GET(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN,"NUM"))
+89 SET GDEN=$GET(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN,"DEN"))
+90 DO DDDEF(GDATA,GNUM,GDEN,COMM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+91 QUIT
+92 ;
DEF(GDATA,GNUM,GDEN) ;EP
+1 SET BQICAT=$PIECE(GDATA,"^",1)
+2 SET BQICLN=$PIECE(GDATA,"^",2)
+3 SET BQMEAS=$PIECE(GDATA,"^",3)
+4 SET MDESC=$PIECE(GDATA,"^",4)
+5 ;S TWTEN=$P(GDATA,"^",5)
+6 SET NCURR=$PIECE(GDATA,"^",5)
+7 SET YCURR=$PIECE(GDATA,"^",6)
+8 SET RPERIOD=$PIECE(GDATA,"^",7)
IF RPERIOD=""
SET RPERIOD=$GET(TPERIOD)
+9 SET NAFLG=$PIECE(GDATA,"^",9)
+10 SET GOAL=$PIECE(GDATA,"^",10)
+11 ;
+12 SET NUM=+$GET(GNUM)
+13 SET DEN=+$GET(GDEN)
+14 IF DEN=0
SET PER=-1
+15 IF NUM=0
IF DEN'=0
SET PER=0
+16 ;I NUM=0,DEN=0 S PER=0
+17 IF NUM=0
IF DEN=0
SET PER=-1
+18 IF NAFLG=1
IF PER=0
SET PER=-1
+19 IF NUM'=0
IF DEN'=0
SET PER=(NUM/DEN)*100
SET PER=$JUSTIFY(PER,3,1)
+20 IF NAFLG=1
SET DEN="-"
+21 SET EXCEPT=$SELECT(NAFLG=1:"Y",1:"N")
+22 SET II=II+1
SET @DATA@(II)=RPERIOD_U_TOTP_U_BQICAT_U_BQICLN_U_BQMEAS_U_NCURR_U_YCURR_U_MDESC_U_NUM_U_DEN_U_PER_U_EXCEPT_U_GOAL_$CHAR(30)
+23 QUIT
+24 ;
DDEF(GDATA,GNUM,GDEN,GDIV) ;
+1 SET BQICAT=$PIECE(GDATA,"^",1)
+2 SET BQICLN=$PIECE(GDATA,"^",2)
+3 SET BQMEAS=$PIECE(GDATA,"^",3)
+4 SET MDESC=$PIECE(GDATA,"^",4)
+5 ;S TWTEN=$P(GDATA,"^",5)
+6 SET NCURR=$PIECE(GDATA,"^",5)
+7 SET YCURR=$PIECE(GDATA,"^",6)
+8 SET RPERIOD=$PIECE(GDATA,"^",7)
IF RPERIOD=""
SET RPERIOD=$GET(TPERIOD)
+9 SET NAFLG=$PIECE(GDATA,"^",9)
+10 SET GOAL=$PIECE(GDATA,"^",10)
+11 ;
+12 SET NUM=+$GET(GNUM)
+13 SET DEN=+$GET(GDEN)
+14 IF DEN=0
SET PER=-1
+15 IF NUM=0
IF DEN'=0
SET PER=0
+16 ;I NUM=0,DEN=0 S PER=0
+17 IF NUM=0
IF DEN=0
SET PER=-1
+18 IF NAFLG=1
IF PER=0
SET PER=-1
+19 IF NUM'=0
IF DEN'=0
SET PER=(NUM/DEN)*100
SET PER=$JUSTIFY(PER,3,1)
+20 IF NAFLG=1
SET DEN="-"
+21 SET EXCEPT=$SELECT(NAFLG=1:"Y",1:"N")
+22 SET II=II+1
SET @DDATA@(GDIV,II)=RPERIOD_U_TOTP_U_BQICAT_U_BQICLN_U_BQMEAS_U_NCURR_U_YCURR_U_MDESC_U_NUM_U_DEN_U_PER_U_EXCEPT_U_GOAL_$CHAR(30)
+23 QUIT
+24 ;
DDDEF(GDATA,GNUM,GDEN,GCOMM) ;
+1 SET BQICAT=$PIECE(GDATA,"^",1)
+2 SET BQICLN=$PIECE(GDATA,"^",2)
+3 SET BQMEAS=$PIECE(GDATA,"^",3)
+4 SET MDESC=$PIECE(GDATA,"^",4)
+5 ;S TWTEN=$P(GDATA,"^",5)
+6 SET NCURR=$PIECE(GDATA,"^",5)
+7 SET YCURR=$PIECE(GDATA,"^",6)
+8 SET RPERIOD=$PIECE(GDATA,"^",7)
IF RPERIOD=""
SET RPERIOD=$GET(TPERIOD)
+9 SET NAFLG=$PIECE(GDATA,"^",9)
+10 SET GOAL=$PIECE(GDATA,"^",10)
+11 ;
+12 SET NUM=+$GET(GNUM)
+13 SET DEN=+$GET(GDEN)
+14 IF DEN=0
SET PER=-1
+15 IF NUM=0
IF DEN'=0
SET PER=0
+16 ;I NUM=0,DEN=0 S PER=0
+17 IF NUM=0
IF DEN=0
SET PER=-1
+18 IF NAFLG=1
IF PER=0
SET PER=-1
+19 IF NUM'=0
IF DEN'=0
SET PER=(NUM/DEN)*100
SET PER=$JUSTIFY(PER,3,1)
+20 IF NAFLG=1
SET DEN="-"
+21 SET EXCEPT=$SELECT(NAFLG=1:"Y",1:"N")
+22 SET II=II+1
SET @DDDATA@(GCOMM,II)=RPERIOD_U_TOTP_U_BQICAT_U_BQICLN_U_BQMEAS_U_NCURR_U_YCURR_U_MDESC_U_NUM_U_DEN_U_PER_U_EXCEPT_U_GOAL_$CHAR(30)
+23 QUIT
+24 ;
RPT(VER) ; Get the CRS Clinical Performance information
+1 NEW BQIND,BQMEAS,VALUE,NUM,DEN,MSIEN,TITLE,CAT,CLIN,BMEAS,BQIYR,FDT,TDT,RPERIOD,SUM
+2 NEW BQDV,BQCOMM
+3 SET BQIND=0
+4 IF $ORDER(^BQIPAT(DFN,30,BQIND))'=""
SET TOTP=TOTP+1
+5 FOR
SET BQIND=$ORDER(^BQIPAT(DFN,30,BQIND))
IF 'BQIND
QUIT
Begin DoDot:1
+6 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)
+7 SET MSIEN=$ORDER(^BQI(90506.1,"B",BQMEAS,""))
IF MSIEN=""
QUIT
+8 IF $PIECE(^BQI(90506.1,MSIEN,0),U,10)=1
QUIT
+9 SET TITLE=$PIECE(^BQI(90506.1,MSIEN,0),U,3)
+10 SET CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
+11 SET CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
+12 SET BMEAS=$PIECE(BQMEAS,"_",2)
+13 ;
+14 SET BQIYR=$PIECE($GET(^BQIPAT(DFN,0)),U,2)
+15 SET FDT=$PIECE($GET(^BQIPAT(DFN,0)),U,3)
SET TDT=$PIECE($GET(^BQIPAT(DFN,0)),U,4)
+16 SET RPERIOD=$$FMTE^XLFDT(FDT,1)_"-"_$$FMTE^XLFDT(TDT,1)
+17 ;
+18 SET SUM=$$GET1^DIQ(BQIMEASF,BMEAS_",",1706,"I")
+19 SET IPC=$$GET1^DIQ(BQIMEASF,BMEAS_",",1707,"I")
+20 IF IPC=1
IF $$CIPC^BQIIPCUT(BQCODE)
Begin DoDot:2
+21 SET CAT="IPC"
SET CLIN=$$CLIN^BQIIPCUT(BQCODE)
+22 IF CLIN=""
SET CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
End DoDot:2
+23 IF '$DATA(@TDATA@(CAT,CLIN,TITLE,MSIEN))
DO INIT(VER,MSIEN)
+24 SET @TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM")=$GET(@TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
+25 SET @TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN")=$GET(@TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
+26 SET $PIECE(@TDATA@(CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD
IF RPERIOD'=""
SET TPERIOD=RPERIOD
+27 SET BQDV=0
+28 FOR
SET BQDV=$ORDER(^AUPNPAT(DFN,41,BQDV))
IF 'BQDV
QUIT
Begin DoDot:2
+29 IF $PIECE($GET(^AUPNPAT(DFN,41,BQDV,0)),U,3)'=""
QUIT
+30 IF '$DATA(^BQI(90508,1,25,"B",BQDV))
QUIT
+31 SET @VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"NUM")=$GET(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
+32 SET @VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"DEN")=$GET(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
+33 SET @VDATA@("TOTP",BQDV,DFN)=""
+34 SET $PIECE(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD
IF RPERIOD'=""
SET TPERIOD=RPERIOD
End DoDot:2
+35 SET BQCOMM=$PIECE($GET(^AUPNPAT(DFN,11)),U,17)
IF BQCOMM=""
QUIT
+36 SET @UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"NUM")=$GET(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
+37 SET @UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"DEN")=$GET(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
+38 SET @UDATA@("TOTP",BQCOMM,DFN)=""
+39 SET $PIECE(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD
IF RPERIOD'=""
SET TPERIOD=RPERIOD
End DoDot:1
+40 QUIT
+41 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
INIT(VER,MSIEN) ; Initialize array
+1 SET BQMEAS=$PIECE(^BQI(90506.1,MSIEN,0),U,1)
SET TITLE=$PIECE(^(0),U,3)
+2 SET BQCODE=BQMEAS
SET BQMEAS=$PIECE(BQMEAS,"_",2)
+3 ;
+4 SET ORDER=TITLE
+5 SET NAFLG=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
+6 SET NAFLG=$SELECT(NAFLG="Y":1,1:0)
+7 SET SUM=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1706,"I")
+8 SET IPC=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1707,"I")
+9 ;
+10 SET TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
+11 IF TWTEN=""
SET TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1503,"E")
+12 SET NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1402,"E")
+13 IF NCURR=""
SET NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1502,"E")
+14 SET NCURR=$$STRIP^XLFSTR(NCURR," @#&!")
+15 SET YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1408,"E")
+16 IF YCURR=""
SET YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1508,"E")
+17 ;
+18 SET GOAL=""
+19 IF $$VERSION^XPDUTL("BGP")>11
Begin DoDot:1
+20 SET GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
+21 IF GOAL=""
SET GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1903,"E")
End DoDot:1
+22 ;
+23 SET CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
+24 SET CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
+25 IF IPC=1
IF $$CIPC^BQIIPCUT(BQCODE)
Begin DoDot:1
+26 SET CAT="IPC"
SET CLIN=$$CLIN^BQIIPCUT(BQCODE)
+27 IF CLIN=""
SET CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
End DoDot:1
+28 ;
+29 SET RPERIOD=""
SET VALUE=""
SET IPC=""
+30 ;
+31 SET @TDATA@(CAT,CLIN,TITLE,MSIEN)=CAT_U_CLIN_U_MSIEN_U_TITLE_U_NCURR_U_YCURR_U_RPERIOD_U_VALUE_U_NAFLG_U_GOAL
+32 SET DIV=""
+33 FOR
SET DIV=$ORDER(^BQI(90508,1,25,"B",DIV))
IF DIV=""
QUIT
SET @VDATA@(DIV,CAT,CLIN,TITLE,MSIEN)=CAT_U_CLIN_U_MSIEN_U_TITLE_U_NCURR_U_YCURR_U_RPERIOD_U_VALUE_U_NAFLG_U_GOAL
+34 NEW COMM,DFN,CIEN
+35 SET COMM=""
+36 FOR
SET COMM=$ORDER(^AUPNPAT("AC",COMM))
IF COMM=""
QUIT
Begin DoDot:1
+37 SET DFN=""
+38 FOR
SET DFN=$ORDER(^AUPNPAT("AC",COMM,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+39 SET CIEN=$PIECE($GET(^AUPNPAT(DFN,11)),"^",17)
IF CIEN=""
QUIT
+40 SET @UDATA@(CIEN,CAT,CLIN,TITLE,MSIEN)=CAT_U_CLIN_U_MSIEN_U_TITLE_U_NCURR_U_YCURR_U_RPERIOD_U_VALUE_U_NAFLG_U_GOAL
End DoDot:2
End DoDot:1
+41 QUIT
