DVBCTXML ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 12/4/23 10:33am
;;2.7;AMIE;**250,252**;Apr 10, 1995;Build 92
; Per VHA Directive 6402 this routine should not be modified
; Reference to SUPPORTED PARAMETER TOOL ENTRY POINTS in ICR #2263
; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
Q
;Made changes for CAPRI-11238. JD - 6/17/24
FAILIST(DVBFAIL,DVBDUZ) ; rpc entry to return list of failed xml transmissions
;Added DVBWOI and DVBWON to the list for CAPRI-11238.
N DVBNCT,DVBAUTH,DVBALL,DVBLIST,DVBSTA,DVBNAME,DVBORG,DVBNOW,DVBCOMP,DVBPT,DVBIEN,DVBCT,DVBFLAG,DVBDATE,DVBPATCH,DVBWOI,DVBWON,DVBCMT,DVBCTFLAG
K ^TMP("CAPRI XML LIST",$J) S DVBNCT=""
S DVBALL=1 I '$D(DVBDUZ) S DVBALL=0
S DVBPATCH=3231025,DVBIEN=""
S DVBDATE=DVBPATCH F S DVBDATE=$O(^DVB(396.17,"C",DVBDATE)) Q:DVBDATE="" D
.S DVBIEN="" F S DVBIEN=$O(^DVB(396.17,"C",DVBDATE,DVBIEN)) Q:DVBIEN="" D
..I '$D(^DVB(396.17,DVBIEN,14,"B")) Q
..;Add CMT toggle parameter check CAPRI-10630 RJA 06/26/24
..S DVBCMT=0 D TOGGLE^DVBUTIL(.DVBCMT)
..S DVBCTFLAG=0 D PASCALCHK^DVBCTPDF(.DVBCTFLAG,DVBIEN)
..Q:DVBCMT=1&(DVBCTFLAG="P")!(DVBCMT=2&(DVBCTFLAG="C"))
..;Next 2 lines added for CAPRI-11238.
..S DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I") ;Worksheet originator IEN
..S DVBWON=$$GET1^DIQ(396.17,DVBIEN,"13","E") ;Worksheet originator name
..;Added the Worksheet Originator IEN (DVBWOI) check for CAPRI-11238.
..S DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I") I (DVBALL=1),($G(DVBDUZ)'=DVBAUTH),($G(DVBDUZ)'=DVBWOI) Q
..S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
..S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:DVBCT="" D
...S DVBFLAG=0,DVBINN=""_DVBCT_","_DVBIEN_","_""
...S DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
...I DVBSTA="C" Q
...S DVBORG=$$GET1^DIQ(396.1726,DVBINN,".05","I")
...S DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","I")
...;;Update Reports to remove version on display CAPRI-9567 CP 5/14/24
...I DVBNAME["_" S DVBNAME=$$NAMEUPD^DVBCTPD2(DVBNAME)
...I DVBNAME?.N S DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","E")
...S DVBNOW=$$NOW^XLFDT S DVBDT=$$FMDIFF^XLFDT(DVBNOW,DVBORG,3)
...S DVBCOMP=$P(DVBDT," ",1) I DVBCOMP>=1 S DVBFLAG=1
...S DVBORG=$$FMTE^XLFDT(DVBORG,1)
...;Added the Worksheet Originator (DVBWOI,DVBWON) to the return list for CAPRI-11238.
...S DVBLIST=DVBIEN_U_DVBCT_U_DVBNAME_U_DVBPT_U_DVBORG_U_DVBFLAG_U_DVBWON_";"
...S DVBNCT=DVBNCT+1 M ^TMP("CAPRI XML LIST",$J,DVBNCT)=DVBLIST
...Q
S DVBFAIL=$NA(^TMP("CAPRI XML LIST",$J))
Q
;
FAILXML(DVBXML,DVBIEN,DVBCT) ;
N DVBABCNT,DVBFXML,DVNCT,DVBFXML,DVBABIEN K ^TMP("DVBAXML",$J)
I '$D(^DVB(396.17,DVBIEN)) S DVBXML="0^NO RECORD EXISTS" Q
I '$D(^DVB(396.17,DVBIEN,14,DVBCT)) S DVBXML="0^NO RECORD EXISTS" Q
S DVBABCNT=1,DVBABIEN=0,DVNCT=0
S DVBRTN=$$LOCK(DVBIEN,DVBCT) I DVBRTN=0 S DVBXML="1^LOCKED RECORD" Q
F S DVBABIEN=$O(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABIEN)) Q:'DVBABIEN D
.S DVBFXML=$G(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABCNT,0))
.I DVBABCNT=1 S DVBFXML="1"_U_DVBFXML
.S DVBABCNT=DVBABCNT+1,DVNCT=DVNCT+1 M ^TMP("DVBAXML",$J,DVNCT)=DVBFXML
.Q
S DVBXML=$NA(^TMP("DVBAXML",$J))
D UNLOCK(DVBIEN,DVBCT)
Q
;
SAVEXML(DVBRTN,DVBNAME,DVBCT,DVBCNT,DVBXML,DVBSTAT,DVBRESP,DVBIEN) ;
I $G(DVBCT)="" S DVBCT=1
I $G(DVBCNT)="" S DVBCNT=1
S DVBRESP="Initial Save"
D STATUS(.DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP)
D FILEIN(.DVBRTN,DVBIEN,DVBCT,DVBCNT,.DVBXML)
K DIC,DIE,DA,DR,DLAYGO,X,Y
S DVBRTN=DVBRTN
Q
FILEIN(DVBRTN,DVBIEN,DVBCT,DVBCNT,DVBXML) ;
N DVBERR
D WP^DIE(396.1726,DVBCT_","_DVBIEN_",",.04,"K","DVBXML","DVBERR")
I $D(DVBERR) S DVBRTN=$G(DVBERR) Q
S DVBRTN=DVBRTN
Q
STATUS(DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP) ;
N DVBCNT,DVBDT,DVBNWIEN,DVBINN,DVBTRANS,DVBSTA
S DVBSTA=$S(DVBSTAT=1:"C",1:"E")
I '$D(DVBRESP)!(DVBRESP="")&(DVBSTA="C") S DVBRESP="TRANSMISSION COMPLETE"
S DVBDT=$$NOW^XLFDT,DVBCNT=""
S DVBCNT=$O(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT),-1)
S DVBCNT=$G(DVBCNT)+1
K DIC,DIE,DA,DR,DLAYGO,X,Y
S DA(2)=DVBIEN,DA(1)=DVBCT,X=DVBCNT
S (DLAYGO,DIC)="^DVB(396.17,"_DA(2)_",14,"_DA(1)_",10,",DIC(0)="L"
D ^DIC
S (DA,DVBNWIEN)=+Y
S DIE=DIC
S DR=".01////"_DVBNWIEN_";.02////"_DVBDT_";.03////"_DUZ_";.04////"_DVBRESP
D ^DIE K DIE,DIC,DA,DR,DLAYGO,X,Y
S DVBINN=""_DVBCT_","_DVBIEN_","_""
S DVBTRANS=$$GET1^DIQ(396.1726,DVBINN,".07","I")
I DVBRESP'="Initial Save" S DVBTRANS=$G(DVBTRANS)+1
S DA(1)=DVBIEN,DA=DVBCT
S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",14,",DIC(0)="L"
D ^DIC
S DIE=DIC
S DR=".01////"_DVBCT_";.07////"_DVBTRANS_";.02////"_DVBSTA
D ^DIE
I DVBSTA="C" S DR=".09////"_DVBDT D ^DIE
I $G(DVBNAME)'="" S DR=".03////"_DVBNAME D ^DIE
I DVBRESP="Initial Save" S DR=".05////"_DVBDT D ^DIE
S DVBRTN=1 I $D(DIERR) S DVBRTN=0
D UNLOCK(DVBIEN,DVBCT)
K DIC,DIE,DIERR,DA,DR,DLAYGO,X
Q
;
LOCK(DVBIEN,DVBCT) ;
L +^DVB(396.17,DVBIEN,14,DVBCT,3):30
S DVBRTN=$T
Q DVBRTN
;
UNLOCK(DVBIEN,DVBCT) ;
L -^DVB(396.17,DVBIEN,14,DVBCT,3)
Q
;
FAILCHK(DVBRTN) ;
K DVBRTN S DVBRTN=0,DVBPATCH=3231025
S DVBDATE=DVBPATCH F S DVBDATE=$O(^DVB(396.17,"C",DVBDATE)) Q:(DVBDATE="")!(DVBRTN=1) D
.S DVBIEN="" F S DVBIEN=$O(^DVB(396.17,"C",DVBDATE,DVBIEN)) Q:(DVBIEN="")!(DVBRTN=1) D
..I $D(^DVB(396.17,DVBIEN,14,"B")) D
...S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:(DVBCT="")!(DVBRTN=1) D
....S DVBINN=""_DVBCT_","_DVBIEN_","_""
....S DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
....I DVBSTA'="C" S DVBRTN=1
Q
GITHUB(DVBRTN) ;
S DVBRTN=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB LINK")
Q
GITTOK(DVBRTN) ;
N DVBTOK,DVBAPP,DVBID,DVBRET,DVBCT,DVBCNT
K ^TMP("DVBTOKEN",$J)
S DVBAPP=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB APP ID")
S DVBID=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB INSTALL ID")
D GETWP^XPAR(.DVBTOK,"PKG","DVBAB CAPRI GITHUB TOKEN")
S DVBCT=0,DVBCNT=0 F S DVBCT=$O(DVBTOK(DVBCT)) Q:DVBCT="" D
.I DVBCNT=0 D
..S DVBCT=0,DVBRET(DVBCNT)=DVBAPP_U_DVBID
..M ^TMP("DVBTOKEN",$J,DVBCNT)=DVBRET(DVBCNT) S DVBCNT=DVBCNT+1,DVBCT=DVBCT+1
..Q
.S DVBRET(DVBCNT)=DVBTOK(DVBCT,0)
.S DVBRET(DVBCNT)=DVBTOK(DVBCT,0) M ^TMP("DVBTOKEN",$J,DVBCNT)=DVBRET(DVBCNT)
.S DVBCNT=DVBCNT+1
.Q
S DVBRTN=$NA(^TMP("DVBTOKEN",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCTXML 6274 printed Aug 26, 2025@22:04:52 Page 2
DVBCTXML ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 12/4/23 10:33am
+1 ;;2.7;AMIE;**250,252**;Apr 10, 1995;Build 92
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; Reference to SUPPORTED PARAMETER TOOL ENTRY POINTS in ICR #2263
+4 ; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
+5 QUIT
+6 ;Made changes for CAPRI-11238. JD - 6/17/24
FAILIST(DVBFAIL,DVBDUZ) ; rpc entry to return list of failed xml transmissions
+1 ;Added DVBWOI and DVBWON to the list for CAPRI-11238.
+2 NEW DVBNCT,DVBAUTH,DVBALL,DVBLIST,DVBSTA,DVBNAME,DVBORG,DVBNOW,DVBCOMP,DVBPT,DVBIEN,DVBCT,DVBFLAG,DVBDATE,DVBPATCH,DVBWOI,DVBWON,DVBCMT,DVBCTFLAG
+3 KILL ^TMP("CAPRI XML LIST",$JOB)
SET DVBNCT=""
+4 SET DVBALL=1
IF '$DATA(DVBDUZ)
SET DVBALL=0
+5 SET DVBPATCH=3231025
SET DVBIEN=""
+6 SET DVBDATE=DVBPATCH
FOR
SET DVBDATE=$ORDER(^DVB(396.17,"C",DVBDATE))
if DVBDATE=""
QUIT
Begin DoDot:1
+7 SET DVBIEN=""
FOR
SET DVBIEN=$ORDER(^DVB(396.17,"C",DVBDATE,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:2
+8 IF '$DATA(^DVB(396.17,DVBIEN,14,"B"))
QUIT
+9 ;Add CMT toggle parameter check CAPRI-10630 RJA 06/26/24
+10 SET DVBCMT=0
DO TOGGLE^DVBUTIL(.DVBCMT)
+11 SET DVBCTFLAG=0
DO PASCALCHK^DVBCTPDF(.DVBCTFLAG,DVBIEN)
+12 if DVBCMT=1&(DVBCTFLAG="P")!(DVBCMT=2&(DVBCTFLAG="C"))
QUIT
+13 ;Next 2 lines added for CAPRI-11238.
+14 ;Worksheet originator IEN
SET DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I")
+15 ;Worksheet originator name
SET DVBWON=$$GET1^DIQ(396.17,DVBIEN,"13","E")
+16 ;Added the Worksheet Originator IEN (DVBWOI) check for CAPRI-11238.
+17 SET DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
IF (DVBALL=1)
IF ($GET(DVBDUZ)'=DVBAUTH)
IF ($GET(DVBDUZ)'=DVBWOI)
QUIT
+18 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+19 SET DVBCT=0
FOR
SET DVBCT=$ORDER(^DVB(396.17,DVBIEN,14,"B",DVBCT))
if DVBCT=""
QUIT
Begin DoDot:3
+20 SET DVBFLAG=0
SET DVBINN=""_DVBCT_","_DVBIEN_","_""
+21 SET DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
+22 IF DVBSTA="C"
QUIT
+23 SET DVBORG=$$GET1^DIQ(396.1726,DVBINN,".05","I")
+24 SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","I")
+25 ;;Update Reports to remove version on display CAPRI-9567 CP 5/14/24
+26 IF DVBNAME["_"
SET DVBNAME=$$NAMEUPD^DVBCTPD2(DVBNAME)
+27 IF DVBNAME?.N
SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN,".03","E")
+28 SET DVBNOW=$$NOW^XLFDT
SET DVBDT=$$FMDIFF^XLFDT(DVBNOW,DVBORG,3)
+29 SET DVBCOMP=$PIECE(DVBDT," ",1)
IF DVBCOMP>=1
SET DVBFLAG=1
+30 SET DVBORG=$$FMTE^XLFDT(DVBORG,1)
+31 ;Added the Worksheet Originator (DVBWOI,DVBWON) to the return list for CAPRI-11238.
+32 SET DVBLIST=DVBIEN_U_DVBCT_U_DVBNAME_U_DVBPT_U_DVBORG_U_DVBFLAG_U_DVBWON_";"
+33 SET DVBNCT=DVBNCT+1
MERGE ^TMP("CAPRI XML LIST",$JOB,DVBNCT)=DVBLIST
+34 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+35 SET DVBFAIL=$NAME(^TMP("CAPRI XML LIST",$JOB))
+36 QUIT
+37 ;
FAILXML(DVBXML,DVBIEN,DVBCT) ;
+1 NEW DVBABCNT,DVBFXML,DVNCT,DVBFXML,DVBABIEN
KILL ^TMP("DVBAXML",$JOB)
+2 IF '$DATA(^DVB(396.17,DVBIEN))
SET DVBXML="0^NO RECORD EXISTS"
QUIT
+3 IF '$DATA(^DVB(396.17,DVBIEN,14,DVBCT))
SET DVBXML="0^NO RECORD EXISTS"
QUIT
+4 SET DVBABCNT=1
SET DVBABIEN=0
SET DVNCT=0
+5 SET DVBRTN=$$LOCK(DVBIEN,DVBCT)
IF DVBRTN=0
SET DVBXML="1^LOCKED RECORD"
QUIT
+6 FOR
SET DVBABIEN=$ORDER(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+7 SET DVBFXML=$GET(^DVB(396.17,DVBIEN,14,DVBCT,3,DVBABCNT,0))
+8 IF DVBABCNT=1
SET DVBFXML="1"_U_DVBFXML
+9 SET DVBABCNT=DVBABCNT+1
SET DVNCT=DVNCT+1
MERGE ^TMP("DVBAXML",$JOB,DVNCT)=DVBFXML
+10 QUIT
End DoDot:1
+11 SET DVBXML=$NAME(^TMP("DVBAXML",$JOB))
+12 DO UNLOCK(DVBIEN,DVBCT)
+13 QUIT
+14 ;
SAVEXML(DVBRTN,DVBNAME,DVBCT,DVBCNT,DVBXML,DVBSTAT,DVBRESP,DVBIEN) ;
+1 IF $GET(DVBCT)=""
SET DVBCT=1
+2 IF $GET(DVBCNT)=""
SET DVBCNT=1
+3 SET DVBRESP="Initial Save"
+4 DO STATUS(.DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP)
+5 DO FILEIN(.DVBRTN,DVBIEN,DVBCT,DVBCNT,.DVBXML)
+6 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+7 SET DVBRTN=DVBRTN
+8 QUIT
FILEIN(DVBRTN,DVBIEN,DVBCT,DVBCNT,DVBXML) ;
+1 NEW DVBERR
+2 DO WP^DIE(396.1726,DVBCT_","_DVBIEN_",",.04,"K","DVBXML","DVBERR")
+3 IF $DATA(DVBERR)
SET DVBRTN=$GET(DVBERR)
QUIT
+4 SET DVBRTN=DVBRTN
+5 QUIT
STATUS(DVBRTN,DVBIEN,DVBCT,DVBNAME,DVBSTAT,DVBRESP) ;
+1 NEW DVBCNT,DVBDT,DVBNWIEN,DVBINN,DVBTRANS,DVBSTA
+2 SET DVBSTA=$SELECT(DVBSTAT=1:"C",1:"E")
+3 IF '$DATA(DVBRESP)!(DVBRESP="")&(DVBSTA="C")
SET DVBRESP="TRANSMISSION COMPLETE"
+4 SET DVBDT=$$NOW^XLFDT
SET DVBCNT=""
+5 SET DVBCNT=$ORDER(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT),-1)
+6 SET DVBCNT=$GET(DVBCNT)+1
+7 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+8 SET DA(2)=DVBIEN
SET DA(1)=DVBCT
SET X=DVBCNT
+9 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(2)_",14,"_DA(1)_",10,"
SET DIC(0)="L"
+10 DO ^DIC
+11 SET (DA,DVBNWIEN)=+Y
+12 SET DIE=DIC
+13 SET DR=".01////"_DVBNWIEN_";.02////"_DVBDT_";.03////"_DUZ_";.04////"_DVBRESP
+14 DO ^DIE
KILL DIE,DIC,DA,DR,DLAYGO,X,Y
+15 SET DVBINN=""_DVBCT_","_DVBIEN_","_""
+16 SET DVBTRANS=$$GET1^DIQ(396.1726,DVBINN,".07","I")
+17 IF DVBRESP'="Initial Save"
SET DVBTRANS=$GET(DVBTRANS)+1
+18 SET DA(1)=DVBIEN
SET DA=DVBCT
+19 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",14,"
SET DIC(0)="L"
+20 DO ^DIC
+21 SET DIE=DIC
+22 SET DR=".01////"_DVBCT_";.07////"_DVBTRANS_";.02////"_DVBSTA
+23 DO ^DIE
+24 IF DVBSTA="C"
SET DR=".09////"_DVBDT
DO ^DIE
+25 IF $GET(DVBNAME)'=""
SET DR=".03////"_DVBNAME
DO ^DIE
+26 IF DVBRESP="Initial Save"
SET DR=".05////"_DVBDT
DO ^DIE
+27 SET DVBRTN=1
IF $DATA(DIERR)
SET DVBRTN=0
+28 DO UNLOCK(DVBIEN,DVBCT)
+29 KILL DIC,DIE,DIERR,DA,DR,DLAYGO,X
+30 QUIT
+31 ;
LOCK(DVBIEN,DVBCT) ;
+1 LOCK +^DVB(396.17,DVBIEN,14,DVBCT,3):30
+2 SET DVBRTN=$TEST
+3 QUIT DVBRTN
+4 ;
UNLOCK(DVBIEN,DVBCT) ;
+1 LOCK -^DVB(396.17,DVBIEN,14,DVBCT,3)
+2 QUIT
+3 ;
FAILCHK(DVBRTN) ;
+1 KILL DVBRTN
SET DVBRTN=0
SET DVBPATCH=3231025
+2 SET DVBDATE=DVBPATCH
FOR
SET DVBDATE=$ORDER(^DVB(396.17,"C",DVBDATE))
if (DVBDATE="")!(DVBRTN=1)
QUIT
Begin DoDot:1
+3 SET DVBIEN=""
FOR
SET DVBIEN=$ORDER(^DVB(396.17,"C",DVBDATE,DVBIEN))
if (DVBIEN="")!(DVBRTN=1)
QUIT
Begin DoDot:2
+4 IF $DATA(^DVB(396.17,DVBIEN,14,"B"))
Begin DoDot:3
+5 SET DVBCT=0
FOR
SET DVBCT=$ORDER(^DVB(396.17,DVBIEN,14,"B",DVBCT))
if (DVBCT="")!(DVBRTN=1)
QUIT
Begin DoDot:4
+6 SET DVBINN=""_DVBCT_","_DVBIEN_","_""
+7 SET DVBSTA=$$GET1^DIQ(396.1726,DVBINN,".02","I")
+8 IF DVBSTA'="C"
SET DVBRTN=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
GITHUB(DVBRTN) ;
+1 SET DVBRTN=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB LINK")
+2 QUIT
GITTOK(DVBRTN) ;
+1 NEW DVBTOK,DVBAPP,DVBID,DVBRET,DVBCT,DVBCNT
+2 KILL ^TMP("DVBTOKEN",$JOB)
+3 SET DVBAPP=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB APP ID")
+4 SET DVBID=$$GET^XPAR("PKG","DVBAB CAPRI GITHUB INSTALL ID")
+5 DO GETWP^XPAR(.DVBTOK,"PKG","DVBAB CAPRI GITHUB TOKEN")
+6 SET DVBCT=0
SET DVBCNT=0
FOR
SET DVBCT=$ORDER(DVBTOK(DVBCT))
if DVBCT=""
QUIT
Begin DoDot:1
+7 IF DVBCNT=0
Begin DoDot:2
+8 SET DVBCT=0
SET DVBRET(DVBCNT)=DVBAPP_U_DVBID
+9 MERGE ^TMP("DVBTOKEN",$JOB,DVBCNT)=DVBRET(DVBCNT)
SET DVBCNT=DVBCNT+1
SET DVBCT=DVBCT+1
+10 QUIT
End DoDot:2
+11 SET DVBRET(DVBCNT)=DVBTOK(DVBCT,0)
+12 SET DVBRET(DVBCNT)=DVBTOK(DVBCT,0)
MERGE ^TMP("DVBTOKEN",$JOB,DVBCNT)=DVBRET(DVBCNT)
+13 SET DVBCNT=DVBCNT+1
+14 QUIT
End DoDot:1
+15 SET DVBRTN=$NAME(^TMP("DVBTOKEN",$JOB))
+16 QUIT
