DVBCTPD2 ;ALB/BG/JD/CP - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 3/17/25 1:25pm
;;2.7;AMIE;**250,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
;
TRANSRPT(DVBRTN,DVBIEN,DVBSDT,DVBEDT) ;
;RPC: DVBA CAPRI GET EXAM REPORT
;CAPRI-16627 4/10/25 CP Updating to match corrected save format
K ^TMP("CAPRI TRANSRPT",$J)
N DVBXMLIEN,DVBIEN2,DVBSTA,DVBNAME,DVBPT,DVBSEQ,DVBI,DVBIEN3
N DVBAUTH,DVBTRDT,DVBRESP,DVBCNT,DVBDT,DVBCHKDT
S DVBCNT=""
I DVBIEN'="" D
.S DVBXMLIEN=0 F S DVBXMLIEN=$O(^DVB(396.17,DVBIEN,14,DVBXMLIEN)) Q:DVBXMLIEN="" D
..S DVBIEN2=""_DVBXMLIEN_","_DVBIEN_","_""
..S DVBSTA=$$GET1^DIQ(396.1726,DVBIEN2,".02","E")
..S DVBNAME=$$GET1^DIQ(396.1726,DVBIEN2,".03","I")
..;Updating for name w/o version CAPRI-9567 CP 05/14/24
..I DVBNAME["_" S DVBNAME=$$NAMEUPD(DVBNAME)
..I DVBNAME?.N S DVBNAME=$$GET1^DIQ(396.1726,DVBIEN2,".03","E")
..S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
..S DVBSEQ=$P($G(^DVB(396.17,DVBIEN,14,DVBXMLIEN,10,0)),U,3)
..F DVBI=1:1:DVBSEQ D
...S DVBIEN3=""_DVBI_","_DVBXMLIEN_","_DVBIEN_","_""
...S DVBAUTH=$$GET1^DIQ(396.2026,DVBIEN3,".03","E")
...S DVBTRDT=$$GET1^DIQ(396.2026,DVBIEN3,".02","E")
...S DVBRESP=$$GET1^DIQ(396.2026,DVBIEN3,".04","E")
...S DVBCNT=DVBCNT+1 S ^TMP("CAPRI TRANSRPT",$J,DVBNAME,DVBTRDT,DVBCNT)=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 DVBXMLIEN=0 F S DVBXMLIEN=$O(^DVB(396.17,DVBIEN,14,DVBXMLIEN)) Q:DVBXMLIEN="" D
...S DVBSEQ=$P($G(^DVB(396.17,DVBIEN,14,DVBXMLIEN,10,0)),U,3)
...F DVBI=1:1:DVBSEQ D
....S DVBIEN3=""_DVBI_","_DVBXMLIEN_","_DVBIEN_","_""
....S DVBCHKDT=$$GET1^DIQ(396.2026,DVBIEN3,".02","I")
....S DVBCHKDT=$P(DVBCHKDT,".",1)
....I DVBCHKDT<DVBSDT Q
....I DVBCHKDT>DVBEDT Q
....S DVBIEN2=""_DVBXMLIEN_","_DVBIEN_","_""
....S DVBTRDT=$$GET1^DIQ(396.2026,DVBIEN3,".02","E")
....S DVBSTA=$$GET1^DIQ(396.1726,DVBIEN2,".02","E")
....S DVBNAME=$$GET1^DIQ(396.1726,DVBIEN2,".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,DVBIEN2,".03","E")
....S DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
....S DVBAUTH=$$GET1^DIQ(396.2026,DVBIEN3,".03","E")
....S DVBRESP=$$GET1^DIQ(396.2026,DVBIEN3,".04","E")
....S DVBCNT=DVBCNT+1 S ^TMP("CAPRI TRANSRPT",$J,DVBNAME,DVBTRDT,DVBCNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
....Q
.S DVBRTN=$NA(^TMP("CAPRI TRANSRPT",$J))
.Q
K X,Y,DVBSTA,DVBNAME,DVBPT,DVBCNT,DVBAUTH,DVBTRDT,DVBRESP,DVBCHKDT,DVBDT
Q
ADDPDF(DVBRTN,DVBIEN,DVBEXAMNAME) ;DVBA CAPRI ADD EXAM
;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
;Capri-17003 BG 3/17/25
S DR="4////"_DVBDTTM
I DVBFORM'="MERGED FORM" S DR=DR_";9////MERGED FORM"
D ^DIE
K DIC,DIE,DA,DR,DLAYGO,X,Y,DVBPREVSEQ
I $$GET1^DIQ(396.17,DVBIEN,4,"I")'=DVBDTTM S DVBRTN="-1^Data Not Saved" Q
Q
DELETEXAM(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME) ;DVBA CAPRI DELETE EXAM
;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
;Capri-17003 BG 3/17/25
S DR="4////"_DVBDTTM
I DVBCNT=1 S DR=DR_";9////"_DVBFORM
D ^DIE
K DIC,DIE,DA,DR,DLAYGO,X,Y,DVBCUR,DVBPREVSEQ
I $$GET1^DIQ(396.17,DVBIEN,4,"I")'=DVBDTTM S DVBRTN="-1^Data Not Saved" Q
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 9719 printed Sep 23, 2025@19:25 Page 2
DVBCTPD2 ;ALB/BG/JD/CP - CAPRI XML RPCS; FEB 6, 2023@16:20 ; 3/17/25 1:25pm
+1 ;;2.7;AMIE;**250,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 ;
TRANSRPT(DVBRTN,DVBIEN,DVBSDT,DVBEDT) ;
+1 ;RPC: DVBA CAPRI GET EXAM REPORT
+2 ;CAPRI-16627 4/10/25 CP Updating to match corrected save format
+3 KILL ^TMP("CAPRI TRANSRPT",$JOB)
+4 NEW DVBXMLIEN,DVBIEN2,DVBSTA,DVBNAME,DVBPT,DVBSEQ,DVBI,DVBIEN3
+5 NEW DVBAUTH,DVBTRDT,DVBRESP,DVBCNT,DVBDT,DVBCHKDT
+6 SET DVBCNT=""
+7 IF DVBIEN'=""
Begin DoDot:1
+8 SET DVBXMLIEN=0
FOR
SET DVBXMLIEN=$ORDER(^DVB(396.17,DVBIEN,14,DVBXMLIEN))
if DVBXMLIEN=""
QUIT
Begin DoDot:2
+9 SET DVBIEN2=""_DVBXMLIEN_","_DVBIEN_","_""
+10 SET DVBSTA=$$GET1^DIQ(396.1726,DVBIEN2,".02","E")
+11 SET DVBNAME=$$GET1^DIQ(396.1726,DVBIEN2,".03","I")
+12 ;Updating for name w/o version CAPRI-9567 CP 05/14/24
+13 IF DVBNAME["_"
SET DVBNAME=$$NAMEUPD(DVBNAME)
+14 IF DVBNAME?.N
SET DVBNAME=$$GET1^DIQ(396.1726,DVBIEN2,".03","E")
+15 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+16 SET DVBSEQ=$PIECE($GET(^DVB(396.17,DVBIEN,14,DVBXMLIEN,10,0)),U,3)
+17 FOR DVBI=1:1:DVBSEQ
Begin DoDot:3
+18 SET DVBIEN3=""_DVBI_","_DVBXMLIEN_","_DVBIEN_","_""
+19 SET DVBAUTH=$$GET1^DIQ(396.2026,DVBIEN3,".03","E")
+20 SET DVBTRDT=$$GET1^DIQ(396.2026,DVBIEN3,".02","E")
+21 SET DVBRESP=$$GET1^DIQ(396.2026,DVBIEN3,".04","E")
+22 SET DVBCNT=DVBCNT+1
SET ^TMP("CAPRI TRANSRPT",$JOB,DVBNAME,DVBTRDT,DVBCNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
+23 QUIT
End DoDot:3
End DoDot:2
+24 SET DVBRTN=$NAME(^TMP("CAPRI TRANSRPT",$JOB))
+25 QUIT
End DoDot:1
+26 ;
+27 IF DVBIEN=""
Begin DoDot:1
+28 SET DVBDT=$$NOW^XLFDT
+29 IF DVBSDT=""
IF DVBEDT=""
SET DVBRTN="-1^MISSING DATE RANGE"
QUIT
+30 SET X=$GET(DVBSDT)
DO ^%DT
SET DVBSDT=Y
+31 IF DVBEDT'=""
SET X=DVBEDT
DO ^%DT
SET DVBEDT=Y
+32 IF DVBEDT=""
SET DVBEDT=$PIECE(DVBDT,".",1)
+33 SET DVBIEN=0
FOR
SET DVBIEN=$ORDER(^DVB(396.17,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:2
+34 SET DVBXMLIEN=0
FOR
SET DVBXMLIEN=$ORDER(^DVB(396.17,DVBIEN,14,DVBXMLIEN))
if DVBXMLIEN=""
QUIT
Begin DoDot:3
+35 SET DVBSEQ=$PIECE($GET(^DVB(396.17,DVBIEN,14,DVBXMLIEN,10,0)),U,3)
+36 FOR DVBI=1:1:DVBSEQ
Begin DoDot:4
+37 SET DVBIEN3=""_DVBI_","_DVBXMLIEN_","_DVBIEN_","_""
+38 SET DVBCHKDT=$$GET1^DIQ(396.2026,DVBIEN3,".02","I")
+39 SET DVBCHKDT=$PIECE(DVBCHKDT,".",1)
+40 IF DVBCHKDT<DVBSDT
QUIT
+41 IF DVBCHKDT>DVBEDT
QUIT
+42 SET DVBIEN2=""_DVBXMLIEN_","_DVBIEN_","_""
+43 SET DVBTRDT=$$GET1^DIQ(396.2026,DVBIEN3,".02","E")
+44 SET DVBSTA=$$GET1^DIQ(396.1726,DVBIEN2,".02","E")
+45 SET DVBNAME=$$GET1^DIQ(396.1726,DVBIEN2,".03","I")
+46 ;Updating for name w/o version CPARI-9567 CP 05/14/24
+47 IF DVBNAME["_"
SET DVBNAME=$$NAMEUPD(DVBNAME)
+48 IF DVBNAME?.N
SET DVBNAME=$$GET1^DIQ(396.1726,DVBIEN2,".03","E")
+49 SET DVBPT=$$GET1^DIQ(396.17,DVBIEN,".01","E")
+50 SET DVBAUTH=$$GET1^DIQ(396.2026,DVBIEN3,".03","E")
+51 SET DVBRESP=$$GET1^DIQ(396.2026,DVBIEN3,".04","E")
+52 SET DVBCNT=DVBCNT+1
SET ^TMP("CAPRI TRANSRPT",$JOB,DVBNAME,DVBTRDT,DVBCNT)=DVBNAME_U_DVBPT_U_DVBAUTH_U_DVBTRDT_U_DVBSTA_U_DVBRESP
+53 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
+54 SET DVBRTN=$NAME(^TMP("CAPRI TRANSRPT",$JOB))
+55 QUIT
End DoDot:1
+56 KILL X,Y,DVBSTA,DVBNAME,DVBPT,DVBCNT,DVBAUTH,DVBTRDT,DVBRESP,DVBCHKDT,DVBDT
+57 QUIT
ADDPDF(DVBRTN,DVBIEN,DVBEXAMNAME) ;DVBA CAPRI ADD EXAM
+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 ;Capri-17003 BG 3/17/25
+33 SET DR="4////"_DVBDTTM
+34 IF DVBFORM'="MERGED FORM"
SET DR=DR_";9////MERGED FORM"
+35 DO ^DIE
+36 KILL DIC,DIE,DA,DR,DLAYGO,X,Y,DVBPREVSEQ
+37 IF $$GET1^DIQ(396.17,DVBIEN,4,"I")'=DVBDTTM
SET DVBRTN="-1^Data Not Saved"
QUIT
+38 QUIT
DELETEXAM(DVBRTN,DVBIEN,DVBSEQ,DVBEXAMNAME) ;DVBA CAPRI DELETE EXAM
+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 ;Capri-17003 BG 3/17/25
+25 SET DR="4////"_DVBDTTM
+26 IF DVBCNT=1
SET DR=DR_";9////"_DVBFORM
+27 DO ^DIE
+28 KILL DIC,DIE,DA,DR,DLAYGO,X,Y,DVBCUR,DVBPREVSEQ
+29 IF $$GET1^DIQ(396.17,DVBIEN,4,"I")'=DVBDTTM
SET DVBRTN="-1^Data Not Saved"
QUIT
+30 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
