DVBCTPD2 ;ALB/BG/JD/CP - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 10/4/23 10:07am
;;2.7;AMIE;**250,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
;
TRANSRPT(DVBRTN,DVBIEN,DVBSDT,DVBEDT) ;
K ^TMP("CAPRI TRANSRPT",$J) S DVBCNNT=""
I DVBIEN'="" D
.S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:DVBCT="" D
..S DVBINN1=""_DVBCT_","_DVBIEN_","_""
..S DVBSTA=$$GET1^DIQ(396.1726,DVBINN1,".02","E")
..S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","I")
..;;Updating for name w/o version CPARI-9567 CP 05/14/24
..I DVBNAME["_" S DVBNAME=$$NAMEUPD(DVBNAME)
..I DVBNAME?.N S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","E")
..S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
..S DVBCNT=0 F S DVBCNT=$O(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT)) Q:DVBCNT="" D
...S DVBINN2=""_DVBCNT_","_DVBCT_","_DVBIEN_","_""
...S DVBAUTH=$$GET1^DIQ(396.2026,DVBINN2,".03","E")
...S DVBTRDT=$$GET1^DIQ(396.2026,DVBINN2,".02","E")
...S DVBRESP=$$GET1^DIQ(396.2026,DVBINN2,".04","E")
...S DVBCNNT=DVBCNNT+1 S ^TMP("CAPRI TRANSRPT",$J,DVBNAME,DVBTRDT,DVBCNNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
...Q
.S DVBRTN=$NA(^TMP("CAPRI TRANSRPT",$J))
.Q
;;
I DVBIEN="" D
.S DVBDT=$$NOW^XLFDT
.I DVBSDT="",DVBEDT="" S DVBRTN="-1^MISSING DATE RANGE" Q
.S X=$G(DVBSDT) D ^%DT S DVBSDT=Y
.I DVBEDT'="" S X=DVBEDT D ^%DT S DVBEDT=Y
.I DVBEDT="" S DVBEDT=$P(DVBDT,".",1)
.S DVBIEN=0 F S DVBIEN=$O(^DVB(396.17,DVBIEN)) Q:DVBIEN="" D
..S DVBCT=0 F S DVBCT=$O(^DVB(396.17,DVBIEN,14,"B",DVBCT)) Q:DVBCT="" D
...S DVBINN1=""_DVBCT_","_DVBIEN_","_""
...S DVBCNT=0 F S DVBCNT=$O(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT)) Q:DVBCNT="" D
....S DVBINN2=""_DVBCNT_","_DVBCT_","_DVBIEN_","_""
....S DVBCHKDT=$$GET1^DIQ(396.2026,DVBINN2,".02","I")
....S DVBCHKDT=$P(DVBCHKDT,".",1)
....I DVBCHKDT<DVBSDT Q
....I DVBCHKDT>DVBEDT Q
....S DVBTRDT=$$GET1^DIQ(396.2026,DVBINN2,".02","E")
....S DVBSTA=$$GET1^DIQ(396.1726,DVBINN1,".02","E")
....S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","I")
....;;Updating for name w/o version CPARI-9567 CP 05/14/24
....I DVBNAME["_" S DVBNAME=$$NAMEUPD(DVBNAME)
....I DVBNAME?.N S DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","E")
....S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
....S DVBAUTH=$$GET1^DIQ(396.2026,DVBINN2,".03","E")
....S DVBRESP=$$GET1^DIQ(396.2026,DVBINN2,".04","E")
....S DVBCNNT=DVBCNNT+1 S ^TMP("CAPRI TRANSRPT",$J,DVBNAME,DVBTRDT,DVBCNNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
....Q
.S DVBRTN=$NA(^TMP("CAPRI TRANSRPT",$J))
.Q
K DVBCNNT,X,Y,DVBCT,DVBINN1,DVBSTA,DVBNAME,DVBPT,DVBCNT,DVBINN2,DVBAUTH,DVBTRDT,DVBRESP,DVBCHKDT,DVBDT
Q
ADDPDF(DVBRTN,DVBIEN,DVBEXAMNAME) ;
;Adding an exam to an existing worksheet CAPRI-9010 CP
N DVBERR,DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBFORM,DVBDTTM,DVBPREV,DVBRTFG,DVBEN2,DVBPN2
S (DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBDTTM,DVBFORM,DVBPREV,DVBRTFG)=""
S DVBPREVSEQ=$P($G(^DVB(396.17,DVBIEN,1,0),""),U,3)
S DVBFORM=$G(^DVB(396.17,DVBIEN,4))
F DVBI=1:1:DVBPREVSEQ D
. S DVBPREV=$G(^DVB(396.17,DVBIEN,1,DVBI,0))
.;;Updates for version numbers CAPRI-10405 CP
. S DVBPN2=$P(DVBPREV,U,2)
. S DVBPN2=$$NAMEUPD(DVBPN2)
. S DVBEN2=$$NAMEUPD(DVBEXAMNAME)
. I ("*DEL*"_DVBEN2)=DVBPN2 D
. . S $P(DVBPREV,U,2)=DVBEXAMNAME
. . S DVBEXAMSEQ(DVBI)=DVBPREV,DVBRTFG=DVBIEN_U_$P(DVBPREV,U,2)_U_$P(DVBPREV,U,1)
. . Q
. I $D(DVBEXAMSEQ(DVBI))=1 Q
. S DVBEXAMSEQ(DVBI)=$G(^DVB(396.17,DVBIEN,1,DVBI,0))
I DVBRTFG="" D
. S DVBNEWSEQ=DVBPREVSEQ+1
. S DVBEXAMSEQ(DVBNEWSEQ)=DVBNEWSEQ_"^"_DVBEXAMNAME_"^0"
. K DIC,DIE,DA,DR,DLAYGO,X,Y
. S DA(1)=DVBIEN,(DA,X)=DVBPREVSEQ
. S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",1,",DIC(0)="LZ"
. D ^DIC
I DVBRTFG="" S DVBRTN=DVBIEN_U_DVBEXAMNAME_U_DVBNEWSEQ
I DVBRTFG'="" S DVBRTN=DVBRTFG_U_"Exam has been Restored"
D WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
I $D(DVBERR) S DVBRTN="-1^Data Not Saved" Q
K DIC,DIE,DA,DR,DLAYGO,X,Y
S DVBDTTM=$$NOW^XLFDT
S DA=DVBIEN,DIE=396.17
S DR="4///"_DVBDTTM
I DVBFORM'="MERGED FORM" S DR=DR_";9///MERGED FORM"
D ^DIE
K DIC,DIE,DA,DR,DLAYGO,X,Y
K DVBPREVSEQ
Q
DELETEXAM(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME) ;
;Deleting an exam from Worksheet CAPRI-9010 CP
N DVBERR,DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBDTTM,DVBCNT,DVBFORM
S DVBCNT=0
S DVBCUR=$G(^DVB(396.17,DVBIEN,1,DVBSEQ,0),"")
I $P(DVBCUR,U,2)'=DVBEXAMNAME S DVBRTN="-1^Exam Names do not match" Q
S DVBPREVSEQ=$P($G(^DVB(396.17,DVBIEN,1,0),""),U,3)
F DVBI=1:1:DVBPREVSEQ D
. I DVBI=DVBSEQ D
. . S DVBNAME=$P($G(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
. . S DVBSAVE=$P($G(^DVB(396.17,DVBIEN,1,DVBI,0)),U,3)
. . S DVBEXAMSEQ(DVBI)=DVBI_U_"*DEL*"_DVBNAME_U_DVBSAVE
. I DVBI'=DVBSEQ S DVBEXAMSEQ(DVBI)=$G(^DVB(396.17,DVBIEN,1,DVBI,0))
D WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
I $D(DVBERR) S DVBRTN="-1^Data Not Saved" Q
I $D(DVBERR)=0 S DVBRTN="1"
K DIC,DIE,DA,DR,DLAYGO,X,Y
F DVBI=1:1:DVBPREVSEQ D
. I $G(^DVB(396.17,DVBIEN,1,DVBI,0))["*DEL*" Q
. I $G(^DVB(396.17,DVBIEN,1,DVBI,0))'["*DEL*" D
. . S DVBCNT=DVBCNT+1
. . S DVBFORM=$P($G(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
S DVBDTTM=$$NOW^XLFDT
S DA=DVBIEN,DIE=396.17
S DR="4///"_DVBDTTM
I DVBCNT=1 S DR=DR_";9///"_DVBFORM
D ^DIE
K DIC,DIE,DA,DR,DLAYGO,X,Y
K DVBCUR,DVBPREVSEQ
Q
EXAMHIST(DVBRTN,DVBIEN) ;Exam history - CAPRI-9413. JD - 4/3/24
;Returns the exam history for a given worksheet
;
;Corresponding RPC: DVBA CAPRI GET EXAM HISTORY
;
;Updating return details to include save message, version, and user CAPRI-11245 CP 6/21/24
I DVBIEN="" S DVBRTN="-1^No worksheet IEN was provided" Q
I '$D(^DVB(396.17,DVBIEN,0)) S DVBRTN="-1^Worksheet IEN="_DVBIEN_" does not exist" Q
K ^TMP("DVBAEXAMHIST",$J)
N DVBCNT,DVBEXNM,DVBEXSQ,DVBEXSV,DVBEXSVDT,DVBSMSG,DVBVER,DVBUSER
S (DVBCNT,DVBEXNM,DVBEXSQ,DVBEXSVDT,DVBSMSG,DVBVER,DVBUSER)=""
F S DVBEXSQ=$O(^DVB(396.17,DVBIEN,15,"B",DVBEXSQ)) Q:DVBEXSQ="" D
. S DVBEXSV="",DVBEXNM=$P($G(^DVB(396.17,DVBIEN,1,DVBEXSQ,0)),U,2)
. F S DVBEXSV=$O(^DVB(396.17,DVBIEN,15,"B",DVBEXSQ,DVBEXSV)) Q:DVBEXSV="" D
. . S DVBEXSVDT=$P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U),DVBCNT=DVBCNT+1
. . S DVBEXSVDT=$$FMTE^XLFDT(DVBEXSVDT)
. . I $P(DVBEXSVDT,":",3)="" S DVBEXSVDT=DVBEXSVDT_":00"
. . S DVBSMSG=$P($P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",2)
. . S DVBVER=$P($P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",3)
. . S DVBUSER=$P($P($G(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",4)
. . S DVBUSER=$$GET1^DIQ(200,DVBUSER,".01","E")
. . S ^TMP("DVBAEXAMHIST",$J,DVBCNT)=DVBEXSQ_U_DVBEXNM_U_DVBEXSV_U_DVBEXSVDT_U_DVBSMSG_U_DVBVER_U_DVBUSER
I DVBCNT'>0 S DVBRTN="-1^Worksheet IEN="_DVBIEN_" has no exam history" Q
S DVBRTN=$NA(^TMP("DVBAEXAMHIST",$J))
Q
RESTORE(DVBRTN,DVBIEN,DVBSEQ,DVBEXAM,DVBSAVE,DVBDATE) ;
;Restoring an exam from Worksheet History CAPRI-9010 CP
N DVBERR,DVBTAB,DVBPDFDATA,DVBTOT,DVBI,DVBARTN,DVBEXAM2,DVBDTM,%DT,DVBMESS,DVBEXNMX,DVBDATA1,DVBTEXT1,DVBDATA2,DVBTEXT2,DVBSMSG,DVBVER,DVBTM
S (DVBERR,DVBTAB,DVBTOT,DVBI,DVBARTN,DVBDTM,DVBSMSG,DVBVER)=""
;
S DVBMESS=$S(DVBIEN="":"Worksheet IEN",DVBSEQ="":"Exam Seq",DVBEXAM="":"Exam Name",DVBSAVE="":"Save Seq",DVBDATE="":"Save DateTime",1:"")
I DVBMESS'="" S DVBRTN="-1^Missing "_DVBMESS Q
S X=$P(DVBDATE,"@",1),%DT="" D ^%DT S DVBDTM=Y
I DVBDTM="-1" S DVBRTN="-1^Invalid DateTime Format:" Q
K %DT
;
;;Correcting for saved time format CAPRI-13217 CP 8-28-24
S DVBTM=$TR($P(DVBDATE,"@",2),":")
I $E(DVBTM,5,6)="00" S DVBTM=$E(DVBTM,1,4)
I $E(DVBTM,6)=0 S DVBTM=$E(DVBTM,1,5)
;
;;Updates for version numbers CAPRI-10405 CP
S DVBEXNMX=$$NAMEUPD(DVBEXAM)
S DVBARTN=""
S DVBDATA1=$P($G(^DVB(396.17,DVBIEN,1,DVBSEQ,0)),U,1,2)
S DVBDATA1=$$NAMEUPD(DVBDATA1)
S DVBTEXT1=DVBSEQ_U_DVBEXNMX
I DVBDATA1'=DVBTEXT1 S DVBRTN="-1^Incorrect Exam Name and Seq Number" Q
I DVBEXAM["*DEL*" S DVBEXAM2=$P(DVBEXAM,"*",3) D ADDPDF(.DVBARTN,DVBIEN,DVBEXAM2)
I DVBARTN["-1^" S DVBRTN=DVBARTN Q
I DVBARTN'="" S DVBEXAM=$P(DVBARTN,U,2),DVBEXNMX=$$NAMEUPD(DVBEXAM)
S DVBDTM=DVBDTM_"."_DVBTM
;;Updating for correct pull of date/time and exam name CAPRI-13217 CP 8-28-24
S DVBDATA2=$P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,1)),U,1,2)
S DVBDATA2=$$NAMEUPD(DVBDATA2)
S DVBTEXT2=DVBDTM_U_DVBEXNMX
I DVBDATA2'=DVBTEXT2 S DVBRTN="-1^Worksheet IEN/Save Seq do not match Save DateTime and Exam Name" Q
;;CAPRI-11245 CP 6/21/24
S DVBTAB=$P($P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,1),""),U,3),"|",1)
S DVBSMSG="RESTORE"
S DVBVER=$P($P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,1),""),U,3),"|",3)
;
S DVBPDFDATA=""
S DVBTOT=$P($G(^DVB(396.17,DVBIEN,15,DVBSAVE,2,0),""),U,3)
I DVBTOT'?.N S DVBRTN="-1^Error with PDF Data" Q
F DVBI=1:1:DVBTOT S DVBPDFDATA(DVBI)=$G(^DVB(396.17,DVBIEN,15,DVBSAVE,2,DVBI,0))
;
D PDFSAVE^DVBCTPDF(.DVBERR,DVBIEN,DVBSEQ,DVBEXAM,.DVBPDFDATA,DVBTAB,DVBSMSG,DVBVER)
S DVBRTN=DVBERR Q
;
Q
NAMEUPD(DVBEXAM) ;
N DVBCNT,DVBEND,DVBEXNM2
S DVBCNT=$L(DVBEXAM,"_")
S DVBEND=DVBCNT-1
I DVBEND=0 Q DVBEXAM
S DVBEXNM2=$P(DVBEXAM,"_",1,DVBEND)
I DVBEXNM2="" S DVBEXNM2=DVBEXAM
Q DVBEXNM2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCTPD2 9266 printed Aug 26, 2025@22:04:44 Page 2
DVBCTPD2 ;ALB/BG/JD/CP - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 10/4/23 10:07am
+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 $$NOW^XLFDT and $$FMTE^XLFDT in ICR #10103
+4 QUIT
+5 ;
TRANSRPT(DVBRTN,DVBIEN,DVBSDT,DVBEDT) ;
+1 KILL ^TMP("CAPRI TRANSRPT",$JOB)
SET DVBCNNT=""
+2 IF DVBIEN'=""
Begin DoDot:1
+3 SET DVBCT=0
FOR
SET DVBCT=$ORDER(^DVB(396.17,DVBIEN,14,"B",DVBCT))
if DVBCT=""
QUIT
Begin DoDot:2
+4 SET DVBINN1=""_DVBCT_","_DVBIEN_","_""
+5 SET DVBSTA=$$GET1^DIQ(396.1726,DVBINN1,".02","E")
+6 SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","I")
+7 ;;Updating for name w/o version CPARI-9567 CP 05/14/24
+8 IF DVBNAME["_"
SET DVBNAME=$$NAMEUPD(DVBNAME)
+9 IF DVBNAME?.N
SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","E")
+10 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+11 SET DVBCNT=0
FOR
SET DVBCNT=$ORDER(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT))
if DVBCNT=""
QUIT
Begin DoDot:3
+12 SET DVBINN2=""_DVBCNT_","_DVBCT_","_DVBIEN_","_""
+13 SET DVBAUTH=$$GET1^DIQ(396.2026,DVBINN2,".03","E")
+14 SET DVBTRDT=$$GET1^DIQ(396.2026,DVBINN2,".02","E")
+15 SET DVBRESP=$$GET1^DIQ(396.2026,DVBINN2,".04","E")
+16 SET DVBCNNT=DVBCNNT+1
SET ^TMP("CAPRI TRANSRPT",$JOB,DVBNAME,DVBTRDT,DVBCNNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
+17 QUIT
End DoDot:3
End DoDot:2
+18 SET DVBRTN=$NAME(^TMP("CAPRI TRANSRPT",$JOB))
+19 QUIT
End DoDot:1
+20 ;;
+21 IF DVBIEN=""
Begin DoDot:1
+22 SET DVBDT=$$NOW^XLFDT
+23 IF DVBSDT=""
IF DVBEDT=""
SET DVBRTN="-1^MISSING DATE RANGE"
QUIT
+24 SET X=$GET(DVBSDT)
DO ^%DT
SET DVBSDT=Y
+25 IF DVBEDT'=""
SET X=DVBEDT
DO ^%DT
SET DVBEDT=Y
+26 IF DVBEDT=""
SET DVBEDT=$PIECE(DVBDT,".",1)
+27 SET DVBIEN=0
FOR
SET DVBIEN=$ORDER(^DVB(396.17,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:2
+28 SET DVBCT=0
FOR
SET DVBCT=$ORDER(^DVB(396.17,DVBIEN,14,"B",DVBCT))
if DVBCT=""
QUIT
Begin DoDot:3
+29 SET DVBINN1=""_DVBCT_","_DVBIEN_","_""
+30 SET DVBCNT=0
FOR
SET DVBCNT=$ORDER(^DVB(396.17,DVBIEN,14,DVBCT,10,"B",DVBCNT))
if DVBCNT=""
QUIT
Begin DoDot:4
+31 SET DVBINN2=""_DVBCNT_","_DVBCT_","_DVBIEN_","_""
+32 SET DVBCHKDT=$$GET1^DIQ(396.2026,DVBINN2,".02","I")
+33 SET DVBCHKDT=$PIECE(DVBCHKDT,".",1)
+34 IF DVBCHKDT<DVBSDT
QUIT
+35 IF DVBCHKDT>DVBEDT
QUIT
+36 SET DVBTRDT=$$GET1^DIQ(396.2026,DVBINN2,".02","E")
+37 SET DVBSTA=$$GET1^DIQ(396.1726,DVBINN1,".02","E")
+38 SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","I")
+39 ;;Updating for name w/o version CPARI-9567 CP 05/14/24
+40 IF DVBNAME["_"
SET DVBNAME=$$NAMEUPD(DVBNAME)
+41 IF DVBNAME?.N
SET DVBNAME=$$GET1^DIQ(396.1726,DVBINN1,".03","E")
+42 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+43 SET DVBAUTH=$$GET1^DIQ(396.2026,DVBINN2,".03","E")
+44 SET DVBRESP=$$GET1^DIQ(396.2026,DVBINN2,".04","E")
+45 SET DVBCNNT=DVBCNNT+1
SET ^TMP("CAPRI TRANSRPT",$JOB,DVBNAME,DVBTRDT,DVBCNNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
+46 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
+47 SET DVBRTN=$NAME(^TMP("CAPRI TRANSRPT",$JOB))
+48 QUIT
End DoDot:1
+49 KILL DVBCNNT,X,Y,DVBCT,DVBINN1,DVBSTA,DVBNAME,DVBPT,DVBCNT,DVBINN2,DVBAUTH,DVBTRDT,DVBRESP,DVBCHKDT,DVBDT
+50 QUIT
ADDPDF(DVBRTN,DVBIEN,DVBEXAMNAME) ;
+1 ;Adding an exam to an existing worksheet CAPRI-9010 CP
+2 NEW DVBERR,DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBFORM,DVBDTTM,DVBPREV,DVBRTFG,DVBEN2,DVBPN2
+3 SET (DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBDTTM,DVBFORM,DVBPREV,DVBRTFG)=""
+4 SET DVBPREVSEQ=$PIECE($GET(^DVB(396.17,DVBIEN,1,0),""),U,3)
+5 SET DVBFORM=$GET(^DVB(396.17,DVBIEN,4))
+6 FOR DVBI=1:1:DVBPREVSEQ
Begin DoDot:1
+7 SET DVBPREV=$GET(^DVB(396.17,DVBIEN,1,DVBI,0))
+8 ;;Updates for version numbers CAPRI-10405 CP
+9 SET DVBPN2=$PIECE(DVBPREV,U,2)
+10 SET DVBPN2=$$NAMEUPD(DVBPN2)
+11 SET DVBEN2=$$NAMEUPD(DVBEXAMNAME)
+12 IF ("*DEL*"_DVBEN2)=DVBPN2
Begin DoDot:2
+13 SET $PIECE(DVBPREV,U,2)=DVBEXAMNAME
+14 SET DVBEXAMSEQ(DVBI)=DVBPREV
SET DVBRTFG=DVBIEN_U_$PIECE(DVBPREV,U,2)_U_$PIECE(DVBPREV,U,1)
+15 QUIT
End DoDot:2
+16 IF $DATA(DVBEXAMSEQ(DVBI))=1
QUIT
+17 SET DVBEXAMSEQ(DVBI)=$GET(^DVB(396.17,DVBIEN,1,DVBI,0))
End DoDot:1
+18 IF DVBRTFG=""
Begin DoDot:1
+19 SET DVBNEWSEQ=DVBPREVSEQ+1
+20 SET DVBEXAMSEQ(DVBNEWSEQ)=DVBNEWSEQ_"^"_DVBEXAMNAME_"^0"
+21 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+22 SET DA(1)=DVBIEN
SET (DA,X)=DVBPREVSEQ
+23 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",1,"
SET DIC(0)="LZ"
+24 DO ^DIC
End DoDot:1
+25 IF DVBRTFG=""
SET DVBRTN=DVBIEN_U_DVBEXAMNAME_U_DVBNEWSEQ
+26 IF DVBRTFG'=""
SET DVBRTN=DVBRTFG_U_"Exam has been Restored"
+27 DO WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
+28 IF $DATA(DVBERR)
SET DVBRTN="-1^Data Not Saved"
QUIT
+29 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+30 SET DVBDTTM=$$NOW^XLFDT
+31 SET DA=DVBIEN
SET DIE=396.17
+32 SET DR="4///"_DVBDTTM
+33 IF DVBFORM'="MERGED FORM"
SET DR=DR_";9///MERGED FORM"
+34 DO ^DIE
+35 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+36 KILL DVBPREVSEQ
+37 QUIT
DELETEXAM(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME) ;
+1 ;Deleting an exam from Worksheet CAPRI-9010 CP
+2 NEW DVBERR,DVBEXAMSEQ,DVBI,DVBNEWSEQ,DVBDTTM,DVBCNT,DVBFORM
+3 SET DVBCNT=0
+4 SET DVBCUR=$GET(^DVB(396.17,DVBIEN,1,DVBSEQ,0),"")
+5 IF $PIECE(DVBCUR,U,2)'=DVBEXAMNAME
SET DVBRTN="-1^Exam Names do not match"
QUIT
+6 SET DVBPREVSEQ=$PIECE($GET(^DVB(396.17,DVBIEN,1,0),""),U,3)
+7 FOR DVBI=1:1:DVBPREVSEQ
Begin DoDot:1
+8 IF DVBI=DVBSEQ
Begin DoDot:2
+9 SET DVBNAME=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
+10 SET DVBSAVE=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBI,0)),U,3)
+11 SET DVBEXAMSEQ(DVBI)=DVBI_U_"*DEL*"_DVBNAME_U_DVBSAVE
End DoDot:2
+12 IF DVBI'=DVBSEQ
SET DVBEXAMSEQ(DVBI)=$GET(^DVB(396.17,DVBIEN,1,DVBI,0))
End DoDot:1
+13 DO WP^DIE(396.17,DVBIEN_",",6,"K","DVBEXAMSEQ","DVBERR")
+14 IF $DATA(DVBERR)
SET DVBRTN="-1^Data Not Saved"
QUIT
+15 IF $DATA(DVBERR)=0
SET DVBRTN="1"
+16 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+17 FOR DVBI=1:1:DVBPREVSEQ
Begin DoDot:1
+18 IF $GET(^DVB(396.17,DVBIEN,1,DVBI,0))["*DEL*"
QUIT
+19 IF $GET(^DVB(396.17,DVBIEN,1,DVBI,0))'["*DEL*"
Begin DoDot:2
+20 SET DVBCNT=DVBCNT+1
+21 SET DVBFORM=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBI,0)),U,2)
End DoDot:2
End DoDot:1
+22 SET DVBDTTM=$$NOW^XLFDT
+23 SET DA=DVBIEN
SET DIE=396.17
+24 SET DR="4///"_DVBDTTM
+25 IF DVBCNT=1
SET DR=DR_";9///"_DVBFORM
+26 DO ^DIE
+27 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+28 KILL DVBCUR,DVBPREVSEQ
+29 QUIT
EXAMHIST(DVBRTN,DVBIEN) ;Exam history - CAPRI-9413. JD - 4/3/24
+1 ;Returns the exam history for a given worksheet
+2 ;
+3 ;Corresponding RPC: DVBA CAPRI GET EXAM HISTORY
+4 ;
+5 ;Updating return details to include save message, version, and user CAPRI-11245 CP 6/21/24
+6 IF DVBIEN=""
SET DVBRTN="-1^No worksheet IEN was provided"
QUIT
+7 IF '$DATA(^DVB(396.17,DVBIEN,0))
SET DVBRTN="-1^Worksheet IEN="_DVBIEN_" does not exist"
QUIT
+8 KILL ^TMP("DVBAEXAMHIST",$JOB)
+9 NEW DVBCNT,DVBEXNM,DVBEXSQ,DVBEXSV,DVBEXSVDT,DVBSMSG,DVBVER,DVBUSER
+10 SET (DVBCNT,DVBEXNM,DVBEXSQ,DVBEXSVDT,DVBSMSG,DVBVER,DVBUSER)=""
+11 FOR
SET DVBEXSQ=$ORDER(^DVB(396.17,DVBIEN,15,"B",DVBEXSQ))
if DVBEXSQ=""
QUIT
Begin DoDot:1
+12 SET DVBEXSV=""
SET DVBEXNM=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBEXSQ,0)),U,2)
+13 FOR
SET DVBEXSV=$ORDER(^DVB(396.17,DVBIEN,15,"B",DVBEXSQ,DVBEXSV))
if DVBEXSV=""
QUIT
Begin DoDot:2
+14 SET DVBEXSVDT=$PIECE($GET(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U)
SET DVBCNT=DVBCNT+1
+15 SET DVBEXSVDT=$$FMTE^XLFDT(DVBEXSVDT)
+16 IF $PIECE(DVBEXSVDT,":",3)=""
SET DVBEXSVDT=DVBEXSVDT_":00"
+17 SET DVBSMSG=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",2)
+18 SET DVBVER=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",3)
+19 SET DVBUSER=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBEXSV,1)),U,3),"|",4)
+20 SET DVBUSER=$$GET1^DIQ(200,DVBUSER,".01","E")
+21 SET ^TMP("DVBAEXAMHIST",$JOB,DVBCNT)=DVBEXSQ_U_DVBEXNM_U_DVBEXSV_U_DVBEXSVDT_U_DVBSMSG_U_DVBVER_U_DVBUSER
End DoDot:2
End DoDot:1
+22 IF DVBCNT'>0
SET DVBRTN="-1^Worksheet IEN="_DVBIEN_" has no exam history"
QUIT
+23 SET DVBRTN=$NAME(^TMP("DVBAEXAMHIST",$JOB))
+24 QUIT
RESTORE(DVBRTN,DVBIEN,DVBSEQ,DVBEXAM,DVBSAVE,DVBDATE) ;
+1 ;Restoring an exam from Worksheet History CAPRI-9010 CP
+2 NEW DVBERR,DVBTAB,DVBPDFDATA,DVBTOT,DVBI,DVBARTN,DVBEXAM2,DVBDTM,%DT,DVBMESS,DVBEXNMX,DVBDATA1,DVBTEXT1,DVBDATA2,DVBTEXT2,DVBSMSG,DVBVER,DVBTM
+3 SET (DVBERR,DVBTAB,DVBTOT,DVBI,DVBARTN,DVBDTM,DVBSMSG,DVBVER)=""
+4 ;
+5 SET DVBMESS=$SELECT(DVBIEN="":"Worksheet IEN",DVBSEQ="":"Exam Seq",DVBEXAM="":"Exam Name",DVBSAVE="":"Save Seq",DVBDATE="":"Save DateTime",1:"")
+6 IF DVBMESS'=""
SET DVBRTN="-1^Missing "_DVBMESS
QUIT
+7 SET X=$PIECE(DVBDATE,"@",1)
SET %DT=""
DO ^%DT
SET DVBDTM=Y
+8 IF DVBDTM="-1"
SET DVBRTN="-1^Invalid DateTime Format:"
QUIT
+9 KILL %DT
+10 ;
+11 ;;Correcting for saved time format CAPRI-13217 CP 8-28-24
+12 SET DVBTM=$TRANSLATE($PIECE(DVBDATE,"@",2),":")
+13 IF $EXTRACT(DVBTM,5,6)="00"
SET DVBTM=$EXTRACT(DVBTM,1,4)
+14 IF $EXTRACT(DVBTM,6)=0
SET DVBTM=$EXTRACT(DVBTM,1,5)
+15 ;
+16 ;;Updates for version numbers CAPRI-10405 CP
+17 SET DVBEXNMX=$$NAMEUPD(DVBEXAM)
+18 SET DVBARTN=""
+19 SET DVBDATA1=$PIECE($GET(^DVB(396.17,DVBIEN,1,DVBSEQ,0)),U,1,2)
+20 SET DVBDATA1=$$NAMEUPD(DVBDATA1)
+21 SET DVBTEXT1=DVBSEQ_U_DVBEXNMX
+22 IF DVBDATA1'=DVBTEXT1
SET DVBRTN="-1^Incorrect Exam Name and Seq Number"
QUIT
+23 IF DVBEXAM["*DEL*"
SET DVBEXAM2=$PIECE(DVBEXAM,"*",3)
DO ADDPDF(.DVBARTN,DVBIEN,DVBEXAM2)
+24 IF DVBARTN["-1^"
SET DVBRTN=DVBARTN
QUIT
+25 IF DVBARTN'=""
SET DVBEXAM=$PIECE(DVBARTN,U,2)
SET DVBEXNMX=$$NAMEUPD(DVBEXAM)
+26 SET DVBDTM=DVBDTM_"."_DVBTM
+27 ;;Updating for correct pull of date/time and exam name CAPRI-13217 CP 8-28-24
+28 SET DVBDATA2=$PIECE($GET(^DVB(396.17,DVBIEN,15,DVBSAVE,1)),U,1,2)
+29 SET DVBDATA2=$$NAMEUPD(DVBDATA2)
+30 SET DVBTEXT2=DVBDTM_U_DVBEXNMX
+31 IF DVBDATA2'=DVBTEXT2
SET DVBRTN="-1^Worksheet IEN/Save Seq do not match Save DateTime and Exam Name"
QUIT
+32 ;;CAPRI-11245 CP 6/21/24
+33 SET DVBTAB=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBSAVE,1),""),U,3),"|",1)
+34 SET DVBSMSG="RESTORE"
+35 SET DVBVER=$PIECE($PIECE($GET(^DVB(396.17,DVBIEN,15,DVBSAVE,1),""),U,3),"|",3)
+36 ;
+37 SET DVBPDFDATA=""
+38 SET DVBTOT=$PIECE($GET(^DVB(396.17,DVBIEN,15,DVBSAVE,2,0),""),U,3)
+39 IF DVBTOT'?.N
SET DVBRTN="-1^Error with PDF Data"
QUIT
+40 FOR DVBI=1:1:DVBTOT
SET DVBPDFDATA(DVBI)=$GET(^DVB(396.17,DVBIEN,15,DVBSAVE,2,DVBI,0))
+41 ;
+42 DO PDFSAVE^DVBCTPDF(.DVBERR,DVBIEN,DVBSEQ,DVBEXAM,.DVBPDFDATA,DVBTAB,DVBSMSG,DVBVER)
+43 SET DVBRTN=DVBERR
QUIT
+44 ;
+45 QUIT
NAMEUPD(DVBEXAM) ;
+1 NEW DVBCNT,DVBEND,DVBEXNM2
+2 SET DVBCNT=$LENGTH(DVBEXAM,"_")
+3 SET DVBEND=DVBCNT-1
+4 IF DVBEND=0
QUIT DVBEXAM
+5 SET DVBEXNM2=$PIECE(DVBEXAM,"_",1,DVBEND)
+6 IF DVBEXNM2=""
SET DVBEXNM2=DVBEXAM
+7 QUIT DVBEXNM2
