DVBCTPDF ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 3/19/25 10:47am
;;2.7;AMIE;**252,254**;Apr 10, 1995;Build 41
; Per VHA Directive 6402 this routine should not be modified
; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
Q
;
;Added Acceptable Clinical Evidence (ACE) to the list of returned items for CAPRI-13939. JD - 10/3/24
;Updating to store Save Message, Version, and User CAPRI-11245 CP 6/21/24
;Made changes for CAPRI-11238. JD - 6/19/24
;Made changes for CAPRI-11207. JD - 6/13/24.
;Made changes for CAPRI-10057. JD - 5/1/24.
FAILPDF(DVBPDF,DVBIEN,DVBCT) ; CAPRI-17770 CP 4/3/25
;;RPC DVBA CAPRI GET DBQ PDF pulls latest version of single Exam, noneditable
;;Routine locks exam not worksheet
N DVBABCNT,DVBFPDF,DVBNCT,DVBABIEN,DVBSV,DVBEXCT,DVBEXNM,DVBLSTNM
K ^TMP("DVBAPDF",$J)
S DVBEXCT=0
S DVBEXNM=$G(^DVB(396.17,DVBIEN,14,DVBCT,2))
S DVBSEQ=$P($G(^DVB(396.17,DVBIEN,1,0)),U,3)
F DVBI=1:1:DVBSEQ Q:DVBEXCT'=0 D
. S DVBLSTNM=$P($G(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
. I DVBLSTNM=DVBEXNM S DVBEXCT=DVBI
;Next two lines added for CAPRI-10057.
S DVBSV=$P($G(^DVB(396.17,DVBIEN,1,DVBEXCT,0)),U,3) ;Get the latest save number for the given exam.
I '$G(DVBSV) S DVBPDF="" Q
;
S DVBABCNT=1,DVBABIEN=0,DVBNCT=0
S DVBRTN=$$LOCK(DVBIEN,DVBSV) I DVBRTN=0 S DVBPDF="1^LOCKED RECORD" Q
;In the following 2 lines replaced 14,DVBCT,7 with 15,DVBSV,2. CAPRI-10057
F S DVBABIEN=$O(^DVB(396.17,DVBIEN,15,DVBSV,2,DVBABIEN)) Q:'DVBABIEN D
.S DVBFPDF=$G(^DVB(396.17,DVBIEN,15,DVBSV,2,DVBABCNT,0))
.I DVBABCNT=1 S DVBFPDF="1"_U_DVBFPDF
.S DVBABCNT=DVBABCNT+1,DVBNCT=DVBNCT+1 M ^TMP("DVBAPDF",$J,DVBNCT)=DVBFPDF
.Q
S DVBPDF=$NA(^TMP("DVBAPDF",$J))
D UNLOCK(DVBIEN,DVBSV)
Q
LOCK(DVBIEN,DVBSV) ;
L +^DVB(396.17,DVBIEN,15,DVBSV,2):$G(DILOCKTM)
S DVBRTN=$T
Q DVBRTN
UNLOCK(DVBIEN,DVBSV) ;
L -^DVB(396.17,DVBIEN,15,DVBSV,2)
Q
PDFRTN(DVBRTN,DVBARRAY) ;
;;RPC DVBA CAPRI GET EXAM PDF used to pull PDF details, Exam can be edited.
;;Worksheet is locked before this call
N DVBIEN,DVBTAB,DVBCT,DVBPTR,DVBNM,DVBTABIO,DVBPDF,DVBCNT,DVBAIEN
K ^TMP("DVBAPDFEDIT",$J)
I '$D(DVBARRAY) S DVBRTN="0^MISSING DATA" Q
S DVBIEN=$P(DVBARRAY,U),DVBCNT=1
S DVBNM=$P($G(DVBARRAY),U,2) I DVBNM="" Q
S DVBAIEN=0 F S DVBAIEN=$O(^DVB(396.17,DVBIEN,1,DVBAIEN)) Q:DVBAIEN="" D
.I $P($G(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",2)'=DVBNM Q
.S DVBPTR=$P($G(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",3) I DVBPTR=0 Q
.;;CAPRI-11245 CP 6/21/24
.S DVBTAB=$P($P($G(^DVB(396.17,DVBIEN,15,DVBPTR,1)),"^",3),"|",1)
.S DVBTABIO=DVBAIEN_U_DVBTAB_U_DVBNM
.S DVBCNT=DVBCNT+1 M ^TMP("DVBAPDFEDIT",$J,DVBCNT)=DVBTABIO
.S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,15,DVBPTR,2,DVBCT)) Q:DVBCT="" D
..S DVBPDF=$G(^DVB(396.17,DVBIEN,15,DVBPTR,2,DVBCT,0))
..S DVBCNT=DVBCNT+1 M ^TMP("DVBAPDFEDIT",$J,DVBCNT)=DVBPDF
..Q
S DVBRTN=$NA(^TMP("DVBAPDFEDIT",$J))
Q
PDFEXAM(DVBRTN,DVBIEN) ;
;Added DVBACE to the list for CAPRI-13939.
;RPC DVBA CAPRI GET WORKSHEET
N DVBACE,DVBCT,DVBSTAT,DVBPT,DVBAUTH,DVBUPD,DVBVHA,DVBIEPD,DVBPDF,DVBCNT
;Added DVBWOI and DVBWON to the list for CAPRI-11238.
N DVBAUTHNM,DVBTRANSID,DVBTRANSNM,DVBPTNM,DVBLOCK,DVBWOI,DVBWON,DVBSSN
K ^TMP("DVBAPDFLST",$J)
I '$D(DVBIEN) S DVBRTN="0^MISSING DATA" Q
;BG CAPRI-8883 added lock
S DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,"11","I")
S DVBLOCK=$S(DVBSTAT="A":"L",DVBSTAT="S":"L",DVBSTAT="P":"L",DVBSTAT="D":"L",1:"U")
I DVBLOCK="L" D LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
I $G(DVBLRTN)["-1" M ^TMP("DVBAPDFLST",$J,1)=DVBLRTN S DVBRTN=$NA(^TMP("DVBAPDFLST",$J)) Q
S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","I")
;;Adding SSN to return CP 1-28-25 CAPRI-16034
S DVBSSN=$$GET1^DIQ(2,DVBPT,".09","I")
S DVBPTNM=$$GET1^DIQ(396.17,DVBIEN,".01","E")
S DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
S DVBAUTHNM=$$GET1^DIQ(396.17,DVBIEN,"2","E")
S DVBUPD=$$GET1^DIQ(396.17,DVBIEN,"4","I")
S DVBVHA=$$GET1^DIQ(396.17,DVBIEN,"25","I")
S DVBIEPD=$$GET1^DIQ(396.17,DVBIEN,"12","I")
S DVBTRANSID=$$GET1^DIQ(396.17,DVBIEN,"10","I")
S DVBTRANSNM=$$GET1^DIQ(396.17,DVBIEN,"10","E")
;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
;Next line added for CAPRI-13939.
S DVBACE=$$GET1^DIQ(396.17,DVBIEN,"1","I") ;Acceptable Clinical Evidence (ACE)
I $G(DVBTRANSID)="" S DVBTRANSID="N/A",DVBTRANSNM="N/A"
S DVBCNT=1
;Added the Worksheet Originator (DVBWOI,DVBWON) to the return list for CAPRI-11238.
;Added Acceptable Clinical Evidence (ACE) to the return list for CAPRI-13939.
;;Adding SSN to return CP 1-28-25 CAPRI-16034
S DVBPDF=DVBIEN_U_DVBSTAT_U_DVBPT_U_DVBPTNM_U_DVBAUTH_U_DVBAUTHNM_U_DVBUPD_U_DVBVHA_U_DVBIEPD_U_DVBTRANSID_U_DVBTRANSNM_U_DVBWOI_U_DVBWON_U_DVBACE_U_DVBSSN
M ^TMP("DVBAPDFLST",$J,DVBCNT)=DVBPDF
S DVBAIEN=0 F S DVBAIEN=$O(^DVB(396.17,DVBIEN,1,DVBAIEN)) Q:DVBAIEN="" D
.S DVBPTR=$P($G(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",3) I DVBPTR="" Q
.S DVBNM=$P($G(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",2) I DVBNM["*DEL*" Q
.;;CAPRI-11245 CP 6/21/24
.S DVBTAB=$P($P($G(^DVB(396.17,DVBIEN,15,DVBPTR,1)),"^",3),"|",1)
.S DVBPDF=DVBAIEN_U_DVBTAB_U_DVBNM
.S DVBCNT=DVBCNT+1 M ^TMP("DVBAPDFLST",$J,DVBCNT)=DVBPDF
S DVBRTN=$NA(^TMP("DVBAPDFLST",$J))
Q
CREATE(DVBRTN,DVBDATA,DVBEXAMLIST) ;
;Updates to remove validation Errors 2-19-25 CP CAPRI-16472
;RPC DVBA CAPRI CREATE WORKSHEET
N DVBPATIENT,DVBAUTHOR,DVBIEPDVER,DVBDBQREF,DVBTRANSCRIB,DVBFORMNAME,DVBDTTM,DVBEXAMCNT
N DVBEXAMSEQ,DVBEXAMNAME,DVBIEN,DVBI,DVBRTDAT,DVBCKDAT
S DVBPATIENT=$G(DVBDATA(1))
I DVBPATIENT="" S DVBRTN="-1^Missing Patient Details" Q
S DVBAUTHOR=$G(DVBDATA(2))
I DVBAUTHOR="" S DVBRTN="-1^Missing Author Details" Q
S DVBIEPDVER=$G(DVBDATA(3))
S DVBDBQREF=$G(DVBDATA(4))
S DVBTRANSCRIB=$G(DVBDATA(5))
S DVBFORMNAME=$G(DVBDATA(6))
I $G(DVBEXAMLIST(1))="" S DVBRTN="-1^Invalid Exam Name/List" Q
S (DVBRTDAT,DVBCKDAT)=""
;
S DVBDTTM=$$NOW^XLFDT
K DIC,DIE,DA,DR,X,Y,DO
S DR="2////"_DVBAUTHOR_";3////"_DVBDTTM_";4////"_DVBDTTM_";5////2800101"_";9////"_DVBFORMNAME
S DR=DR_";10////"_DVBTRANSCRIB_";11////D"_";12////"_DVBIEPDVER_";19////N"_";25////"_DVBDBQREF_";13////"_DVBAUTHOR
;S DR=DR_";32////"_$S($$GET^XPAR("PKG","DVBAB CAPRI EMS TOGGLE",1,"I")=2:"E",1:"C") ;CAPRI-19608:NGC
S DIC("DR")=DR
S DIC=396.17,DIC(0)="Z",X=DVBPATIENT
D FILE^DICN
I Y=-1 K DIC S DVBRTN="-1^New Entry not Built" Q
S DA=$P($G(Y),U,1)
S DVBRTDAT=$G(Y(0))
S DVBCKDAT=DVBPATIENT_U_DVBAUTHOR_U_DVBDTTM_U_DVBDTTM_U_"2800101"_U_DVBAUTHOR
I DVBRTDAT="",DVBRTDAT'=DVBCKDAT S DIK="^DVB(396.17,",DA=$G(DA) D ^DIK S DVBRTN="-1^Details not Saved" Q
S DVBRTN(0)=DA
K DIK,DIC,DIE,DA,DR,X,Y
;
;
N DVBERR
S (DVBEXAMCNT,DVBEXAMSEQ)=""
S DVBEXAMCNT=$O(DVBEXAMLIST(DVBEXAMCNT),-1)
F DVBI=1:1:DVBEXAMCNT Q:$G(DVBEXAMLIST(DVBI))="" D
. S DVBEXAMNAME=$G(DVBEXAMLIST(DVBI))
. S DVBIEN=$G(DVBRTN(0))
. S DVBEXAMSEQ(DVBI)=DVBI_"^"_DVBEXAMNAME_"^0"
. K DIC,DIE,DA,DR,DLAYGO,X,Y
. S DA(1)=DVBIEN,(DA,X)=DVBI
. S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",1,",DIC(0)="L"
. D ^DIC
. S DVBRTN(DVBI)=DVBI_":"_DVBEXAMNAME
. Q
D WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
I $D(DVBERR) S DVBRTN="-1^Data Not Saved" Q
;BG CAPRI-8883 added lock
D LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
I $G(DVBLRTN)["-1" S DVBRTN=DVBLRTN Q
K DIC,DIE,DA,DR,DLAYGO,X,Y
Q
PDFSAVE(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME,DVBPDFDATA,DVBTABIO,DVBSMSG,DVBVER) ;
;RPC: DVBA CAPRI SAVE EXAM PDF
;Updates CAPRI-16627 CP 5/10/25
N DVBDTTM,DVBSAVESEQ,DVBNEXTSEQ,DVBPRESAVE,DVBPRENAME,DVBAFDA,DVBLRTN,DVBPN2,DVBEN2,DVBSAVECMT
I $D(DVBSMSG)=0 S DVBSMSG=""
I $D(DVBVER)=0 S DVBVER=""
K DIC,DIE,DA,DR,DLAYGO,X,Y
N DVBERR
;;CAPRI-11245 CP 6/21/24
S DVBSAVECMT=DVBTABIO_"|"_DVBSMSG_"|"_DVBVER_"|"_DUZ
S DVBDTTM=$$NOW^XLFDT
S DVBSAVESEQ=$P($G(^DVB(396.17,DVBIEN,15,0)),"^",3)
S DA(1)=DVBIEN,(DA,X)=DVBSAVESEQ+1
;;Adding Z to correct xref CP
S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",15,",DIC(0)="LZ"
S DIC("DR")=".01////"_DVBSEQ_";.02////"_DVBDTTM_";.03////"_DVBEXAMNAME_";.04////"_DVBSAVECMT
D FILE^DICN
I Y=-1 K DIC S DVBRTN="-1^New version not saved" Q
S DVBNEXTSEQ=+Y
I $$GET1^DIQ(396.1727,DVBNEXTSEQ_","_DVBIEN,.02,"I")'=DVBDTTM S DVBRTN="-1^Sequence, Date/Time, Exam Name data Not Saved" Q
D WP^DIE(396.1727,DVBNEXTSEQ_","_DVBIEN_",",.05,"K","DVBPDFDATA","DVBERR")
I $D(DVBERR) S DVBRTN="-1^PDF data not saved" Q
S DVBAFDA(396.17,DVBIEN_",",4)=DVBDTTM
K DVBERR D FILE^DIE(,"DVBAFDA","DVBERR")
I $D(DVBERR) S DVBRTN="-1^Date/Time data not saved" Q
S DVBPRESAVE=$G(^DVB(396.17,DVBIEN,1,DVBSEQ,0),"")
I DVBPRESAVE="" S DVBRTN="-1^Incorrect Seq Number" Q
S DVBPRENAME=$P(DVBPRESAVE,"^",2)
;;Updating to not compare version CAPRI-10405 CP
S DVBPN2=$$NAMEUPD^DVBCTPD2(DVBPRENAME)
S DVBEN2=$$NAMEUPD^DVBCTPD2(DVBEXAMNAME)
I DVBPN2'=DVBEN2 S DVBRTN="-1^Mismatch Exam Name" Q
I DVBPN2=DVBEN2 S ^DVB(396.17,DVBIEN,1,DVBSEQ,0)=DVBSEQ_"^"_DVBEXAMNAME_"^"_DVBNEXTSEQ,DVBRTN="1"
Q
PASCALCHK(DVBRTN,DVBIEN) ;
;RPC DVBA CAPRI PASCAL CHECK
I '$D(DVBIEN) S DVBRTN="-1^MISSING DATA" Q
I $D(^DVB(396.17,DVBIEN,3)) S DVBRTN="P" Q
I '$D(^DVB(396.17,DVBIEN,3)) S DVBRTN="C"
Q
PDFLST(DVBRTN,DVBIEN) ;
;RPC: DVBA CAPRI GET WORKSHEET LIST
;Update for CMT/PASCAL flag 4-22-24 CP CAPRI 9826
;Added DVBWON to the list for CAPRI-11238.
;Update for VHA Internal DBQ Referral DVBIR RJA 250401 CAPRI-17618
N DVBNCT,DVBNNCT,DVBAUTH,DVBSTAT,DVBNAME,DVBNM,DVBPT,DVBPIEN,DVBAIEN,DVBWSIEN,DVBSDT,DVBPDF,DVBNFLG,DVBGFLG,DVBXFLG,DVBCPFLG,DVBWON,DVBIR
K ^TMP("DVBPDFLST",$J) S DVBNCT=0
I '$D(DVBIEN) S DVBRTN="0^MISSING DATA" Q
I $D(^DVB(396.17,"B",DVBIEN))<10 S DVBRTN="0^NO WORKSHEETS" Q
S DVBWSIEN=0 F S DVBWSIEN=$O(^DVB(396.17,"B",DVBIEN,DVBWSIEN)) Q:DVBWSIEN="" D
.S DVBNCT=DVBNCT+1
.S DVBAUTH=$$GET1^DIQ(396.17,DVBWSIEN,"2","E")
.S DVBNAME=$$GET1^DIQ(396.17,DVBWSIEN,"9","I")
.S DVBSTAT=$$GET1^DIQ(396.17,DVBWSIEN,"11","I")
.S DVBPT=$$GET1^DIQ(396.17,DVBWSIEN,".01","E")
.S DVBSDT=$$GET1^DIQ(396.17,DVBWSIEN,"5","E")
.S DVBNFLG=$$GET1^DIQ(396.17,DVBWSIEN,"19","E")
.S DVBGFLG=$$GET1^DIQ(396.17,DVBWSIEN,"20","E")
.S DVBXFLG=$$GET1^DIQ(396.17,DVBWSIEN,"21","E")
.;Next line added for CAPRI-11238.
.S DVBWON=$$GET1^DIQ(396.17,DVBWSIEN,"13","E") ;Worksheet originator name
.S DVBIR=$$GET1^DIQ(396.17,DVBWSIEN,"25","E") ;VHA Internal DBQ Referral
.S DVBCPFLG=$S($D(^DVB(396.17,DVBWSIEN,3))>9:"P",1:"C")
.S DVBPDF=$G(DVBWSIEN)_U_$G(DVBPT)_U_$G(DVBNAME)_U_$G(DVBSDT)_U_$G(DVBAUTH)_U_$G(DVBSTAT)_U_$G(DVBNFLG)_U_$G(DVBGFLG)_U_$G(DVBXFLG)_U_$G(DVBCPFLG)_U_$G(DVBWON)_U_$G(DVBIR)
.S ^TMP("DVBPDFLST",$J,DVBNCT)=DVBPDF
.S DVBAIEN=0 F S DVBAIEN=$O(^DVB(396.17,DVBWSIEN,1,DVBAIEN)) Q:DVBAIEN="" D
..S DVBPTR=$P($G(^DVB(396.17,DVBWSIEN,1,DVBAIEN,0)),"^",3) I DVBPTR="" Q
..S DVBNM=$P($G(^DVB(396.17,DVBWSIEN,1,DVBAIEN,0)),"^",2) I DVBNM["*DEL*" Q
..;;CAPRI-11245 CP 6/21/24
..S DVBTAB=$P($P($G(^DVB(396.17,DVBWSIEN,15,DVBPTR,1)),"^",3),"|",1)
..S DVBPDF=DVBAIEN_U_DVBTAB_U_DVBNM
..S DVBNCT=DVBNCT+1 M ^TMP("DVBPDFLST",$J,DVBNCT)=DVBPDF
S DVBRTN=$NA(^TMP("DVBPDFLST",$J))
Q
DELCHECK(DVBRTN,DVBIEN) ;
;RPC DVBA CAPRI DELETE CHECK
;CAPRI-16627 CP 4-11-25
;Added DVBWOI to the list for CAPRI-11238.
N DVBAUTH,DVBTRS,DVBKY,DVBWOI,DVBFLAG
S DVBFLAG=0
I '$D(DVBIEN) S DVBRTN="-1^MISSING IEN" Q
;BG CAPRI-8883 added lock
D LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
I $G(DVBLRTN)["-1" S DVBRTN=DVBLRTN Q
D OWNSKEY^XUSRB(.DVBKY,"DVBAB CPWM REVIEWER",DUZ)
I $G(DVBKY(0)) S DVBFLAG=1
I $P($G(^VA(200,DUZ,0)),U,4)="@" S DVBFLAG=1
S DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
S DVBTRS=$$GET1^DIQ(396.17,DVBIEN,"10","I")
S DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I")
;Added the Worksheet Originator IEN (DVBWOI) check for CAPRI-11238.
I (DVBFLAG'=1),(DUZ'=DVBAUTH),(DUZ'=DVBTRS),(DUZ'=DVBWOI) S DVBRTN="-1^Unable to delete, User is not Document Manager, Transcriber or Worksheet Originator" Q
S DVBRTN=1
Q
DELETE(DVBRTN,DVBIEN) ;
;RPC DVBA CAPRI DELETE WORKSHEET
N FDA,DVBERR
I '$D(DVBIEN) S DVBRTN="-1^MISSING IEN" Q
S FDA(396.17,DVBIEN_",",.01)="@"
D FILE^DIE("","FDA","DVBERR")
I '$D(DVBERR) S DVBRTN=1
I $D(DVBERR) S DVBRTN="-1^Unable to delete"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCTPDF 12422 printed Sep 23, 2025@19:25:01 Page 2
DVBCTPDF ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 3/19/25 10:47am
+1 ;;2.7;AMIE;**252,254**;Apr 10, 1995;Build 41
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; Reference to $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
+4 QUIT
+5 ;
+6 ;Added Acceptable Clinical Evidence (ACE) to the list of returned items for CAPRI-13939. JD - 10/3/24
+7 ;Updating to store Save Message, Version, and User CAPRI-11245 CP 6/21/24
+8 ;Made changes for CAPRI-11238. JD - 6/19/24
+9 ;Made changes for CAPRI-11207. JD - 6/13/24.
+10 ;Made changes for CAPRI-10057. JD - 5/1/24.
FAILPDF(DVBPDF,DVBIEN,DVBCT) ; CAPRI-17770 CP 4/3/25
+1 ;;RPC DVBA CAPRI GET DBQ PDF pulls latest version of single Exam, noneditable
+2 ;;Routine locks exam not worksheet
+3 NEW DVBABCNT,DVBFPDF,DVBNCT,DVBABIEN,DVBSV,DVBEXCT,DVBEXNM,DVBLSTNM
+4 KILL ^TMP("DVBAPDF",$JOB)
+5 SET DVBEXCT=0
+6 SET DVBEXNM=$GET(^DVB(396.17,DVBIEN,14,DVBCT,2))
+7 SET DVBSEQ=$PIECE($GET(^DVB(396.17,DVBIEN,1,0)),U,3)
+8 FOR DVBI=1:1:DVBSEQ
if DVBEXCT'=0
QUIT
Begin DoDot:1
+9 SET DVBLSTNM=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
+10 IF DVBLSTNM=DVBEXNM
SET DVBEXCT=DVBI
End DoDot:1
+11 ;Next two lines added for CAPRI-10057.
+12 ;Get the latest save number for the given exam.
SET DVBSV=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBEXCT,0)),U,3)
+13 IF '$GET(DVBSV)
SET DVBPDF=""
QUIT
+14 ;
+15 SET DVBABCNT=1
SET DVBABIEN=0
SET DVBNCT=0
+16 SET DVBRTN=$$LOCK(DVBIEN,DVBSV)
IF DVBRTN=0
SET DVBPDF="1^LOCKED RECORD"
QUIT
+17 ;In the following 2 lines replaced 14,DVBCT,7 with 15,DVBSV,2. CAPRI-10057
+18 FOR
SET DVBABIEN=$ORDER(^DVB(396.17,DVBIEN,15,DVBSV,2,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+19 SET DVBFPDF=$GET(^DVB(396.17,DVBIEN,15,DVBSV,2,DVBABCNT,0))
+20 IF DVBABCNT=1
SET DVBFPDF="1"_U_DVBFPDF
+21 SET DVBABCNT=DVBABCNT+1
SET DVBNCT=DVBNCT+1
MERGE ^TMP("DVBAPDF",$JOB,DVBNCT)=DVBFPDF
+22 QUIT
End DoDot:1
+23 SET DVBPDF=$NAME(^TMP("DVBAPDF",$JOB))
+24 DO UNLOCK(DVBIEN,DVBSV)
+25 QUIT
LOCK(DVBIEN,DVBSV) ;
+1 LOCK +^DVB(396.17,DVBIEN,15,DVBSV,2):$GET(DILOCKTM)
+2 SET DVBRTN=$TEST
+3 QUIT DVBRTN
UNLOCK(DVBIEN,DVBSV) ;
+1 LOCK -^DVB(396.17,DVBIEN,15,DVBSV,2)
+2 QUIT
PDFRTN(DVBRTN,DVBARRAY) ;
+1 ;;RPC DVBA CAPRI GET EXAM PDF used to pull PDF details, Exam can be edited.
+2 ;;Worksheet is locked before this call
+3 NEW DVBIEN,DVBTAB,DVBCT,DVBPTR,DVBNM,DVBTABIO,DVBPDF,DVBCNT,DVBAIEN
+4 KILL ^TMP("DVBAPDFEDIT",$JOB)
+5 IF '$DATA(DVBARRAY)
SET DVBRTN="0^MISSING DATA"
QUIT
+6 SET DVBIEN=$PIECE(DVBARRAY,U)
SET DVBCNT=1
+7 SET DVBNM=$PIECE($GET(DVBARRAY),U,2)
IF DVBNM=""
QUIT
+8 SET DVBAIEN=0
FOR
SET DVBAIEN=$ORDER(^DVB(396.17,DVBIEN,1,DVBAIEN))
if DVBAIEN=""
QUIT
Begin DoDot:1
+9 IF $PIECE($GET(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",2)'=DVBNM
QUIT
+10 SET DVBPTR=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",3)
IF DVBPTR=0
QUIT
+11 ;;CAPRI-11245 CP 6/21/24
+12 SET DVBTAB=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBPTR,1)),"^",3),"|",1)
+13 SET DVBTABIO=DVBAIEN_U_DVBTAB_U_DVBNM
+14 SET DVBCNT=DVBCNT+1
MERGE ^TMP("DVBAPDFEDIT",$JOB,DVBCNT)=DVBTABIO
+15 SET DVBCT=0
FOR
SET DVBCT=$ORDER(^DVB(396.17,DVBIEN,15,DVBPTR,2,DVBCT))
if DVBCT=""
QUIT
Begin DoDot:2
+16 SET DVBPDF=$GET(^DVB(396.17,DVBIEN,15,DVBPTR,2,DVBCT,0))
+17 SET DVBCNT=DVBCNT+1
MERGE ^TMP("DVBAPDFEDIT",$JOB,DVBCNT)=DVBPDF
+18 QUIT
End DoDot:2
End DoDot:1
+19 SET DVBRTN=$NAME(^TMP("DVBAPDFEDIT",$JOB))
+20 QUIT
PDFEXAM(DVBRTN,DVBIEN) ;
+1 ;Added DVBACE to the list for CAPRI-13939.
+2 ;RPC DVBA CAPRI GET WORKSHEET
+3 NEW DVBACE,DVBCT,DVBSTAT,DVBPT,DVBAUTH,DVBUPD,DVBVHA,DVBIEPD,DVBPDF,DVBCNT
+4 ;Added DVBWOI and DVBWON to the list for CAPRI-11238.
+5 NEW DVBAUTHNM,DVBTRANSID,DVBTRANSNM,DVBPTNM,DVBLOCK,DVBWOI,DVBWON,DVBSSN
+6 KILL ^TMP("DVBAPDFLST",$JOB)
+7 IF '$DATA(DVBIEN)
SET DVBRTN="0^MISSING DATA"
QUIT
+8 ;BG CAPRI-8883 added lock
+9 SET DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,"11","I")
+10 SET DVBLOCK=$SELECT(DVBSTAT="A":"L",DVBSTAT="S":"L",DVBSTAT="P":"L",DVBSTAT="D":"L",1:"U")
+11 IF DVBLOCK="L"
DO LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
+12 IF $GET(DVBLRTN)["-1"
MERGE ^TMP("DVBAPDFLST",$JOB,1)=DVBLRTN
SET DVBRTN=$NAME(^TMP("DVBAPDFLST",$JOB))
QUIT
+13 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","I")
+14 ;;Adding SSN to return CP 1-28-25 CAPRI-16034
+15 SET DVBSSN=$$GET1^DIQ(2,DVBPT,".09","I")
+16 SET DVBPTNM=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+17 SET DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
+18 SET DVBAUTHNM=$$GET1^DIQ(396.17,DVBIEN,"2","E")
+19 SET DVBUPD=$$GET1^DIQ(396.17,DVBIEN,"4","I")
+20 SET DVBVHA=$$GET1^DIQ(396.17,DVBIEN,"25","I")
+21 SET DVBIEPD=$$GET1^DIQ(396.17,DVBIEN,"12","I")
+22 SET DVBTRANSID=$$GET1^DIQ(396.17,DVBIEN,"10","I")
+23 SET DVBTRANSNM=$$GET1^DIQ(396.17,DVBIEN,"10","E")
+24 ;Next 2 lines added for CAPRI-11238.
+25 ;Worksheet originator IEN
SET DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I")
+26 ;Worksheet originator name
SET DVBWON=$$GET1^DIQ(396.17,DVBIEN,"13","E")
+27 ;Next line added for CAPRI-13939.
+28 ;Acceptable Clinical Evidence (ACE)
SET DVBACE=$$GET1^DIQ(396.17,DVBIEN,"1","I")
+29 IF $GET(DVBTRANSID)=""
SET DVBTRANSID="N/A"
SET DVBTRANSNM="N/A"
+30 SET DVBCNT=1
+31 ;Added the Worksheet Originator (DVBWOI,DVBWON) to the return list for CAPRI-11238.
+32 ;Added Acceptable Clinical Evidence (ACE) to the return list for CAPRI-13939.
+33 ;;Adding SSN to return CP 1-28-25 CAPRI-16034
+34 SET DVBPDF=DVBIEN_U_DVBSTAT_U_DVBPT_U_DVBPTNM_U_DVBAUTH_U_DVBAUTHNM_U_DVBUPD_U_DVBVHA_U_DVBIEPD_U_DVBTRANSID_U_DVBTRANSNM_U_DVBWOI_U_DVBWON_U_DVBACE_U_DVBSSN
+35 MERGE ^TMP("DVBAPDFLST",$JOB,DVBCNT)=DVBPDF
+36 SET DVBAIEN=0
FOR
SET DVBAIEN=$ORDER(^DVB(396.17,DVBIEN,1,DVBAIEN))
if DVBAIEN=""
QUIT
Begin DoDot:1
+37 SET DVBPTR=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",3)
IF DVBPTR=""
QUIT
+38 SET DVBNM=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",2)
IF DVBNM["*DEL*"
QUIT
+39 ;;CAPRI-11245 CP 6/21/24
+40 SET DVBTAB=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBPTR,1)),"^",3),"|",1)
+41 SET DVBPDF=DVBAIEN_U_DVBTAB_U_DVBNM
+42 SET DVBCNT=DVBCNT+1
MERGE ^TMP("DVBAPDFLST",$JOB,DVBCNT)=DVBPDF
End DoDot:1
+43 SET DVBRTN=$NAME(^TMP("DVBAPDFLST",$JOB))
+44 QUIT
CREATE(DVBRTN,DVBDATA,DVBEXAMLIST) ;
+1 ;Updates to remove validation Errors 2-19-25 CP CAPRI-16472
+2 ;RPC DVBA CAPRI CREATE WORKSHEET
+3 NEW DVBPATIENT,DVBAUTHOR,DVBIEPDVER,DVBDBQREF,DVBTRANSCRIB,DVBFORMNAME,DVBDTTM,DVBEXAMCNT
+4 NEW DVBEXAMSEQ,DVBEXAMNAME,DVBIEN,DVBI,DVBRTDAT,DVBCKDAT
+5 SET DVBPATIENT=$GET(DVBDATA(1))
+6 IF DVBPATIENT=""
SET DVBRTN="-1^Missing Patient Details"
QUIT
+7 SET DVBAUTHOR=$GET(DVBDATA(2))
+8 IF DVBAUTHOR=""
SET DVBRTN="-1^Missing Author Details"
QUIT
+9 SET DVBIEPDVER=$GET(DVBDATA(3))
+10 SET DVBDBQREF=$GET(DVBDATA(4))
+11 SET DVBTRANSCRIB=$GET(DVBDATA(5))
+12 SET DVBFORMNAME=$GET(DVBDATA(6))
+13 IF $GET(DVBEXAMLIST(1))=""
SET DVBRTN="-1^Invalid Exam Name/List"
QUIT
+14 SET (DVBRTDAT,DVBCKDAT)=""
+15 ;
+16 SET DVBDTTM=$$NOW^XLFDT
+17 KILL DIC,DIE,DA,DR,X,Y,DO
+18 SET DR="2////"_DVBAUTHOR_";3////"_DVBDTTM_";4////"_DVBDTTM_";5////2800101"_";9////"_DVBFORMNAME
+19 SET DR=DR_";10////"_DVBTRANSCRIB_";11////D"_";12////"_DVBIEPDVER_";19////N"_";25////"_DVBDBQREF_";13////"_DVBAUTHOR
+20 ;S DR=DR_";32////"_$S($$GET^XPAR("PKG","DVBAB CAPRI EMS TOGGLE",1,"I")=2:"E",1:"C") ;CAPRI-19608:NGC
+21 SET DIC("DR")=DR
+22 SET DIC=396.17
SET DIC(0)="Z"
SET X=DVBPATIENT
+23 DO FILE^DICN
+24 IF Y=-1
KILL DIC
SET DVBRTN="-1^New Entry not Built"
QUIT
+25 SET DA=$PIECE($GET(Y),U,1)
+26 SET DVBRTDAT=$GET(Y(0))
+27 SET DVBCKDAT=DVBPATIENT_U_DVBAUTHOR_U_DVBDTTM_U_DVBDTTM_U_"2800101"_U_DVBAUTHOR
+28 IF DVBRTDAT=""
IF DVBRTDAT'=DVBCKDAT
SET DIK="^DVB(396.17,"
SET DA=$GET(DA)
DO ^DIK
SET DVBRTN="-1^Details not Saved"
QUIT
+29 SET DVBRTN(0)=DA
+30 KILL DIK,DIC,DIE,DA,DR,X,Y
+31 ;
+32 ;
+33 NEW DVBERR
+34 SET (DVBEXAMCNT,DVBEXAMSEQ)=""
+35 SET DVBEXAMCNT=$ORDER(DVBEXAMLIST(DVBEXAMCNT),-1)
+36 FOR DVBI=1:1:DVBEXAMCNT
if $GET(DVBEXAMLIST(DVBI))=""
QUIT
Begin DoDot:1
+37 SET DVBEXAMNAME=$GET(DVBEXAMLIST(DVBI))
+38 SET DVBIEN=$GET(DVBRTN(0))
+39 SET DVBEXAMSEQ(DVBI)=DVBI_"^"_DVBEXAMNAME_"^0"
+40 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+41 SET DA(1)=DVBIEN
SET (DA,X)=DVBI
+42 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",1,"
SET DIC(0)="L"
+43 DO ^DIC
+44 SET DVBRTN(DVBI)=DVBI_":"_DVBEXAMNAME
+45 QUIT
End DoDot:1
+46 DO WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
+47 IF $DATA(DVBERR)
SET DVBRTN="-1^Data Not Saved"
QUIT
+48 ;BG CAPRI-8883 added lock
+49 DO LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
+50 IF $GET(DVBLRTN)["-1"
SET DVBRTN=DVBLRTN
QUIT
+51 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+52 QUIT
PDFSAVE(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME,DVBPDFDATA,DVBTABIO,DVBSMSG,DVBVER) ;
+1 ;RPC: DVBA CAPRI SAVE EXAM PDF
+2 ;Updates CAPRI-16627 CP 5/10/25
+3 NEW DVBDTTM,DVBSAVESEQ,DVBNEXTSEQ,DVBPRESAVE,DVBPRENAME,DVBAFDA,DVBLRTN,DVBPN2,DVBEN2,DVBSAVECMT
+4 IF $DATA(DVBSMSG)=0
SET DVBSMSG=""
+5 IF $DATA(DVBVER)=0
SET DVBVER=""
+6 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+7 NEW DVBERR
+8 ;;CAPRI-11245 CP 6/21/24
+9 SET DVBSAVECMT=DVBTABIO_"|"_DVBSMSG_"|"_DVBVER_"|"_DUZ
+10 SET DVBDTTM=$$NOW^XLFDT
+11 SET DVBSAVESEQ=$PIECE($GET(^DVB(396.17,DVBIEN,15,0)),"^",3)
+12 SET DA(1)=DVBIEN
SET (DA,X)=DVBSAVESEQ+1
+13 ;;Adding Z to correct xref CP
+14 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",15,"
SET DIC(0)="LZ"
+15 SET DIC("DR")=".01////"_DVBSEQ_";.02////"_DVBDTTM_";.03////"_DVBEXAMNAME_";.04////"_DVBSAVECMT
+16 DO FILE^DICN
+17 IF Y=-1
KILL DIC
SET DVBRTN="-1^New version not saved"
QUIT
+18 SET DVBNEXTSEQ=+Y
+19 IF $$GET1^DIQ(396.1727,DVBNEXTSEQ_","_DVBIEN,.02,"I")'=DVBDTTM
SET DVBRTN="-1^Sequence, Date/Time, Exam Name data Not Saved"
QUIT
+20 DO WP^DIE(396.1727,DVBNEXTSEQ_","_DVBIEN_",",.05,"K","DVBPDFDATA","DVBERR")
+21 IF $DATA(DVBERR)
SET DVBRTN="-1^PDF data not saved"
QUIT
+22 SET DVBAFDA(396.17,DVBIEN_",",4)=DVBDTTM
+23 KILL DVBERR
DO FILE^DIE(,"DVBAFDA","DVBERR")
+24 IF $DATA(DVBERR)
SET DVBRTN="-1^Date/Time data not saved"
QUIT
+25 SET DVBPRESAVE=$GET(^DVB(396.17,DVBIEN,1,DVBSEQ,0),"")
+26 IF DVBPRESAVE=""
SET DVBRTN="-1^Incorrect Seq Number"
QUIT
+27 SET DVBPRENAME=$PIECE(DVBPRESAVE,"^",2)
+28 ;;Updating to not compare version CAPRI-10405 CP
+29 SET DVBPN2=$$NAMEUPD^DVBCTPD2(DVBPRENAME)
+30 SET DVBEN2=$$NAMEUPD^DVBCTPD2(DVBEXAMNAME)
+31 IF DVBPN2'=DVBEN2
SET DVBRTN="-1^Mismatch Exam Name"
QUIT
+32 IF DVBPN2=DVBEN2
SET ^DVB(396.17,DVBIEN,1,DVBSEQ,0)=DVBSEQ_"^"_DVBEXAMNAME_"^"_DVBNEXTSEQ
SET DVBRTN="1"
+33 QUIT
PASCALCHK(DVBRTN,DVBIEN) ;
+1 ;RPC DVBA CAPRI PASCAL CHECK
+2 IF '$DATA(DVBIEN)
SET DVBRTN="-1^MISSING DATA"
QUIT
+3 IF $DATA(^DVB(396.17,DVBIEN,3))
SET DVBRTN="P"
QUIT
+4 IF '$DATA(^DVB(396.17,DVBIEN,3))
SET DVBRTN="C"
+5 QUIT
PDFLST(DVBRTN,DVBIEN) ;
+1 ;RPC: DVBA CAPRI GET WORKSHEET LIST
+2 ;Update for CMT/PASCAL flag 4-22-24 CP CAPRI 9826
+3 ;Added DVBWON to the list for CAPRI-11238.
+4 ;Update for VHA Internal DBQ Referral DVBIR RJA 250401 CAPRI-17618
+5 NEW DVBNCT,DVBNNCT,DVBAUTH,DVBSTAT,DVBNAME,DVBNM,DVBPT,DVBPIEN,DVBAIEN,DVBWSIEN,DVBSDT,DVBPDF,DVBNFLG,DVBGFLG,DVBXFLG,DVBCPFLG,DVBWON,DVBIR
+6 KILL ^TMP("DVBPDFLST",$JOB)
SET DVBNCT=0
+7 IF '$DATA(DVBIEN)
SET DVBRTN="0^MISSING DATA"
QUIT
+8 IF $DATA(^DVB(396.17,"B",DVBIEN))<10
SET DVBRTN="0^NO WORKSHEETS"
QUIT
+9 SET DVBWSIEN=0
FOR
SET DVBWSIEN=$ORDER(^DVB(396.17,"B",DVBIEN,DVBWSIEN))
if DVBWSIEN=""
QUIT
Begin DoDot:1
+10 SET DVBNCT=DVBNCT+1
+11 SET DVBAUTH=$$GET1^DIQ(396.17,DVBWSIEN,"2","E")
+12 SET DVBNAME=$$GET1^DIQ(396.17,DVBWSIEN,"9","I")
+13 SET DVBSTAT=$$GET1^DIQ(396.17,DVBWSIEN,"11","I")
+14 SET DVBPT=$$GET1^DIQ(396.17,DVBWSIEN,".01","E")
+15 SET DVBSDT=$$GET1^DIQ(396.17,DVBWSIEN,"5","E")
+16 SET DVBNFLG=$$GET1^DIQ(396.17,DVBWSIEN,"19","E")
+17 SET DVBGFLG=$$GET1^DIQ(396.17,DVBWSIEN,"20","E")
+18 SET DVBXFLG=$$GET1^DIQ(396.17,DVBWSIEN,"21","E")
+19 ;Next line added for CAPRI-11238.
+20 ;Worksheet originator name
SET DVBWON=$$GET1^DIQ(396.17,DVBWSIEN,"13","E")
+21 ;VHA Internal DBQ Referral
SET DVBIR=$$GET1^DIQ(396.17,DVBWSIEN,"25","E")
+22 SET DVBCPFLG=$SELECT($DATA(^DVB(396.17,DVBWSIEN,3))>9:"P",1:"C")
+23 SET DVBPDF=$GET(DVBWSIEN)_U_$GET(DVBPT)_U_$GET(DVBNAME)_U_$GET(DVBSDT)_U_$GET(DVBAUTH)_U_$GET(DVBSTAT)_U_$GET(DVBNFLG)_U_$GET(DVBGFLG)_U_$GET(DVBXFLG)_U_$GET(DVBCPFLG)_U_$GET(DVBWON)_U_$GET(DVBIR)
+24 SET ^TMP("DVBPDFLST",$JOB,DVBNCT)=DVBPDF
+25 SET DVBAIEN=0
FOR
SET DVBAIEN=$ORDER(^DVB(396.17,DVBWSIEN,1,DVBAIEN))
if DVBAIEN=""
QUIT
Begin DoDot:2
+26 SET DVBPTR=$PIECE($GET(^DVB(396.17,DVBWSIEN,1,DVBAIEN,0)),"^",3)
IF DVBPTR=""
QUIT
+27 SET DVBNM=$PIECE($GET(^DVB(396.17,DVBWSIEN,1,DVBAIEN,0)),"^",2)
IF DVBNM["*DEL*"
QUIT
+28 ;;CAPRI-11245 CP 6/21/24
+29 SET DVBTAB=$PIECE($PIECE($GET(^DVB(396.17,DVBWSIEN,15,DVBPTR,1)),"^",3),"|",1)
+30 SET DVBPDF=DVBAIEN_U_DVBTAB_U_DVBNM
+31 SET DVBNCT=DVBNCT+1
MERGE ^TMP("DVBPDFLST",$JOB,DVBNCT)=DVBPDF
End DoDot:2
End DoDot:1
+32 SET DVBRTN=$NAME(^TMP("DVBPDFLST",$JOB))
+33 QUIT
DELCHECK(DVBRTN,DVBIEN) ;
+1 ;RPC DVBA CAPRI DELETE CHECK
+2 ;CAPRI-16627 CP 4-11-25
+3 ;Added DVBWOI to the list for CAPRI-11238.
+4 NEW DVBAUTH,DVBTRS,DVBKY,DVBWOI,DVBFLAG
+5 SET DVBFLAG=0
+6 IF '$DATA(DVBIEN)
SET DVBRTN="-1^MISSING IEN"
QUIT
+7 ;BG CAPRI-8883 added lock
+8 DO LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
+9 IF $GET(DVBLRTN)["-1"
SET DVBRTN=DVBLRTN
QUIT
+10 DO OWNSKEY^XUSRB(.DVBKY,"DVBAB CPWM REVIEWER",DUZ)
+11 IF $GET(DVBKY(0))
SET DVBFLAG=1
+12 IF $PIECE($GET(^VA(200,DUZ,0)),U,4)="@"
SET DVBFLAG=1
+13 SET DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
+14 SET DVBTRS=$$GET1^DIQ(396.17,DVBIEN,"10","I")
+15 SET DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I")
+16 ;Added the Worksheet Originator IEN (DVBWOI) check for CAPRI-11238.
+17 IF (DVBFLAG'=1)
IF (DUZ'=DVBAUTH)
IF (DUZ'=DVBTRS)
IF (DUZ'=DVBWOI)
SET DVBRTN="-1^Unable to delete, User is not Document Manager, Transcriber or Worksheet Originator"
QUIT
+18 SET DVBRTN=1
+19 QUIT
DELETE(DVBRTN,DVBIEN) ;
+1 ;RPC DVBA CAPRI DELETE WORKSHEET
+2 NEW FDA,DVBERR
+3 IF '$DATA(DVBIEN)
SET DVBRTN="-1^MISSING IEN"
QUIT
+4 SET FDA(396.17,DVBIEN_",",.01)="@"
+5 DO FILE^DIE("","FDA","DVBERR")
+6 IF '$DATA(DVBERR)
SET DVBRTN=1
+7 IF $DATA(DVBERR)
SET DVBRTN="-1^Unable to delete"
+8 QUIT
