BQIIPPRV ;VNGT/HS/ALA-Get Provider Data ; 19 Jul 2011 2:39 PM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
;
EN(DATA,OWNR,PLIEN,CRIPC,PLIST) ;EP - BQI GET IPC PROV DETAIL
;Description - Entry point for the panel
;Input Parameters
; OWNR - Owner of panel
; PLIEN - Panel IEN
; PLIST - List of DFNs (optional)
NEW UID,II,TDATA,XX,BQIND,BQMEAS,CAT,CODE,DEC,DEN,DFN,IDATA,MET,MSIEN
NEW NDA,NO,NUM,PROV,PRV,TITLE,TOTP,TYP,VAL,VALUE,XX,YES,TNDA,CAT2,CAT
NEW TAB,MSN,NA,BQIDOD,CNT,DCAT,EXEC,GP,I,ORD,QFL,TAG,STAB,GOAL,CRN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIIPPRV",UID)) K @DATA
S TDATA=$NA(^TMP("BQIPRVIP",UID)) K @TDATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPPRV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; get the current IPC definition
S CRIPC=$G(CRIPC,"")
I CRIPC="" S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
S @DATA@(II)="T00035PROVIDER^I00010TOTAL_PATIENTS^I00010TOTAL_NDA^"
S @DATA@(II)=@DATA@(II)_"T00030CATEGORY^T00030CAT2^T00060TITLE^T00030ID^"
S @DATA@(II)=@DATA@(II)_"I00010NUMERATOR^I00010DENOMINATOR^I00010DECEASED^T00005PERCENT_MET^T00005PERCENT_GOAL"_$C(30)
;
; If a list of DFNs, process them instead of entire panel
I $D(PLIST)>0 D G DONE
. I $D(PLIST)>1 D
.. S LIST="",BN=""
.. F S BN=$O(PLIST(BN)) Q:BN="" S LIST=LIST_PLIST(BN)
.. K PLIST S PLIST=LIST
. F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN="" D
.. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
.. D RPT(DFN)
;
S DFN=0
I $O(^BQICARE(OWNR,1,PLIEN,40,DFN))="" G DONE
;
F S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN D
. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
. D RPT(DFN)
;
S PRV=""
F S PRV=$O(@TDATA@(PRV)) Q:PRV="" D
. S TOTP=$G(@TDATA@(PRV,"TOTP")),TNDA=0
. S DFN="" F S DFN=$O(@TDATA@(PRV,"NDA",DFN)) Q:DFN="" S TNDA=TNDA+1
. S ORD=""
. F S ORD=$O(@TDATA@(PRV,ORD)) Q:'ORD D
.. S MSN=$O(^BQI(90508,1,22,CRN,1,"C",ORD,"")) I MSN="" Q
.. S IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
.. I $P(IDATA,U,7)=1 Q
.. NEW DA,IENS
.. S DA(2)=1,DA(1)=CRN,DA=MSN,IENS=$$IENS^DILF(.DA)
.. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
.. S CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
.. I CRIPC="IPC4/IPC5" D
... S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
... I CAT="" D
.... S RIEN=$O(^BQI(90506.1,"B",CODE,""))
.... S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
... S CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
.. I CRIPC="IPCMH" D
... S CAT1=$$GET1^DIQ(90508.221,IENS,.03,"E")
... S ICAT=$$GET1^DIQ(90508.221,IENS,.03,"I")
... S CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
... I CAT2="" S CAT2=$$GET1^DIQ(90506.8,ICAT_",",.04,"E")
... S CAT=CAT2,CAT2=CAT1
.. S TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
.. S STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
.. I TAB="A" Q
.. S CODE=$P(IDATA,U,1),TITLE=$P(IDATA,U,4),GOAL=$P(IDATA,U,12)
.. S NUM=$G(@TDATA@(PRV,ORD,"NUM"))
.. S DEN=$G(@TDATA@(PRV,ORD,"DEN"))
.. S DEC=$G(@TDATA@(PRV,ORD,"DEC"))
.. I IDATA["Goal Set" S DEN=TOTP
.. I +DEN=0 S MET="0%"
.. I +DEN'=0,+NUM=0 S MET="0%"
.. I +NUM'=0 S MET=$J((NUM/DEN)*100,3,0),MET=$$TRIM^BQIUL1(MET," ")_"%"
.. I PRV'="~" D
... S TRM=0
... I $P($G(^VA(200,PRV,0)),U,13)'="" S TRM=1
... S PROV=PRV_$C(28)_$S(TRM:"*",1:"")_$P($G(^VA(200,PRV,0)),U,1)
.. I PRV="~" S PROV="{NOT ASSIGNED}"
.. S DCAT=CAT
.. I DCAT["_1" S DCAT=$P(CAT,"_1",1)
.. I DCAT["_2" S DCAT=$P(CAT,"_2",1)
.. S II=II+1,@DATA@(II)=PROV_U_TOTP_U_$G(TNDA)_U_DCAT_U_CAT2_U_TITLE_U_CODE_U_NUM_U_DEN_U_DEC_U_MET_U_GOAL_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
K @TDATA
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
;
RPT(DFN) ; Get the CRS Clinical Performance information
S PROV=$P($G(^AUPNPAT(DFN,0)),U,14) S:PROV="" PROV="~"
I '$$HRN^BQIUL1(DFN) Q
S @TDATA@(PROV,"TOTP")=$G(@TDATA@(PROV,"TOTP"))+1
S ORD=""
F S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD="" D
. S MSN=""
. F S MSN=$O(^BQI(90508,1,22,CRN,1,"C",ORD,MSN)) Q:MSN="" D
.. S IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
.. S CODE=$P(IDATA,U,1),TYP=$P(IDATA,U,2),TITLE=$P(IDATA,U,4)
.. ; If inactive, quit
.. I $P(IDATA,U,7)=1 Q
.. NEW DA,IENS
.. S DA(2)=1,DA(1)=CRN,DA=MSN,IENS=$$IENS^DILF(.DA)
.. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
.. S MSIEN=$O(^BQI(90506.1,"B",CODE,""))
.. I CAT="",MSIEN'="" S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
.. I CAT="" S CAT="~"
.. I $P(IDATA,U,5)'="B" S CAT=CAT_"_2"
.. S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
.. I $G(BQIDOD)'="" D Q
... I CAT'["_" S CAT=CAT_"_1"
... S @TDATA@(PROV,ORD,"DEC")=$G(@TDATA@(PROV,ORD,"DEC"))+1
.. I TYP="R",$P(IDATA,U,5)="B" D
... K XX
... I CODE="IPC_OUTC" D
.... I DFN'="" S VAL=$$OPAT^BQIIPOTC(CRN,DFN)
... I CODE["CTRL" D
.... I DFN'="" S VAL=$$PAT^BQIIPOTC(CRN,DFN,CODE)
... I CODE'="IPC_OUTC",CODE'["CTRL" D
.... D BUN^BQIIPBNL(CRN,MSN,.XX)
.... I DFN'="" S VAL=$$PAT^BQIIPBNL(DFN,.XX)
... I VAL="N/A"!(VAL="NDA") S NUM=0,DEN=0 D STOR(ORD) Q
... ;I VAL="N/A" Q
... I $P(IDATA,U,5)="B" S CAT=CAT_"_1"
... I VAL="NDA" D Q
.... S DEN=0,NUM=0 D STOR(ORD)
.... S @TDATA@(PROV,"NDA",DFN)=1
... I VAL="NO" S DEN=1,NUM=0 D STOR(ORD) Q
... I VAL="YES" S DEN=1,NUM=1 D STOR(ORD) Q
.. I TYP'="G" Q
.. S BQIND=$O(^BQIPAT(DFN,30,"B",CODE,"")) I BQIND="" D Q
... S @TDATA@(PROV,"NDA",DFN)=1
... ;S DEN=1,NUM=0 D STOR(ORD)
... S DEN=0,NUM=0 D STOR(ORD)
.. 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)
.. ;
.. D STOR(ORD)
Q
;
STOR(ORD) ;EP
S @TDATA@(PROV,ORD,"NUM")=$G(@TDATA@(PROV,ORD,"NUM"))+NUM
S @TDATA@(PROV,ORD,"DEN")=$G(@TDATA@(PROV,ORD,"DEN"))+DEN
;S @TDATA@(PROV,CAT,TITLE,MSN,"NUM")=$G(@TDATA@(PROV,CAT,TITLE,MSN,"NUM"))+NUM
;S @TDATA@(PROV,CAT,TITLE,MSN,"DEN")=$G(@TDATA@(PROV,CAT,TITLE,MSN,"DEN"))+DEN
Q
BQIIPPRV ;VNGT/HS/ALA-Get Provider Data ; 19 Jul 2011 2:39 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
+3 ;
EN(DATA,OWNR,PLIEN,CRIPC,PLIST) ;EP - BQI GET IPC PROV DETAIL
+1 ;Description - Entry point for the panel
+2 ;Input Parameters
+3 ; OWNR - Owner of panel
+4 ; PLIEN - Panel IEN
+5 ; PLIST - List of DFNs (optional)
+6 NEW UID,II,TDATA,XX,BQIND,BQMEAS,CAT,CODE,DEC,DEN,DFN,IDATA,MET,MSIEN
+7 NEW NDA,NO,NUM,PROV,PRV,TITLE,TOTP,TYP,VAL,VALUE,XX,YES,TNDA,CAT2,CAT
+8 NEW TAB,MSN,NA,BQIDOD,CNT,DCAT,EXEC,GP,I,ORD,QFL,TAG,STAB,GOAL,CRN
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BQIIPPRV",UID))
KILL @DATA
+11 SET TDATA=$NAME(^TMP("BQIPRVIP",UID))
KILL @TDATA
+12 ;
+13 SET II=0
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPPRV D UNWIND^%ZTER"
+15 ;
+16 ; get the current IPC definition
+17 SET CRIPC=$GET(CRIPC,"")
+18 IF CRIPC=""
SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+19 SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))
IF CRN=""
QUIT
+20 SET @DATA@(II)="T00035PROVIDER^I00010TOTAL_PATIENTS^I00010TOTAL_NDA^"
+21 SET @DATA@(II)=@DATA@(II)_"T00030CATEGORY^T00030CAT2^T00060TITLE^T00030ID^"
+22 SET @DATA@(II)=@DATA@(II)_"I00010NUMERATOR^I00010DENOMINATOR^I00010DECEASED^T00005PERCENT_MET^T00005PERCENT_GOAL"_$CHAR(30)
+23 ;
+24 ; If a list of DFNs, process them instead of entire panel
+25 IF $DATA(PLIST)>0
Begin DoDot:1
+26 IF $DATA(PLIST)>1
Begin DoDot:2
+27 SET LIST=""
SET BN=""
+28 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+29 KILL PLIST
SET PLIST=LIST
End DoDot:2
+30 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:2
+31 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+32 DO RPT(DFN)
End DoDot:2
End DoDot:1
GOTO DONE
+33 ;
+34 SET DFN=0
+35 IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))=""
GOTO DONE
+36 ;
+37 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+38 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+39 DO RPT(DFN)
End DoDot:1
+40 ;
+41 SET PRV=""
+42 FOR
SET PRV=$ORDER(@TDATA@(PRV))
IF PRV=""
QUIT
Begin DoDot:1
+43 SET TOTP=$GET(@TDATA@(PRV,"TOTP"))
SET TNDA=0
+44 SET DFN=""
FOR
SET DFN=$ORDER(@TDATA@(PRV,"NDA",DFN))
IF DFN=""
QUIT
SET TNDA=TNDA+1
+45 SET ORD=""
+46 FOR
SET ORD=$ORDER(@TDATA@(PRV,ORD))
IF 'ORD
QUIT
Begin DoDot:2
+47 SET MSN=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD,""))
IF MSN=""
QUIT
+48 SET IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
+49 IF $PIECE(IDATA,U,7)=1
QUIT
+50 NEW DA,IENS
+51 SET DA(2)=1
SET DA(1)=CRN
SET DA=MSN
SET IENS=$$IENS^DILF(.DA)
+52 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+53 SET CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
+54 IF CRIPC="IPC4/IPC5"
Begin DoDot:3
+55 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+56 IF CAT=""
Begin DoDot:4
+57 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
+58 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
End DoDot:4
+59 SET CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
End DoDot:3
+60 IF CRIPC="IPCMH"
Begin DoDot:3
+61 SET CAT1=$$GET1^DIQ(90508.221,IENS,.03,"E")
+62 SET ICAT=$$GET1^DIQ(90508.221,IENS,.03,"I")
+63 SET CAT2=$$GET1^DIQ(90508.221,IENS,.11,"E")
+64 IF CAT2=""
SET CAT2=$$GET1^DIQ(90506.8,ICAT_",",.04,"E")
+65 SET CAT=CAT2
SET CAT2=CAT1
End DoDot:3
+66 SET TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
+67 SET STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
+68 IF TAB="A"
QUIT
+69 SET CODE=$PIECE(IDATA,U,1)
SET TITLE=$PIECE(IDATA,U,4)
SET GOAL=$PIECE(IDATA,U,12)
+70 SET NUM=$GET(@TDATA@(PRV,ORD,"NUM"))
+71 SET DEN=$GET(@TDATA@(PRV,ORD,"DEN"))
+72 SET DEC=$GET(@TDATA@(PRV,ORD,"DEC"))
+73 IF IDATA["Goal Set"
SET DEN=TOTP
+74 IF +DEN=0
SET MET="0%"
+75 IF +DEN'=0
IF +NUM=0
SET MET="0%"
+76 IF +NUM'=0
SET MET=$JUSTIFY((NUM/DEN)*100,3,0)
SET MET=$$TRIM^BQIUL1(MET," ")_"%"
+77 IF PRV'="~"
Begin DoDot:3
+78 SET TRM=0
+79 IF $PIECE($GET(^VA(200,PRV,0)),U,13)'=""
SET TRM=1
+80 SET PROV=PRV_$CHAR(28)_$SELECT(TRM:"*",1:"")_$PIECE($GET(^VA(200,PRV,0)),U,1)
End DoDot:3
+81 IF PRV="~"
SET PROV="{NOT ASSIGNED}"
+82 SET DCAT=CAT
+83 IF DCAT["_1"
SET DCAT=$PIECE(CAT,"_1",1)
+84 IF DCAT["_2"
SET DCAT=$PIECE(CAT,"_2",1)
+85 SET II=II+1
SET @DATA@(II)=PROV_U_TOTP_U_$GET(TNDA)_U_DCAT_U_CAT2_U_TITLE_U_CODE_U_NUM_U_DEN_U_DEC_U_MET_U_GOAL_$CHAR(30)
End DoDot:2
End DoDot:1
+86 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 KILL @TDATA
+3 QUIT
+4 ;
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 ;
RPT(DFN) ; Get the CRS Clinical Performance information
+1 SET PROV=$PIECE($GET(^AUPNPAT(DFN,0)),U,14)
IF PROV=""
SET PROV="~"
+2 IF '$$HRN^BQIUL1(DFN)
QUIT
+3 SET @TDATA@(PROV,"TOTP")=$GET(@TDATA@(PROV,"TOTP"))+1
+4 SET ORD=""
+5 FOR
SET ORD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+6 SET MSN=""
+7 FOR
SET MSN=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD,MSN))
IF MSN=""
QUIT
Begin DoDot:2
+8 SET IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
+9 SET CODE=$PIECE(IDATA,U,1)
SET TYP=$PIECE(IDATA,U,2)
SET TITLE=$PIECE(IDATA,U,4)
+10 ; If inactive, quit
+11 IF $PIECE(IDATA,U,7)=1
QUIT
+12 NEW DA,IENS
+13 SET DA(2)=1
SET DA(1)=CRN
SET DA=MSN
SET IENS=$$IENS^DILF(.DA)
+14 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+15 SET MSIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
+16 IF CAT=""
IF MSIEN'=""
SET CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
+17 IF CAT=""
SET CAT="~"
+18 IF $PIECE(IDATA,U,5)'="B"
SET CAT=CAT_"_2"
+19 SET BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
+20 IF $GET(BQIDOD)'=""
Begin DoDot:3
+21 IF CAT'["_"
SET CAT=CAT_"_1"
+22 SET @TDATA@(PROV,ORD,"DEC")=$GET(@TDATA@(PROV,ORD,"DEC"))+1
End DoDot:3
QUIT
+23 IF TYP="R"
IF $PIECE(IDATA,U,5)="B"
Begin DoDot:3
+24 KILL XX
+25 IF CODE="IPC_OUTC"
Begin DoDot:4
+26 IF DFN'=""
SET VAL=$$OPAT^BQIIPOTC(CRN,DFN)
End DoDot:4
+27 IF CODE["CTRL"
Begin DoDot:4
+28 IF DFN'=""
SET VAL=$$PAT^BQIIPOTC(CRN,DFN,CODE)
End DoDot:4
+29 IF CODE'="IPC_OUTC"
IF CODE'["CTRL"
Begin DoDot:4
+30 DO BUN^BQIIPBNL(CRN,MSN,.XX)
+31 IF DFN'=""
SET VAL=$$PAT^BQIIPBNL(DFN,.XX)
End DoDot:4
+32 IF VAL="N/A"!(VAL="NDA")
SET NUM=0
SET DEN=0
DO STOR(ORD)
QUIT
+33 ;I VAL="N/A" Q
+34 IF $PIECE(IDATA,U,5)="B"
SET CAT=CAT_"_1"
+35 IF VAL="NDA"
Begin DoDot:4
+36 SET DEN=0
SET NUM=0
DO STOR(ORD)
+37 SET @TDATA@(PROV,"NDA",DFN)=1
End DoDot:4
QUIT
+38 IF VAL="NO"
SET DEN=1
SET NUM=0
DO STOR(ORD)
QUIT
+39 IF VAL="YES"
SET DEN=1
SET NUM=1
DO STOR(ORD)
QUIT
End DoDot:3
+40 IF TYP'="G"
QUIT
+41 SET BQIND=$ORDER(^BQIPAT(DFN,30,"B",CODE,""))
IF BQIND=""
Begin DoDot:3
+42 SET @TDATA@(PROV,"NDA",DFN)=1
+43 ;S DEN=1,NUM=0 D STOR(ORD)
+44 SET DEN=0
SET NUM=0
DO STOR(ORD)
End DoDot:3
QUIT
+45 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)
+46 ;
+47 DO STOR(ORD)
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
STOR(ORD) ;EP
+1 SET @TDATA@(PROV,ORD,"NUM")=$GET(@TDATA@(PROV,ORD,"NUM"))+NUM
+2 SET @TDATA@(PROV,ORD,"DEN")=$GET(@TDATA@(PROV,ORD,"DEN"))+DEN
+3 ;S @TDATA@(PROV,CAT,TITLE,MSN,"NUM")=$G(@TDATA@(PROV,CAT,TITLE,MSN,"NUM"))+NUM
+4 ;S @TDATA@(PROV,CAT,TITLE,MSN,"DEN")=$G(@TDATA@(PROV,CAT,TITLE,MSN,"DEN"))+DEN
+5 QUIT
