DVBCTPDF ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 4/29/24 12:59pm
;;2.7;AMIE;**252**;Apr 10, 1995;Build 92
; 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) ;
;;RPC DVBA CAPRI GET DBQ PDF pulls latest version of single Exam, noneditable
;;Routine locks exam not worksheet
N DVBABCNT,DVBFPDF,DVNCT,DVBABIEN,DVBSV K ^TMP("DVBAPDF",$J)
;Next two lines added for CAPRI-10057.
S DVBSV=$P($G(^DVB(396.17,DVBIEN,1,DVBCT,0)),U,3) ;Get the latest save number for the given exam.
I '$G(DVBSV) S DVBPDF="" Q
;
S DVBABCNT=1,DVBABIEN=0,DVNCT=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,DVNCT=DVNCT+1 M ^TMP("DVBAPDF",$J,DVNCT)=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.
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
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")
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.
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
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) ;
N DVBPATIENT,DVBAUTHOR,DVBIEPDVER,DVBDBQREF,DVBTRANSCRIB,DVBFORMNAME,DVBDTTM,DVBEXAMCNT,DVBEXAMSEQ,DVBEXAMNAME,DVBIEN,DVBI
S DVBPATIENT=$G(DVBDATA(1))
S DVBAUTHOR=$G(DVBDATA(2))
S DVBIEPDVER=$G(DVBDATA(3))
S DVBDBQREF=$G(DVBDATA(4))
S DVBTRANSCRIB=$G(DVBDATA(5))
S DVBFORMNAME=$G(DVBDATA(6))
;
K DIC,DIE,DA,DR,X,Y,DO
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)=+Y,DIE=DIC
S DVBDTTM=$$NOW^XLFDT
S DR=".01///"_DVBPATIENT_";2///"_DVBAUTHOR_";3///"_DVBDTTM_";4///"_DVBDTTM_";5///2800101"
S DR=DR_";9///"_DVBFORMNAME_";10///"_DVBTRANSCRIB_";11///D"_";12///"_DVBIEPDVER_";19///N"_";25///"_DVBDBQREF
;Used Author to populate the Worksheet Originator field for CAPRI-11207.
S DR=DR_";13///"_DVBAUTHOR
D ^DIE
I DA="" S DVBRTN="-1^Missing Worksheet IEN" Q
S DVBRTN(0)=DA
K 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) ;
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"
D ^DIC
I Y=-1 K DIC S DVBRTN="-1^New version not saved" Q
S DVBNEXTSEQ=+Y
S DIE=DIC
S DR=".01///"_DVBSEQ_";.02///"_DVBDTTM_";.03///"_DVBEXAMNAME_";.04///"_DVBSAVECMT
D ^DIE
D WP^DIE(396.1727,DVBNEXTSEQ_","_DVBIEN_",",.05,"K","DVBPDFDATA","DVBERR")
I $D(DVBERR) S DVBRTN="-1^Data not saved" Q
I '$D(DVBERR) S DVBRTN=1
S DVBAFDA(396.17,DVBIEN_",",4)=DVBDTTM
K DVBERR D FILE^DIE(,"DVBAFDA","DVBERR")
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) ;
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) ;
;RETURN worksheet IEN, Worksheet Name, Template/Exam Name, Date Signed (if applicable), Author, Status, New Flag, Green Flag, Exclamation Flag, CMT/PASCAL FLAG.
;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.
N DVBNCT,DVBNNCT,DVBAUTH,DVBSTAT,DVBNAME,DVBNM,DVBPT,DVBPIEN,DVBAIEN,DVBWSIEN,DVBSDT,DVBPDF,DVBNFLG,DVBGFLG,DVBXFLG,DVBCPFLG,DVBWON
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 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)
.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) ;
;Added DVBWOI to the list for CAPRI-11238.
N DVBAUTH,DVBTRS,DVBKY,DVBWOI
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
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 (DUZ'=DVBAUTH),(DUZ'=DVBTRS),(DUZ'=DVBWOI) S DVBRTN="-1^Unable to delete, User is not Document Manager, Transcriber or Worksheet Originator" Q
D OWNSKEY^XUSRB(.DVBKY,"DVBAB CPWM REVIEWER",DUZ)
I '$G(DVBKY(0)) S DVBRTN="-1^Unable to delete, User does not have DVBAB CPWM REVIEWER Security Key"
I $P($G(^VA(200,DUZ)),U,4)'="@" S DVBRTN="-1^Unable to delete, User does not have Fileman Access"
S DVBRTN=1
Q
DELETE(DVBRTN,DVBIEN) ;
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 11174 printed Aug 26, 2025@22:04:45 Page 2
DVBCTPDF ;ALB/BG/CP/JD - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 4/29/24 12:59pm
+1 ;;2.7;AMIE;**252**;Apr 10, 1995;Build 92
+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) ;
+1 ;;RPC DVBA CAPRI GET DBQ PDF pulls latest version of single Exam, noneditable
+2 ;;Routine locks exam not worksheet
+3 NEW DVBABCNT,DVBFPDF,DVNCT,DVBABIEN,DVBSV
KILL ^TMP("DVBAPDF",$JOB)
+4 ;Next two lines added for CAPRI-10057.
+5 ;Get the latest save number for the given exam.
SET DVBSV=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBCT,0)),U,3)
+6 IF '$GET(DVBSV)
SET DVBPDF=""
QUIT
+7 ;
+8 SET DVBABCNT=1
SET DVBABIEN=0
SET DVNCT=0
+9 SET DVBRTN=$$LOCK(DVBIEN,DVBSV)
IF DVBRTN=0
SET DVBPDF="1^LOCKED RECORD"
QUIT
+10 ;In the following 2 lines replaced 14,DVBCT,7 with 15,DVBSV,2. CAPRI-10057
+11 FOR
SET DVBABIEN=$ORDER(^DVB(396.17,DVBIEN,15,DVBSV,2,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+12 SET DVBFPDF=$GET(^DVB(396.17,DVBIEN,15,DVBSV,2,DVBABCNT,0))
+13 IF DVBABCNT=1
SET DVBFPDF="1"_U_DVBFPDF
+14 SET DVBABCNT=DVBABCNT+1
SET DVNCT=DVNCT+1
MERGE ^TMP("DVBAPDF",$JOB,DVNCT)=DVBFPDF
+15 QUIT
End DoDot:1
+16 SET DVBPDF=$NAME(^TMP("DVBAPDF",$JOB))
+17 DO UNLOCK(DVBIEN,DVBSV)
+18 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 NEW DVBACE,DVBCT,DVBSTAT,DVBPT,DVBAUTH,DVBUPD,DVBVHA,DVBIEPD,DVBPDF,DVBCNT
+3 ;Added DVBWOI and DVBWON to the list for CAPRI-11238.
+4 NEW DVBAUTHNM,DVBTRANSID,DVBTRANSNM,DVBPTNM,DVBLOCK,DVBWOI,DVBWON
+5 KILL ^TMP("DVBAPDFLST",$JOB)
+6 IF '$DATA(DVBIEN)
SET DVBRTN="0^MISSING DATA"
QUIT
+7 ;BG CAPRI-8883 added lock
+8 SET DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,"11","I")
+9 SET DVBLOCK=$SELECT(DVBSTAT="A":"L",DVBSTAT="S":"L",DVBSTAT="P":"L",DVBSTAT="D":"L",1:"U")
+10 IF DVBLOCK="L"
DO LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
+11 IF $GET(DVBLRTN)["-1"
MERGE ^TMP("DVBAPDFLST",$JOB,1)=DVBLRTN
SET DVBRTN=$NAME(^TMP("DVBAPDFLST",$JOB))
QUIT
+12 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","I")
+13 SET DVBPTNM=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+14 SET DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
+15 SET DVBAUTHNM=$$GET1^DIQ(396.17,DVBIEN,"2","E")
+16 SET DVBUPD=$$GET1^DIQ(396.17,DVBIEN,"4","I")
+17 SET DVBVHA=$$GET1^DIQ(396.17,DVBIEN,"25","I")
+18 SET DVBIEPD=$$GET1^DIQ(396.17,DVBIEN,"12","I")
+19 SET DVBTRANSID=$$GET1^DIQ(396.17,DVBIEN,"10","I")
+20 SET DVBTRANSNM=$$GET1^DIQ(396.17,DVBIEN,"10","E")
+21 ;Next 2 lines added for CAPRI-11238.
+22 ;Worksheet originator IEN
SET DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I")
+23 ;Worksheet originator name
SET DVBWON=$$GET1^DIQ(396.17,DVBIEN,"13","E")
+24 ;Next line added for CAPRI-13939.
+25 ;Acceptable Clinical Evidence (ACE)
SET DVBACE=$$GET1^DIQ(396.17,DVBIEN,"1","I")
+26 IF $GET(DVBTRANSID)=""
SET DVBTRANSID="N/A"
SET DVBTRANSNM="N/A"
+27 SET DVBCNT=1
+28 ;Added the Worksheet Originator (DVBWOI,DVBWON) to the return list for CAPRI-11238.
+29 ;Added Acceptable Clinical Evidence (ACE) to the return list for CAPRI-13939.
+30 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
+31 MERGE ^TMP("DVBAPDFLST",$JOB,DVBCNT)=DVBPDF
+32 SET DVBAIEN=0
FOR
SET DVBAIEN=$ORDER(^DVB(396.17,DVBIEN,1,DVBAIEN))
if DVBAIEN=""
QUIT
Begin DoDot:1
+33 SET DVBPTR=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",3)
IF DVBPTR=""
QUIT
+34 SET DVBNM=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBAIEN,0)),"^",2)
IF DVBNM["*DEL*"
QUIT
+35 ;;CAPRI-11245 CP 6/21/24
+36 SET DVBTAB=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBPTR,1)),"^",3),"|",1)
+37 SET DVBPDF=DVBAIEN_U_DVBTAB_U_DVBNM
+38 SET DVBCNT=DVBCNT+1
MERGE ^TMP("DVBAPDFLST",$JOB,DVBCNT)=DVBPDF
End DoDot:1
+39 SET DVBRTN=$NAME(^TMP("DVBAPDFLST",$JOB))
+40 QUIT
CREATE(DVBRTN,DVBDATA,DVBEXAMLIST) ;
+1 NEW DVBPATIENT,DVBAUTHOR,DVBIEPDVER,DVBDBQREF,DVBTRANSCRIB,DVBFORMNAME,DVBDTTM,DVBEXAMCNT,DVBEXAMSEQ,DVBEXAMNAME,DVBIEN,DVBI
+2 SET DVBPATIENT=$GET(DVBDATA(1))
+3 SET DVBAUTHOR=$GET(DVBDATA(2))
+4 SET DVBIEPDVER=$GET(DVBDATA(3))
+5 SET DVBDBQREF=$GET(DVBDATA(4))
+6 SET DVBTRANSCRIB=$GET(DVBDATA(5))
+7 SET DVBFORMNAME=$GET(DVBDATA(6))
+8 ;
+9 KILL DIC,DIE,DA,DR,X,Y,DO
+10 SET DIC=396.17
SET DIC(0)="Z"
SET X=DVBPATIENT
+11 DO FILE^DICN
+12 IF Y=-1
KILL DIC
SET DVBRTN="-1^New Entry not Built"
QUIT
+13 SET (DA)=+Y
SET DIE=DIC
+14 SET DVBDTTM=$$NOW^XLFDT
+15 SET DR=".01///"_DVBPATIENT_";2///"_DVBAUTHOR_";3///"_DVBDTTM_";4///"_DVBDTTM_";5///2800101"
+16 SET DR=DR_";9///"_DVBFORMNAME_";10///"_DVBTRANSCRIB_";11///D"_";12///"_DVBIEPDVER_";19///N"_";25///"_DVBDBQREF
+17 ;Used Author to populate the Worksheet Originator field for CAPRI-11207.
+18 SET DR=DR_";13///"_DVBAUTHOR
+19 DO ^DIE
+20 IF DA=""
SET DVBRTN="-1^Missing Worksheet IEN"
QUIT
+21 SET DVBRTN(0)=DA
+22 KILL DIC,DIE,DA,DR,X,Y
+23 ;
+24 NEW DVBERR
+25 SET (DVBEXAMCNT,DVBEXAMSEQ)=""
+26 SET DVBEXAMCNT=$ORDER(DVBEXAMLIST(DVBEXAMCNT),-1)
+27 FOR DVBI=1:1:DVBEXAMCNT
if $GET(DVBEXAMLIST(DVBI))=""
QUIT
Begin DoDot:1
+28 SET DVBEXAMNAME=$GET(DVBEXAMLIST(DVBI))
+29 SET DVBIEN=$GET(DVBRTN(0))
+30 SET DVBEXAMSEQ(DVBI)=DVBI_"^"_DVBEXAMNAME_"^0"
+31 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+32 SET DA(1)=DVBIEN
SET (DA,X)=DVBI
+33 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",1,"
SET DIC(0)="L"
+34 DO ^DIC
+35 SET DVBRTN(DVBI)=DVBI_":"_DVBEXAMNAME
+36 QUIT
End DoDot:1
+37 DO WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
+38 IF $DATA(DVBERR)
SET DVBRTN="-1^Data Not Saved"
QUIT
+39 ;BG CAPRI-8883 added lock
+40 DO LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
+41 IF $GET(DVBLRTN)["-1"
SET DVBRTN=DVBLRTN
QUIT
+42 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+43 QUIT
PDFSAVE(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME,DVBPDFDATA,DVBTABIO,DVBSMSG,DVBVER) ;
+1 NEW DVBDTTM,DVBSAVESEQ,DVBNEXTSEQ,DVBPRESAVE,DVBPRENAME,DVBAFDA,DVBLRTN,DVBPN2,DVBEN2,DVBSAVECMT
+2 IF $DATA(DVBSMSG)=0
SET DVBSMSG=""
+3 IF $DATA(DVBVER)=0
SET DVBVER=""
+4 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+5 NEW DVBERR
+6 ;;CAPRI-11245 CP 6/21/24
+7 SET DVBSAVECMT=DVBTABIO_"|"_DVBSMSG_"|"_DVBVER_"|"_DUZ
+8 SET DVBDTTM=$$NOW^XLFDT
+9 SET DVBSAVESEQ=$PIECE($GET(^DVB(396.17,DVBIEN,15,0)),"^",3)
+10 SET DA(1)=DVBIEN
SET (DA,X)=DVBSAVESEQ+1
+11 ;;Adding Z to correct xref CP
+12 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",15,"
SET DIC(0)="LZ"
+13 DO ^DIC
+14 IF Y=-1
KILL DIC
SET DVBRTN="-1^New version not saved"
QUIT
+15 SET DVBNEXTSEQ=+Y
+16 SET DIE=DIC
+17 SET DR=".01///"_DVBSEQ_";.02///"_DVBDTTM_";.03///"_DVBEXAMNAME_";.04///"_DVBSAVECMT
+18 DO ^DIE
+19 DO WP^DIE(396.1727,DVBNEXTSEQ_","_DVBIEN_",",.05,"K","DVBPDFDATA","DVBERR")
+20 IF $DATA(DVBERR)
SET DVBRTN="-1^Data not saved"
QUIT
+21 IF '$DATA(DVBERR)
SET DVBRTN=1
+22 SET DVBAFDA(396.17,DVBIEN_",",4)=DVBDTTM
+23 KILL DVBERR
DO FILE^DIE(,"DVBAFDA","DVBERR")
+24 SET DVBPRESAVE=$GET(^DVB(396.17,DVBIEN,1,DVBSEQ,0),"")
+25 IF DVBPRESAVE=""
SET DVBRTN="-1^Incorrect Seq Number"
QUIT
+26 SET DVBPRENAME=$PIECE(DVBPRESAVE,"^",2)
+27 ;;Updating to not compare version CAPRI-10405 CP
+28 SET DVBPN2=$$NAMEUPD^DVBCTPD2(DVBPRENAME)
+29 SET DVBEN2=$$NAMEUPD^DVBCTPD2(DVBEXAMNAME)
+30 IF DVBPN2'=DVBEN2
SET DVBRTN="-1^Mismatch Exam Name"
QUIT
+31 IF DVBPN2=DVBEN2
SET ^DVB(396.17,DVBIEN,1,DVBSEQ,0)=DVBSEQ_"^"_DVBEXAMNAME_"^"_DVBNEXTSEQ
SET DVBRTN="1"
+32 QUIT
PASCALCHK(DVBRTN,DVBIEN) ;
+1 IF '$DATA(DVBIEN)
SET DVBRTN="-1^MISSING DATA"
QUIT
+2 IF $DATA(^DVB(396.17,DVBIEN,3))
SET DVBRTN="P"
QUIT
+3 IF '$DATA(^DVB(396.17,DVBIEN,3))
SET DVBRTN="C"
+4 QUIT
PDFLST(DVBRTN,DVBIEN) ;
+1 ;RETURN worksheet IEN, Worksheet Name, Template/Exam Name, Date Signed (if applicable), Author, Status, New Flag, Green Flag, Exclamation Flag, CMT/PASCAL FLAG.
+2 ;RPC: DVBA CAPRI GET WORKSHEET LIST
+3 ;Update for CMT/PASCAL flag 4-22-24 CP CAPRI 9826
+4 ;Added DVBWON to the list for CAPRI-11238.
+5 NEW DVBNCT,DVBNNCT,DVBAUTH,DVBSTAT,DVBNAME,DVBNM,DVBPT,DVBPIEN,DVBAIEN,DVBWSIEN,DVBSDT,DVBPDF,DVBNFLG,DVBGFLG,DVBXFLG,DVBCPFLG,DVBWON
+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 SET DVBCPFLG=$SELECT($DATA(^DVB(396.17,DVBWSIEN,3))>9:"P",1:"C")
+22 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)
+23 SET ^TMP("DVBPDFLST",$JOB,DVBNCT)=DVBPDF
+24 SET DVBAIEN=0
FOR
SET DVBAIEN=$ORDER(^DVB(396.17,DVBWSIEN,1,DVBAIEN))
if DVBAIEN=""
QUIT
Begin DoDot:2
+25 SET DVBPTR=$PIECE($GET(^DVB(396.17,DVBWSIEN,1,DVBAIEN,0)),"^",3)
IF DVBPTR=""
QUIT
+26 SET DVBNM=$PIECE($GET(^DVB(396.17,DVBWSIEN,1,DVBAIEN,0)),"^",2)
IF DVBNM["*DEL*"
QUIT
+27 ;;CAPRI-11245 CP 6/21/24
+28 SET DVBTAB=$PIECE($PIECE($GET(^DVB(396.17,DVBWSIEN,15,DVBPTR,1)),"^",3),"|",1)
+29 SET DVBPDF=DVBAIEN_U_DVBTAB_U_DVBNM
+30 SET DVBNCT=DVBNCT+1
MERGE ^TMP("DVBPDFLST",$JOB,DVBNCT)=DVBPDF
End DoDot:2
End DoDot:1
+31 SET DVBRTN=$NAME(^TMP("DVBPDFLST",$JOB))
+32 QUIT
DELCHECK(DVBRTN,DVBIEN) ;
+1 ;Added DVBWOI to the list for CAPRI-11238.
+2 NEW DVBAUTH,DVBTRS,DVBKY,DVBWOI
+3 IF '$DATA(DVBIEN)
SET DVBRTN="-1^MISSING IEN"
QUIT
+4 ;BG CAPRI-8883 added lock
+5 DO LOCKUNLOCK^DVBUTIL(.DVBLRTN,DVBIEN,"L")
+6 IF $GET(DVBLRTN)["-1"
SET DVBRTN=DVBLRTN
QUIT
+7 SET DVBAUTH=$$GET1^DIQ(396.17,DVBIEN,"2","I")
+8 SET DVBTRS=$$GET1^DIQ(396.17,DVBIEN,"10","I")
+9 SET DVBWOI=$$GET1^DIQ(396.17,DVBIEN,"13","I")
+10 ;Added the Worksheet Originator IEN (DVBWOI) check for CAPRI-11238.
+11 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
+12 DO OWNSKEY^XUSRB(.DVBKY,"DVBAB CPWM REVIEWER",DUZ)
+13 IF '$GET(DVBKY(0))
SET DVBRTN="-1^Unable to delete, User does not have DVBAB CPWM REVIEWER Security Key"
+14 IF $PIECE($GET(^VA(200,DUZ)),U,4)'="@"
SET DVBRTN="-1^Unable to delete, User does not have Fileman Access"
+15 SET DVBRTN=1
+16 QUIT
DELETE(DVBRTN,DVBIEN) ;
+1 NEW FDA,DVBERR
+2 IF '$DATA(DVBIEN)
SET DVBRTN="-1^MISSING IEN"
QUIT
+3 SET FDA(396.17,DVBIEN_",",.01)="@"
+4 DO FILE^DIE("","FDA","DVBERR")
+5 IF '$DATA(DVBERR)
SET DVBRTN=1
+6 IF $DATA(DVBERR)
SET DVBRTN="-1^Unable to delete"
+7 QUIT
