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

BQIGPRA5.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1. AGG(DATA,DIV,COMM) ; EP -- BQI GET GPRA AGG TOTAL
  1.  NEW UID,II,BQI,TDATA
  1.  S DIV=$G(DIV,""),COMM=$G(COMM,"")
  1.  S II=0,BQI=0
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  I DIV="",COMM="" S TDATA=$NA(^XTMP("BQIGPTOT")),DATA=$NA(^TMP("BQIGTOT",UID))
  1.  I DIV="",COMM'="" S TDATA=$NA(^XTMP("BQIGPCOM",COMM)),DATA=$NA(^TMP("BQIGTOT",UID))
  1.  I DIV'="" S TDATA=$NA(^XTMP("BQIGPDIV",DIV)),DATA=$NA(^TMP("BQIGTOT",UID))
  1.  K @DATA
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  I $G(@TDATA@(II))="" D
  1.  . S @DATA@(BQI)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
  1.  . S @DATA@(BQI)=@DATA@(BQI)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^I00010DENOMINATOR^"
  1.  . S @DATA@(BQI)=@DATA@(BQI)_"N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$C(30)
  1.  . S BQI=BQI+1
  1.  F  S II=$O(@TDATA@(II)) Q:'II  S @DATA@(BQI)=@TDATA@(II),BQI=BQI+1
  1.  ;
  1. DONE ;
  1.  S BQI=BQI+1,@DATA@(BQI)=$C(31)
  1.  Q
  1.  ;
  1. COML(DATA,FAKE) ;EP - BQI GET GPRA COMM LIST
  1.  NEW UID,II,BQI,TDATA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIGPC",UID)) K @DATA
  1.  S TDATA=$NA(^XTMP("BQIGPCOM"))
  1.  S II=0,BQI=0,HDR="I00010IEN^T00050COMMUNITY"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  F  S BQI=$O(@TDATA@(BQI)) Q:'BQI  D
  1.  . S II=II+1,@DATA@(II)=BQI_U_$P(^AUTTCOM(BQI,0),U,1)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. COMP ;EP - Compile the CRS Aggregate for entire database
  1.  NEW UID,II,PLID,DFN,TOTP,BQIIND,BQICAT,MDESC,TWTEN,NCURR,NUM,DEN
  1.  NEW TITLE,ORDER,CAT,BQIYR,FDT,TDT,RPERIOD,BQIMEASF,BQIND,BQMEAS,BQIEN
  1.  NEW SUM,PER,VALUE,X,TDATA,YCURR,CLIN,BQICLN,MSIEN,PIND,YEAR,BQIY,BQIH
  1.  NEW BQIINDF,BQIINDG,BQIMEASG,NAFLG,TPERIOD,BMEAS,GDATA,GNUM,GDEN,TIT
  1.  NEW EXCEPT,GOAL,HDR,DIV,BQDV,DATA,DDATA,DDDATA,TDATA,VDATA,UDATA,IPC
  1.  S DFN=0,II=0
  1.  ;S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S UID=$J
  1.  S DATA=$NA(^XTMP("BQIGPTOT")),TDATA=$NA(^TMP("BQIGTOT",UID))
  1.  S DDATA=$NA(^XTMP("BQIGPDIV")),VDATA=$NA(^TMP("BQIGDIV",UID))
  1.  S DDDATA=$NA(^XTMP("BQIGPCOM")),UDATA=$NA(^TMP("BQIGPCOM",UID))
  1.  K @DATA,@TDATA,@DDATA,@VDATA,@DDDATA,@UDATA
  1.  S @DATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate"
  1.  S @DDATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate by Division"
  1.  S @DDDATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate by Community"
  1.  S II=II+1
  1.  ;
  1.  S @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
  1.  S @DATA@(II)=@DATA@(II)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^I00010DENOMINATOR^"
  1.  S @DATA@(II)=@DATA@(II)_"N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$C(30)
  1.  S HDR=@DATA@(II)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S YEAR=$$GET1^DIQ(90508,1_",",2,"E")
  1.  S BQIY=$$LKP^BQIGPUTL(YEAR)
  1.  D GFN^BQIGPUTL(BQIH,BQIY)
  1.  S BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
  1.  S BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
  1.  S VER=$$VERSION^XPDUTL("BGP")
  1.  ;
  1.  S MSIEN=""
  1.  F  S MSIEN=$O(^BQI(90506.1,"AC","G",MSIEN)) Q:MSIEN=""  D
  1.  . I $P(^BQI(90506.1,MSIEN,0),U,10)=1 Q
  1.  . D INIT(.VER,.MSIEN)
  1.  ;
  1.  S DFN=0,TOTP=0
  1.  F  S DFN=$O(^BQIPAT(DFN)) Q:'DFN  D RPT(.VER)
  1.  ;
  1.  S CAT=""
  1.  F  S CAT=$O(@TDATA@(CAT)) Q:CAT=""  D
  1.  . S CLIN=""
  1.  . F  S CLIN=$O(@TDATA@(CAT,CLIN)) Q:CLIN=""  D
  1.  .. S TIT=""
  1.  .. F  S TIT=$O(@TDATA@(CAT,CLIN,TIT)) Q:TIT=""  D
  1.  ... S BQIEN=""
  1.  ... F  S BQIEN=$O(@TDATA@(CAT,CLIN,TIT,BQIEN)) Q:BQIEN=""  D
  1.  .... S GDATA=@TDATA@(CAT,CLIN,TIT,BQIEN)
  1.  .... S GNUM=$G(@TDATA@(CAT,CLIN,TIT,BQIEN,"NUM"))
  1.  .... S GDEN=$G(@TDATA@(CAT,CLIN,TIT,BQIEN,"DEN"))
  1.  .... D DEF(GDATA,GNUM,GDEN)
  1.  ;
  1.  K @TDATA
  1.  ;
  1.  S DIV=""
  1.  F  S DIV=$O(@VDATA@(DIV)) Q:DIV=""  D
  1.  . S TOTP=0,DFN=""
  1.  . F  S DFN=$O(@VDATA@("TOTP",DIV,DFN)) Q:DFN=""  S TOTP=TOTP+1
  1.  . K @VDATA@("TOTP",DIV)
  1.  . S CAT="",II=1,@VDATA@(DIV,II)=HDR
  1.  . F  S CAT=$O(@VDATA@(DIV,CAT)) Q:CAT=""  D
  1.  .. S CLIN=""
  1.  .. F  S CLIN=$O(@VDATA@(DIV,CAT,CLIN)) Q:CLIN=""  D
  1.  ... S TIT=""
  1.  ... F  S TIT=$O(@VDATA@(DIV,CAT,CLIN,TIT)) Q:TIT=""  D
  1.  .... S BQIEN=""
  1.  .... F  S BQIEN=$O(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN)) Q:BQIEN=""  D
  1.  ..... S GDATA=@VDATA@(DIV,CAT,CLIN,TIT,BQIEN)
  1.  ..... S GNUM=$G(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN,"NUM"))
  1.  ..... S GDEN=$G(@VDATA@(DIV,CAT,CLIN,TIT,BQIEN,"DEN"))
  1.  ..... D DDEF(GDATA,GNUM,GDEN,DIV)
  1.  ;
  1.  K @VDATA
  1.  ;
  1.  S COMM=""
  1.  F  S COMM=$O(@UDATA@(COMM)) Q:COMM=""  D
  1.  . S TOTP=0,DFN=""
  1.  . F  S DFN=$O(@UDATA@("TOTP",COMM,DFN)) Q:DFN=""  S TOTP=TOTP+1
  1.  . K @UDATA@("TOTP",COMM)
  1.  . S CAT="",II=1,@UDATA@(COMM,II)=HDR
  1.  . F  S CAT=$O(@UDATA@(COMM,CAT)) Q:CAT=""  D
  1.  .. S CLIN=""
  1.  .. F  S CLIN=$O(@UDATA@(COMM,CAT,CLIN)) Q:CLIN=""  D
  1.  ... S TIT=""
  1.  ... F  S TIT=$O(@UDATA@(COMM,CAT,CLIN,TIT)) Q:TIT=""  D
  1.  .... S BQIEN=""
  1.  .... F  S BQIEN=$O(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN)) Q:BQIEN=""  D
  1.  ..... S GDATA=@UDATA@(COMM,CAT,CLIN,TIT,BQIEN)
  1.  ..... S GNUM=$G(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN,"NUM"))
  1.  ..... S GDEN=$G(@UDATA@(COMM,CAT,CLIN,TIT,BQIEN,"DEN"))
  1.  ..... D DDDEF(GDATA,GNUM,GDEN,COMM)
  1.  Q
  1.  ;
  1. DEF(GDATA,GNUM,GDEN) ;EP
  1.  S BQICAT=$P(GDATA,"^",1)
  1.  S BQICLN=$P(GDATA,"^",2)
  1.  S BQMEAS=$P(GDATA,"^",3)
  1.  S MDESC=$P(GDATA,"^",4)
  1.  ;S TWTEN=$P(GDATA,"^",5)
  1.  S NCURR=$P(GDATA,"^",5)
  1.  S YCURR=$P(GDATA,"^",6)
  1.  S RPERIOD=$P(GDATA,"^",7) S:RPERIOD="" RPERIOD=$G(TPERIOD)
  1.  S NAFLG=$P(GDATA,"^",9)
  1.  S GOAL=$P(GDATA,"^",10)
  1.  ;
  1.  S NUM=+$G(GNUM)
  1.  S DEN=+$G(GDEN)
  1.  I DEN=0 S PER=-1
  1.  I NUM=0,DEN'=0 S PER=0
  1.  ;I NUM=0,DEN=0 S PER=0
  1.  I NUM=0,DEN=0 S PER=-1
  1.  I NAFLG=1,PER=0 S PER=-1
  1.  I NUM'=0,DEN'=0 S PER=(NUM/DEN)*100,PER=$J(PER,3,1)
  1.  I NAFLG=1 S DEN="-"
  1.  S EXCEPT=$S(NAFLG=1:"Y",1:"N")
  1.  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)
  1.  Q
  1.  ;
  1. DDEF(GDATA,GNUM,GDEN,GDIV) ;
  1.  S BQICAT=$P(GDATA,"^",1)
  1.  S BQICLN=$P(GDATA,"^",2)
  1.  S BQMEAS=$P(GDATA,"^",3)
  1.  S MDESC=$P(GDATA,"^",4)
  1.  ;S TWTEN=$P(GDATA,"^",5)
  1.  S NCURR=$P(GDATA,"^",5)
  1.  S YCURR=$P(GDATA,"^",6)
  1.  S RPERIOD=$P(GDATA,"^",7) S:RPERIOD="" RPERIOD=$G(TPERIOD)
  1.  S NAFLG=$P(GDATA,"^",9)
  1.  S GOAL=$P(GDATA,"^",10)
  1.  ;
  1.  S NUM=+$G(GNUM)
  1.  S DEN=+$G(GDEN)
  1.  I DEN=0 S PER=-1
  1.  I NUM=0,DEN'=0 S PER=0
  1.  ;I NUM=0,DEN=0 S PER=0
  1.  I NUM=0,DEN=0 S PER=-1
  1.  I NAFLG=1,PER=0 S PER=-1
  1.  I NUM'=0,DEN'=0 S PER=(NUM/DEN)*100,PER=$J(PER,3,1)
  1.  I NAFLG=1 S DEN="-"
  1.  S EXCEPT=$S(NAFLG=1:"Y",1:"N")
  1.  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)
  1.  Q
  1.  ;
  1. DDDEF(GDATA,GNUM,GDEN,GCOMM) ;
  1.  S BQICAT=$P(GDATA,"^",1)
  1.  S BQICLN=$P(GDATA,"^",2)
  1.  S BQMEAS=$P(GDATA,"^",3)
  1.  S MDESC=$P(GDATA,"^",4)
  1.  ;S TWTEN=$P(GDATA,"^",5)
  1.  S NCURR=$P(GDATA,"^",5)
  1.  S YCURR=$P(GDATA,"^",6)
  1.  S RPERIOD=$P(GDATA,"^",7) S:RPERIOD="" RPERIOD=$G(TPERIOD)
  1.  S NAFLG=$P(GDATA,"^",9)
  1.  S GOAL=$P(GDATA,"^",10)
  1.  ;
  1.  S NUM=+$G(GNUM)
  1.  S DEN=+$G(GDEN)
  1.  I DEN=0 S PER=-1
  1.  I NUM=0,DEN'=0 S PER=0
  1.  ;I NUM=0,DEN=0 S PER=0
  1.  I NUM=0,DEN=0 S PER=-1
  1.  I NAFLG=1,PER=0 S PER=-1
  1.  I NUM'=0,DEN'=0 S PER=(NUM/DEN)*100,PER=$J(PER,3,1)
  1.  I NAFLG=1 S DEN="-"
  1.  S EXCEPT=$S(NAFLG=1:"Y",1:"N")
  1.  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)
  1.  Q
  1.  ;
  1. 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
  1.  NEW BQDV,BQCOMM
  1.  S BQIND=0
  1.  I $O(^BQIPAT(DFN,30,BQIND))'="" S TOTP=TOTP+1
  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 MSIEN=$O(^BQI(90506.1,"B",BQMEAS,"")) I MSIEN="" Q
  1.  . I $P(^BQI(90506.1,MSIEN,0),U,10)=1 Q
  1.  . S TITLE=$P(^BQI(90506.1,MSIEN,0),U,3)
  1.  . S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
  1.  . S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  . S BMEAS=$P(BQMEAS,"_",2)
  1.  . ;
  1.  . S BQIYR=$P($G(^BQIPAT(DFN,0)),U,2)
  1.  . S FDT=$P($G(^BQIPAT(DFN,0)),U,3),TDT=$P($G(^BQIPAT(DFN,0)),U,4)
  1.  . S RPERIOD=$$FMTE^XLFDT(FDT,1)_"-"_$$FMTE^XLFDT(TDT,1)
  1.  . ;
  1.  . S SUM=$$GET1^DIQ(BQIMEASF,BMEAS_",",1706,"I")
  1.  . S IPC=$$GET1^DIQ(BQIMEASF,BMEAS_",",1707,"I")
  1.  . I IPC=1,$$CIPC^BQIIPCUT(BQCODE) D
  1.  .. S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(BQCODE)
  1.  .. I CLIN="" S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  . I '$D(@TDATA@(CAT,CLIN,TITLE,MSIEN)) D INIT(VER,MSIEN)
  1.  . S @TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM")=$G(@TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
  1.  . S @TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN")=$G(@TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
  1.  . S $P(@TDATA@(CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD S:RPERIOD'="" TPERIOD=RPERIOD
  1.  . S BQDV=0
  1.  . F  S BQDV=$O(^AUPNPAT(DFN,41,BQDV)) Q:'BQDV  D
  1.  .. I $P($G(^AUPNPAT(DFN,41,BQDV,0)),U,3)'="" Q
  1.  .. I '$D(^BQI(90508,1,25,"B",BQDV)) Q
  1.  .. S @VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"NUM")=$G(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
  1.  .. S @VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"DEN")=$G(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
  1.  .. S @VDATA@("TOTP",BQDV,DFN)=""
  1.  .. S $P(@VDATA@(BQDV,CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD S:RPERIOD'="" TPERIOD=RPERIOD
  1.  . S BQCOMM=$P($G(^AUPNPAT(DFN,11)),U,17) I BQCOMM="" Q
  1.  . S @UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"NUM")=$G(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
  1.  . S @UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"DEN")=$G(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
  1.  . S @UDATA@("TOTP",BQCOMM,DFN)=""
  1.  . S $P(@UDATA@(BQCOMM,CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD S:RPERIOD'="" TPERIOD=RPERIOD
  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. INIT(VER,MSIEN) ; Initialize array
  1.  S BQMEAS=$P(^BQI(90506.1,MSIEN,0),U,1),TITLE=$P(^(0),U,3)
  1.  S BQCODE=BQMEAS,BQMEAS=$P(BQMEAS,"_",2)
  1.  ;
  1.  S ORDER=TITLE
  1.  S NAFLG=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
  1.  S NAFLG=$S(NAFLG="Y":1,1:0)
  1.  S SUM=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1706,"I")
  1.  S IPC=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1707,"I")
  1.  ;
  1.  S TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
  1.  I TWTEN="" S TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1503,"E")
  1.  S NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1402,"E")
  1.  I NCURR="" S NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1502,"E")
  1.  S NCURR=$$STRIP^XLFSTR(NCURR," @#&!")
  1.  S YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1408,"E")
  1.  I YCURR="" S YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1508,"E")
  1.  ;
  1.  S GOAL=""
  1.  I $$VERSION^XPDUTL("BGP")>11 D
  1.  . S GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
  1.  . I GOAL="" S GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1903,"E")
  1.  ;
  1.  S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
  1.  S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  I IPC=1,$$CIPC^BQIIPCUT(BQCODE) D
  1.  . S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(BQCODE)
  1.  . I CLIN="" S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  ;
  1.  S RPERIOD="",VALUE="",IPC=""
  1.  ;
  1.  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
  1.  S DIV=""
  1.  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
  1.  NEW COMM,DFN,CIEN
  1.  S COMM=""
  1.  F  S COMM=$O(^AUPNPAT("AC",COMM)) Q:COMM=""  D
  1.  . S DFN=""
  1.  . F  S DFN=$O(^AUPNPAT("AC",COMM,DFN)) Q:DFN=""  D
  1.  .. S CIEN=$P($G(^AUPNPAT(DFN,11)),"^",17) I CIEN="" Q
  1.  .. 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
  1.  Q