DVBCPUSH ;ALB/AKG - CAPRI PUSH UTILITY RPC; APR 25, 2022@9:30am ; 5/19/23 9:07am
;;2.7;AMIE;**238,242,248**;Apr 10, 1995;Build 6
;Per VHA Directive 6402 this routine should not be modified
;ICR #2263 Supports all calls to Parameter File and XPAR usage
;
Q
;
PARAMS(DVBLIST) ;returns data on the entire DVBA parameter list
;rpc returns all CAPRI namespaced Paramaters
K DVBLIST
N DVBCNT,DVBPARAM,DVBVAL,DVBPAR
S DVBCNT=0
S DVBPARAM="" F S DVBPARAM=$O(^XTV(8989.51,"B",DVBPARAM)) Q:DVBPARAM="" D
.S DVBPAR="" F S DVBPAR=$O(^XTV(8989.51,"B",DVBPARAM,DVBPAR)) Q:DVBPAR="" D
..I $P($P(DVBPARAM,U,1)," ")'["DVBA" Q
..S DVBVAL=$$GET^XPAR("PKG",DVBPARAM,1,"Q")
..S DVBLIST(DVBCNT)=DVBPAR_U_DVBPARAM_U_DVBVAL
..S DVBCNT=DVBCNT+1
Q
;
PARAMED(DVBMSG,DVBNAME,DVBVAL) ;
;edits exiting paramater value from CAPRI Push Utility
I $G(DVBNAME)="" S DVBMSG="Missing parameter name" Q
I $G(DVBVAL)="" S DVBMSG="Missing new value" Q
K DVBMSG S DVBMSG=""
N DVBERR,DVBINFO,DVBOLD
S DVBOLD=$$GET^XPAR("PKG",DVBNAME,1,"Q")
D EN^XPAR("PKG.AUTOMATED MED INFO EXCHANGE",DVBNAME,1,DVBVAL,.DVBERR)
I DVBERR S DVBMSG="Failed to update because "_DVBERR_U_0 Q
S DVBINFO=$$GET^XPAR("PKG",DVBNAME,1,"Q")
S DVBMSG=DVBNAME_" value updated successfully from "_DVBOLD_" to "_DVBINFO_U_1
Q
;
PARADESC(DVBRTN,DVBIEN) ;
;returns description for selected parameter
N DVBX,DVBTWP,DVBERR,DVBCT,DVBRT,DVBIENS,DVBTMP
I $G(DVBIEN)="" S DVBRTN="Missing Parameter IEN" Q
D GETS^DIQ(8989.51,DVBIEN,20,"","DVBTWP","DVBERR")
I $D(DVBERR) S DVBRTN=DVBERR Q
K DVBTMP M DVBTMP=DVBTWP
S DVBIENS=""_DVBIEN_","
I $D(DVBTMP) D
.S DVBCT="",DVBX="" F S DVBX=$O(DVBTMP(8989.51,DVBIENS,20,DVBX)) Q:DVBX="" D
..S DVBCT=DVBCT+1
..S DVBRT(DVBCT)=DVBTMP(8989.51,DVBIENS,20,DVBX)
M DVBRTN=DVBRT
K DVBRT,DVBTWP
Q
;
EFOLDMET(DVBRTN,DVBAUTH,DVBPIEN,DVBTRANS,DVBSTAT,DVBERR,DVBRPD) ;
;Input: DVBAUTH=Authorized User IEN
; DVBPIEN=Patient IEN
; DVBTRANS=Transmission Path
; DVBSTAT=Transmission Status
; DVBERR=Transmission Error Code
; DVBRPD=Report Details
;Output: RTN=0 for Failure and 1 for Success
;
N DVBDT,DIC,X,Y,DA,DTOUT,DUOUT,DLAYGO,DVBI,DVBRPC,DVBN1,DVBAIEN,DVBNUM
I DVBAUTH="" S DVBRTN="0^MISSING AUTHORIZED USER IEN" Q
I DVBPIEN="" S DVBRTN="0^MISSING PATIENT IEN" Q
I DVBTRANS="" S DVBRTN="0^MISSING TRANSMISSION PATH" Q
I DVBSTAT="" S DVBRTN="0^MISSING TRANSMISSION STATUS" Q
S DVBDT=$$NOW^XLFDT()
K DIC,DIE,DR,DA
S (DIC,DIE)="^DVB(396.21,",DIC(0)="L",DLAYGO=396.21 S X=DVBDT
D ^DIC S DA=+Y K DIC
I DA=-1 S DVBRTN=0 Q
S DVBRTN=1
S DR=".02////"_DVBAUTH_";.03////"_DVBPIEN_";1////"_DVBTRANS D ^DIE
S DR="1.1////"_DVBSTAT_";1.2////"_DVBERR D ^DIE
S DVBNUM=DA
S DVBI="" F S DVBI=$O(DVBRPD(DVBI)) Q:DVBI="" D
.S DA(1)=DVBNUM
.S DIC="^DVB(396.21,"_DA(1)_",2,",DIC(0)="L"
.D ^DIC S DA=+Y
.S DIE=DIC
.S DVBRPC=$P(DVBRPD(DVBI),U),DVBAIEN=$P(DVBRPD(DVBI),U,2)
.S DVBN1=$P(DVBRPD(DVBI),U,3,100)
.S DR=".01////"_DVBRPC_";.02////"_DVBAIEN_";.03////"_DVBN1
.D ^DIE
K DIC,DIE,DA,DR,DIRUT
Q
;
PURGEMET(DVBRTN,DUZ,DVBDTP) ;
;
;input: DUZ user must have the DVBA METRICS DATA PURGE key
; : Date to purge up to
N DVBDT,DVBDA,DVBKEY,DVBDATE
I DUZ="" S DVBRTN="0^Missing DUZ" Q
I DVBDTP="" S DVBRTN="0^Missing Date" Q
S X=DVBDTP D ^%DT S DVBDATE=Y
D OWNSKEY^XUSRB(.DVBKEY,"DVBA CAPRI METRICS PURGE",DUZ)
I DVBKEY(0)=0 S DVBRTN="0^Missing security key" Q
S DVBDT="" F S DVBDT=$O(^DVB(396.21,"B",DVBDT)) Q:DVBDT="" D
.S DVBDA="" F S DVBDA=$O(^DVB(396.21,"B",DVBDT,DVBDA)) Q:DVBDA="" D
..I $P(DVBDT,".")>DVBDATE Q
..K DIC,DA,DIK
..S DIC="^DVB(396.21,",DA=DVBDA
..S DIK=DIC D ^DIK K DIK,DIC
..S DVBRTN=1
I $G(DVBRTN)'=1 S DVBRTN="-1"
Q
PURGEOPT ;
W !!,"CAPRI CLINICAL DOCUMENTS EFOLDER METRIC DATA PURGE",!!
S DIR("?")="Enter date to purge CAPRI Clinical Documents EFolder Metrics file up to. For Example,to purge from today and older enter today's date"
S DIR("A")="Enter date to purge CAPRI Clinical Documents EFolder Metrics file."
S DIR(0)="D" D ^DIR K DIR Q:$D(DIRUT)!($D(DTOUT))
D PURGEMET(.DVBRTN,DUZ,Y)
I DVBRTN["Miss" W !!,"Missing Security Key, please check with your manager for additional assistance" Q
I DVBRTN'=1 W !!,"No records were purged",!! D PURGEOPT Q
I DVBRTN=1 W !!,"Purge completed"
Q
ALL(DVBLIST) ;
K DVBLIST
N DVBCNT,DVBPARAM,DVBVAL,DVBPAR,DVBSIY,DVBSIEN,DVBZ,DVBERR
S DVBCNT=0
S DVBPARAM="" F S DVBPARAM=$O(^XTV(8989.51,"B",DVBPARAM)) Q:DVBPARAM="" D
.S DVBPAR="" F S DVBPAR=$O(^XTV(8989.51,"B",DVBPARAM,DVBPAR)) Q:DVBPAR="" D
..S DVBZ="30*" K DVBSIY D GETS^DIQ(8989.51,DVBPAR,DVBZ,"I","DVBSIY","DVBERR") I $D(DVBERR) Q
..S DVBSIEN="" F S DVBSIEN=$O(DVBSIY(8989.513,DVBSIEN)) Q:DVBSIEN="" D
...N DVBENT S DVBENT=DVBSIY(8989.513,DVBSIEN,.02,"I") I DVBENT'=9.4 Q
...I DVBPARAM["XPAR" Q
...S DVBVAL=$$GET^XPAR("ALL",DVBPARAM,1,"Q")
...S DVBLIST(DVBCNT)=DVBPARAM_U_DVBVAL
...S DVBCNT=DVBCNT+1
Q
SPECADD(DVBMSG,DVBNAME) ;
;adds entry to Special Considerations
I $G(DVBNAME)="" S DVBMSG="0^Missing Special Considerations name" Q
K DVBMSG S DVBMSG="",DVBIEN=0
F S DVBIEN=$O(^DVB(396.25,DVBIEN)) Q:DVBIEN=""!('DVBIEN) D
.I $P(^DVB(396.25,DVBIEN,0),U,1)=DVBNAME S DVBMSG="0^Duplicate"
.Q
I DVBMSG="" D
.K DIC,DO,DIE,DA,DR,DLAYGO,X,Y
.N DIERR
.S DIC=396.25,DIC(0)="Z",X=DVBNAME D FILE^DICN
.S (DA)=+Y,DIE=DIC
.S DR=".02////1" D ^DIE
.I $D(DIERR) S DVBMSG="0^Record not added"
.I '$D(DIERR) S DVBMSG="1^Record added"
.K DIC,DO,DIE,DA,DR,DLAYGO,X,Y
.Q
Q
SPECDIS(DVBMSG,DVBIEN,DVBSTAT) ;
;disables entry in Special Considerations
N DIERR
K DIC,DIE,DA,DR,DLAYGO,X,Y
I $G(DVBIEN)="" S DVBMSG="0^Missing IEN" Q
I $G(DVBSTAT)="" S DVBMSG="0^Missing Status" Q
S DA=DVBIEN,(DLAYGO,DIE)="^DVB(396.25,",DIC(0)="L"
S DR=".02////"_DVBSTAT D ^DIE
I $D(DIERR) S DVBMSG="0^Record not disabled"
I '$D(DIERR) S DVBMSG="1^Record disabled"
K DIC,DIE,DA,DR,DLAYGO,X,Y
Q
LISTSC(DVBMSG) ;
;list inactive Special Considerations
N DVBIEN,DVBCNT,DVBRET
K ^TMP("DVBLSTSC",$J)
S DVBIEN=0,DVBCNT=0
F S DVBIEN=$O(^DVB(396.25,DVBIEN)) Q:DVBIEN=""!('DVBIEN) D
.Q:$G(^DVB(396.25,DVBIEN,0))=""
.Q:$P($G(^DVB(396.25,DVBIEN,0)),U,2)'=0
.S DVBRET(DVBCNT)=$P(^DVB(396.25,DVBIEN,0),"^",1)_"^"_DVBIEN
.M ^TMP("DVBLSTSC",$J,DVBCNT)=DVBRET(DVBCNT)
.S DVBCNT=DVBCNT+1
S DVBMSG=$NA(^TMP("DVBLSTSC",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCPUSH 6484 printed Oct 16, 2024@17:46:15 Page 2
DVBCPUSH ;ALB/AKG - CAPRI PUSH UTILITY RPC; APR 25, 2022@9:30am ; 5/19/23 9:07am
+1 ;;2.7;AMIE;**238,242,248**;Apr 10, 1995;Build 6
+2 ;Per VHA Directive 6402 this routine should not be modified
+3 ;ICR #2263 Supports all calls to Parameter File and XPAR usage
+4 ;
+5 QUIT
+6 ;
PARAMS(DVBLIST) ;returns data on the entire DVBA parameter list
+1 ;rpc returns all CAPRI namespaced Paramaters
+2 KILL DVBLIST
+3 NEW DVBCNT,DVBPARAM,DVBVAL,DVBPAR
+4 SET DVBCNT=0
+5 SET DVBPARAM=""
FOR
SET DVBPARAM=$ORDER(^XTV(8989.51,"B",DVBPARAM))
if DVBPARAM=""
QUIT
Begin DoDot:1
+6 SET DVBPAR=""
FOR
SET DVBPAR=$ORDER(^XTV(8989.51,"B",DVBPARAM,DVBPAR))
if DVBPAR=""
QUIT
Begin DoDot:2
+7 IF $PIECE($PIECE(DVBPARAM,U,1)," ")'["DVBA"
QUIT
+8 SET DVBVAL=$$GET^XPAR("PKG",DVBPARAM,1,"Q")
+9 SET DVBLIST(DVBCNT)=DVBPAR_U_DVBPARAM_U_DVBVAL
+10 SET DVBCNT=DVBCNT+1
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
PARAMED(DVBMSG,DVBNAME,DVBVAL) ;
+1 ;edits exiting paramater value from CAPRI Push Utility
+2 IF $GET(DVBNAME)=""
SET DVBMSG="Missing parameter name"
QUIT
+3 IF $GET(DVBVAL)=""
SET DVBMSG="Missing new value"
QUIT
+4 KILL DVBMSG
SET DVBMSG=""
+5 NEW DVBERR,DVBINFO,DVBOLD
+6 SET DVBOLD=$$GET^XPAR("PKG",DVBNAME,1,"Q")
+7 DO EN^XPAR("PKG.AUTOMATED MED INFO EXCHANGE",DVBNAME,1,DVBVAL,.DVBERR)
+8 IF DVBERR
SET DVBMSG="Failed to update because "_DVBERR_U_0
QUIT
+9 SET DVBINFO=$$GET^XPAR("PKG",DVBNAME,1,"Q")
+10 SET DVBMSG=DVBNAME_" value updated successfully from "_DVBOLD_" to "_DVBINFO_U_1
+11 QUIT
+12 ;
PARADESC(DVBRTN,DVBIEN) ;
+1 ;returns description for selected parameter
+2 NEW DVBX,DVBTWP,DVBERR,DVBCT,DVBRT,DVBIENS,DVBTMP
+3 IF $GET(DVBIEN)=""
SET DVBRTN="Missing Parameter IEN"
QUIT
+4 DO GETS^DIQ(8989.51,DVBIEN,20,"","DVBTWP","DVBERR")
+5 IF $DATA(DVBERR)
SET DVBRTN=DVBERR
QUIT
+6 KILL DVBTMP
MERGE DVBTMP=DVBTWP
+7 SET DVBIENS=""_DVBIEN_","
+8 IF $DATA(DVBTMP)
Begin DoDot:1
+9 SET DVBCT=""
SET DVBX=""
FOR
SET DVBX=$ORDER(DVBTMP(8989.51,DVBIENS,20,DVBX))
if DVBX=""
QUIT
Begin DoDot:2
+10 SET DVBCT=DVBCT+1
+11 SET DVBRT(DVBCT)=DVBTMP(8989.51,DVBIENS,20,DVBX)
End DoDot:2
End DoDot:1
+12 MERGE DVBRTN=DVBRT
+13 KILL DVBRT,DVBTWP
+14 QUIT
+15 ;
EFOLDMET(DVBRTN,DVBAUTH,DVBPIEN,DVBTRANS,DVBSTAT,DVBERR,DVBRPD) ;
+1 ;Input: DVBAUTH=Authorized User IEN
+2 ; DVBPIEN=Patient IEN
+3 ; DVBTRANS=Transmission Path
+4 ; DVBSTAT=Transmission Status
+5 ; DVBERR=Transmission Error Code
+6 ; DVBRPD=Report Details
+7 ;Output: RTN=0 for Failure and 1 for Success
+8 ;
+9 NEW DVBDT,DIC,X,Y,DA,DTOUT,DUOUT,DLAYGO,DVBI,DVBRPC,DVBN1,DVBAIEN,DVBNUM
+10 IF DVBAUTH=""
SET DVBRTN="0^MISSING AUTHORIZED USER IEN"
QUIT
+11 IF DVBPIEN=""
SET DVBRTN="0^MISSING PATIENT IEN"
QUIT
+12 IF DVBTRANS=""
SET DVBRTN="0^MISSING TRANSMISSION PATH"
QUIT
+13 IF DVBSTAT=""
SET DVBRTN="0^MISSING TRANSMISSION STATUS"
QUIT
+14 SET DVBDT=$$NOW^XLFDT()
+15 KILL DIC,DIE,DR,DA
+16 SET (DIC,DIE)="^DVB(396.21,"
SET DIC(0)="L"
SET DLAYGO=396.21
SET X=DVBDT
+17 DO ^DIC
SET DA=+Y
KILL DIC
+18 IF DA=-1
SET DVBRTN=0
QUIT
+19 SET DVBRTN=1
+20 SET DR=".02////"_DVBAUTH_";.03////"_DVBPIEN_";1////"_DVBTRANS
DO ^DIE
+21 SET DR="1.1////"_DVBSTAT_";1.2////"_DVBERR
DO ^DIE
+22 SET DVBNUM=DA
+23 SET DVBI=""
FOR
SET DVBI=$ORDER(DVBRPD(DVBI))
if DVBI=""
QUIT
Begin DoDot:1
+24 SET DA(1)=DVBNUM
+25 SET DIC="^DVB(396.21,"_DA(1)_",2,"
SET DIC(0)="L"
+26 DO ^DIC
SET DA=+Y
+27 SET DIE=DIC
+28 SET DVBRPC=$PIECE(DVBRPD(DVBI),U)
SET DVBAIEN=$PIECE(DVBRPD(DVBI),U,2)
+29 SET DVBN1=$PIECE(DVBRPD(DVBI),U,3,100)
+30 SET DR=".01////"_DVBRPC_";.02////"_DVBAIEN_";.03////"_DVBN1
+31 DO ^DIE
End DoDot:1
+32 KILL DIC,DIE,DA,DR,DIRUT
+33 QUIT
+34 ;
PURGEMET(DVBRTN,DUZ,DVBDTP) ;
+1 ;
+2 ;input: DUZ user must have the DVBA METRICS DATA PURGE key
+3 ; : Date to purge up to
+4 NEW DVBDT,DVBDA,DVBKEY,DVBDATE
+5 IF DUZ=""
SET DVBRTN="0^Missing DUZ"
QUIT
+6 IF DVBDTP=""
SET DVBRTN="0^Missing Date"
QUIT
+7 SET X=DVBDTP
DO ^%DT
SET DVBDATE=Y
+8 DO OWNSKEY^XUSRB(.DVBKEY,"DVBA CAPRI METRICS PURGE",DUZ)
+9 IF DVBKEY(0)=0
SET DVBRTN="0^Missing security key"
QUIT
+10 SET DVBDT=""
FOR
SET DVBDT=$ORDER(^DVB(396.21,"B",DVBDT))
if DVBDT=""
QUIT
Begin DoDot:1
+11 SET DVBDA=""
FOR
SET DVBDA=$ORDER(^DVB(396.21,"B",DVBDT,DVBDA))
if DVBDA=""
QUIT
Begin DoDot:2
+12 IF $PIECE(DVBDT,".")>DVBDATE
QUIT
+13 KILL DIC,DA,DIK
+14 SET DIC="^DVB(396.21,"
SET DA=DVBDA
+15 SET DIK=DIC
DO ^DIK
KILL DIK,DIC
+16 SET DVBRTN=1
End DoDot:2
End DoDot:1
+17 IF $GET(DVBRTN)'=1
SET DVBRTN="-1"
+18 QUIT
PURGEOPT ;
+1 WRITE !!,"CAPRI CLINICAL DOCUMENTS EFOLDER METRIC DATA PURGE",!!
+2 SET DIR("?")="Enter date to purge CAPRI Clinical Documents EFolder Metrics file up to. For Example,to purge from today and older enter today's date"
+3 SET DIR("A")="Enter date to purge CAPRI Clinical Documents EFolder Metrics file."
+4 SET DIR(0)="D"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!($DATA(DTOUT))
QUIT
+5 DO PURGEMET(.DVBRTN,DUZ,Y)
+6 IF DVBRTN["Miss"
WRITE !!,"Missing Security Key, please check with your manager for additional assistance"
QUIT
+7 IF DVBRTN'=1
WRITE !!,"No records were purged",!!
DO PURGEOPT
QUIT
+8 IF DVBRTN=1
WRITE !!,"Purge completed"
+9 QUIT
ALL(DVBLIST) ;
+1 KILL DVBLIST
+2 NEW DVBCNT,DVBPARAM,DVBVAL,DVBPAR,DVBSIY,DVBSIEN,DVBZ,DVBERR
+3 SET DVBCNT=0
+4 SET DVBPARAM=""
FOR
SET DVBPARAM=$ORDER(^XTV(8989.51,"B",DVBPARAM))
if DVBPARAM=""
QUIT
Begin DoDot:1
+5 SET DVBPAR=""
FOR
SET DVBPAR=$ORDER(^XTV(8989.51,"B",DVBPARAM,DVBPAR))
if DVBPAR=""
QUIT
Begin DoDot:2
+6 SET DVBZ="30*"
KILL DVBSIY
DO GETS^DIQ(8989.51,DVBPAR,DVBZ,"I","DVBSIY","DVBERR")
IF $DATA(DVBERR)
QUIT
+7 SET DVBSIEN=""
FOR
SET DVBSIEN=$ORDER(DVBSIY(8989.513,DVBSIEN))
if DVBSIEN=""
QUIT
Begin DoDot:3
+8 NEW DVBENT
SET DVBENT=DVBSIY(8989.513,DVBSIEN,.02,"I")
IF DVBENT'=9.4
QUIT
+9 IF DVBPARAM["XPAR"
QUIT
+10 SET DVBVAL=$$GET^XPAR("ALL",DVBPARAM,1,"Q")
+11 SET DVBLIST(DVBCNT)=DVBPARAM_U_DVBVAL
+12 SET DVBCNT=DVBCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
SPECADD(DVBMSG,DVBNAME) ;
+1 ;adds entry to Special Considerations
+2 IF $GET(DVBNAME)=""
SET DVBMSG="0^Missing Special Considerations name"
QUIT
+3 KILL DVBMSG
SET DVBMSG=""
SET DVBIEN=0
+4 FOR
SET DVBIEN=$ORDER(^DVB(396.25,DVBIEN))
if DVBIEN=""!('DVBIEN)
QUIT
Begin DoDot:1
+5 IF $PIECE(^DVB(396.25,DVBIEN,0),U,1)=DVBNAME
SET DVBMSG="0^Duplicate"
+6 QUIT
End DoDot:1
+7 IF DVBMSG=""
Begin DoDot:1
+8 KILL DIC,DO,DIE,DA,DR,DLAYGO,X,Y
+9 NEW DIERR
+10 SET DIC=396.25
SET DIC(0)="Z"
SET X=DVBNAME
DO FILE^DICN
+11 SET (DA)=+Y
SET DIE=DIC
+12 SET DR=".02////1"
DO ^DIE
+13 IF $DATA(DIERR)
SET DVBMSG="0^Record not added"
+14 IF '$DATA(DIERR)
SET DVBMSG="1^Record added"
+15 KILL DIC,DO,DIE,DA,DR,DLAYGO,X,Y
+16 QUIT
End DoDot:1
+17 QUIT
SPECDIS(DVBMSG,DVBIEN,DVBSTAT) ;
+1 ;disables entry in Special Considerations
+2 NEW DIERR
+3 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+4 IF $GET(DVBIEN)=""
SET DVBMSG="0^Missing IEN"
QUIT
+5 IF $GET(DVBSTAT)=""
SET DVBMSG="0^Missing Status"
QUIT
+6 SET DA=DVBIEN
SET (DLAYGO,DIE)="^DVB(396.25,"
SET DIC(0)="L"
+7 SET DR=".02////"_DVBSTAT
DO ^DIE
+8 IF $DATA(DIERR)
SET DVBMSG="0^Record not disabled"
+9 IF '$DATA(DIERR)
SET DVBMSG="1^Record disabled"
+10 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+11 QUIT
LISTSC(DVBMSG) ;
+1 ;list inactive Special Considerations
+2 NEW DVBIEN,DVBCNT,DVBRET
+3 KILL ^TMP("DVBLSTSC",$JOB)
+4 SET DVBIEN=0
SET DVBCNT=0
+5 FOR
SET DVBIEN=$ORDER(^DVB(396.25,DVBIEN))
if DVBIEN=""!('DVBIEN)
QUIT
Begin DoDot:1
+6 if $GET(^DVB(396.25,DVBIEN,0))=""
QUIT
+7 if $PIECE($GET(^DVB(396.25,DVBIEN,0)),U,2)'=0
QUIT
+8 SET DVBRET(DVBCNT)=$PIECE(^DVB(396.25,DVBIEN,0),"^",1)_"^"_DVBIEN
+9 MERGE ^TMP("DVBLSTSC",$JOB,DVBCNT)=DVBRET(DVBCNT)
+10 SET DVBCNT=DVBCNT+1
End DoDot:1
+11 SET DVBMSG=$NAME(^TMP("DVBLSTSC",$JOB))
+12 QUIT
