DVBUTIL ;ALB/CP/JD/BG - CAPRI UTILITIES RPCS; June 23, 2023@10:20 ; 4/24/25 1:35pm
;;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
; Reference to $$GET^XPAR in ICR #2263
; Reference to $$NAME^XUSER in ICR #2343
; Reference to GETLST^XPAR in ICR #2263
Q
;
LOCKUNLOCK(DVBRETURN,DVBIEN,DVBLOCK) ;
;RPC: DVBA CAPRI UNLOCK EXAM
;Updates CAPRI-16627 CP 5/10/25
N DVBDTTM,DVBPERSON,DVBNOW,DVBLOCKSTA
I DVBIEN="" S DVBRETURN="-1^Missing Worksheet IEN" Q
I DVBLOCK="" S DVBRETURN="-1^Missing Lock Flag" Q
I "UL"'[$G(DVBLOCK) S DVBRETURN="-1^Invalid Lock Flag" Q
K DVBRETURN
S DVBLOCKSTA=$$GET1^DIQ(396.17,DVBIEN,17,"E")
S DVBPERSON=$$GET1^DIQ(200,DUZ_",",.01,"E")
;BG CAPRI-8883
I DVBLOCK="L" D
.I DVBLOCKSTA'="" D
..I $P(DVBLOCKSTA,":",3)=DUZ S DVBRETURN="1" Q
..I $P(DVBLOCKSTA,":",3)'=DUZ S DVBRETURN="-1^Current worksheet is locked by "_$P(DVBLOCKSTA,"@",1)_" and cannot be viewed, edited, copied or deleted at this time" Q
.I DVBLOCKSTA="" D
. . S DVBNOW=$$NOW^XLFDT
. . S DVBDTTM=$$FMTE^XLFDT(DVBNOW,"2M")
. . S DVBPERSON=DVBPERSON_" on "_DVBDTTM_":"_DUZ
. . K DIE,DA,DR,X,Y
. . S DIE=396.17,DA=DVBIEN,DR="17////"_DVBPERSON
. . D ^DIE
. . I $P($G(^DVB(396.17,DVBIEN,8)),U,2)=DVBPERSON S DVBRETURN=1 Q
. . S DVBRETURN="-1^Can not lock worksheet at this time" Q
. . Q
. Q
I DVBLOCK="U" D
.I DVBLOCKSTA="" S DVBRETURN=1 Q
.I DVBLOCKSTA'="",$P(DVBLOCKSTA,":",3)'=DUZ S DVBRETURN="-1^Current worksheet is locked by "_$P(DVBLOCKSTA,"@",1)_" and cannot be viewed, edited, copied or deleted at this time" Q
.I $P(DVBLOCKSTA,":",3)=DUZ D
. . K DIE,DA,DR,X,Y
. . S DIE=396.17,DA=DVBIEN,DR="17///@"
. . D ^DIE
. . I $P($G(^DVB(396.17,DVBIEN,8)),U,2)="" S DVBRETURN=1 Q
. . S DVBRETURN="-1^Can not unlock worksheet at this time" Q
. Q
K DIE,DA,DR,X,Y
Q
INVALCHAR(DVBRETURN) ;
;RPC: DVBA CAPRI INVALID CHAR LIST
N DVBSEQ,DVBRCHAR,DVBLEN,DVBCNT,DVBI,DVBINV,DVBLEN2,DVBI2,DVBBAD,DVBGOOD
S DVBSEQ=0,DVBI=1
S DVBRCHAR=$$GET^XPAR("PKG","DVBAB CAPRI INVALID CHARACTERS",DVBI,"Q")
S DVBLEN=$L(DVBRCHAR,",")
F DVBCNT=1:1:DVBLEN D
. S DVBI=DVBI+1
. S DVBINV=$$GET^XPAR("PKG","DVBAB CAPRI INVALID CHARACTERS",DVBI,"Q")
. S DVBLEN2=$L(DVBINV,",")
. F DVBI2=1:1:DVBLEN2 D
. . S DVBSEQ=DVBSEQ+1
. . S DVBBAD=$P(DVBINV,",",DVBI2)
. . S DVBGOOD=$P(DVBRCHAR,",",DVBCNT)
. . S DVBRETURN(DVBSEQ)=DVBBAD_U_DVBGOOD
Q
TOGGLE(DVBRETURN) ;
;BG-CAPRI-9269
;RPC: DVBA CAPRI CMT TOGGLE
N DVBPAR
S DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI CMT TOGGLE",1,"I")
S DVBRETURN=DVBPAR
Q
;
EXINFO(DVBRETURN,DVBDUZ,DVBDVI) ;
;New RPC code for CAPRI-11043. JD - 7/1/24
;RPC: DVBA CAPRI GET EXAMINER INFO
N DVBA,DVBDVCT,DVBDVNM,DVBDVAD1,DVBDVAD2,DVBDVSTA,DVBDVZP,DVBEXNM
S DVBDUZ=$G(DVBDUZ),DVBDVI=$G(DVBDVI)
I DVBDUZ="" S DVBRETURN="-1^No User DUZ was provided" Q
I DVBDVI="" S DVBRETURN="-1^No division IEN was provided" Q
S DVBEXNM=$$NAME^XUSER(DVBDUZ) ;Standard name (first MI last) of DVBDUZ
I DVBEXNM="" S DVBRETURN="-1^User with DUZ="_DVBDUZ_" does not exist" Q
S DVBDVNM=$$GET1^DIQ(4,DVBDVI,".01","E") ;Division name
I DVBDVNM="" S DVBRETURN="-1^Division with IEN="_DVBDVI_" does not exist" Q
S DVBDVNM=$$GET1^DIQ(4,DVBDVI,".01","E") ;Division name
S DVBDVAD1=$$GET1^DIQ(4,DVBDVI,"1.01","E") ;Division address 1
S DVBDVAD2=$$GET1^DIQ(4,DVBDVI,"1.02","E") ;Division address 2
S DVBDVCT=$$GET1^DIQ(4,DVBDVI,"1.03","E") ;Division city
S DVBA=$$GET1^DIQ(4,DVBDVI,".02","I") ;Division state IEN
S DVBDVSTA=$$GET1^DIQ(5,DVBA,"1","E") ;Division state abbreviation
S DVBDVZP=$$GET1^DIQ(4,DVBDVI,"1.04","E") ;Division zipcode
S DVBRETURN=DVBEXNM_U_DVBDVNM_U_DVBDVAD1_U_DVBDVAD2_U_DVBDVCT_U_DVBDVSTA_U_DVBDVZP
Q
SECTOG(DVBRETURN) ;RPC: DVBA CAPRI SECURITY TOGGLE ;CAPRI-11932;JCS
N DVBPAR
S DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI SECURITY TOGGLE",1,"I")
S DVBRETURN=DVBPAR
Q
;
;
PDFSIGNM(DVBRTN) ;
;New RPC code for CAPRI-12469. JD - 7/30/24
;RPC: DVBA CAPRI PDF SIG FIELD NAMES
N DVBARTN,DVBERR
K ^TMP("PDFSIGNM",$J),DVBERR
S DVBARTN=$NA(^TMP("PDFSIGNM",$J))
D GETLST^XPAR(DVBARTN,"PKG","DVBAB CAPRI PDF SIG FLD NAMES","Q",.DVBERR,1)
S DVBRTN=DVBARTN
I DVBRTN="" S DVBRTN="-1^No data available" Q
I DVBERR'=0 S DVBRTN="-1^Unable to retrieve data"
Q
HELPINFO(DVBRETURN) ;RPC: DVBA CAPRI SUPPORT MESSAGE ;CAPRI-12817 ;GTR
N DVBPAR
S DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI SUPPORT MESSAGE",1,"I")
S DVBRETURN=DVBPAR
Q
DBQLOGIC(DVBRETURN) ;
;New RPC to pull list of DBQs with conditional Logic CAPRI-13314 CP 9-4-24
;RPC: DVBA CAPRI PDF LOGIC TOGGLE
N DVBLIST,DVBLEN,DVBSEQ,DVBRTN,DVBERR,DVBDATA,DVBI
K ^TMP("DBQLOGIC",$J)
S DVBSEQ=0,(DVBLIST,DVBDATA)=""
D GETWP^XPAR(.DVBLIST,"PKG","DVBAB CAPRI DBQ COND LOGIC",1,.DVBERR)
I DVBERR'=0 S DVBRETURN="-1^"_DVBERR Q
S DVBLEN=$O(DVBLIST(""),-1)
S DVBRTN=$G(DVBLIST(1,0))
I DVBRTN="ALL" S DVBDATA="ALL"
I DVBRTN="NONE" S DVBDATA=0
I DVBDATA="" F DVBI=1:1:DVBLEN D
. S DVBDATA=DVBLEN
. S DVBSEQ=DVBSEQ+1
. S DVBDATA(DVBSEQ)=$G(DVBLIST(DVBI,0))
. Q
M ^TMP("DBQLOGIC",$J)=DVBDATA
S DVBRETURN=$NA(^TMP("DBQLOGIC",$J))
Q
WKSHBYEXAM(DVBRETURN,DVBEXAM) ;
;New RPC to pull Worksheet IEN from Exam IEN CAPRI-13257 CP 9-11-24
;RPC: DVBA CAPRI WORKSHEET BY EXAM
N DVBIEN1,DVBIEN2
S DVBIEN1=""
;
I DVBEXAM="" S DVBRETURN="-1^Missing Exam Reference Number" Q
I $D(^DVB(396.4,"B",DVBEXAM))<10 S DVBRETURN="-1^Invalid Exam Reference Number" Q
S DVBIEN1=$O(^DVB(396.4,"B",DVBEXAM,DVBIEN1))
S DVBIEN2=$G(^DVB(396.4,DVBIEN1,2))
I DVBIEN2="" S DVBRETURN="-1^NO worksheet IEN found" Q
I $D(^DVB(396.17,DVBIEN2))<10 S DVBRETURN="-1^Invalid Worksheet pointer saved" Q
S DVBRETURN=DVBIEN2
Q
PNTOG(DVBRTN) ;
;RPC: DVBA CAPRI PN TOGGLE
;BG-CAPRI
N DVBPAR
S DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI PN TOGGLE",1,"I")
S DVBRTN=DVBPAR
Q
PCHILDLOGIC(DVBRTN) ;
;RPC:DVBA CAPRI SKIP PARENTCHILD
;Return parameter values for Parent child cond logic CAPRI-16410 CP 2-26-25
;
N DVBLIST,DVBCNT
D GETLST^XPAR(.DVBLIST,"PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SKIP PARENTCHILD","I",)
S DVBCNT=$G(DVBLIST)
I DVBCNT=0 S DVBRTN(0)="-1^Parameter Empty" Q
F DVBI=1:1:DVBCNT S DVBRTN(DVBI)=$G(DVBLIST(DVBI))
S DVBRTN(0)=DVBCNT
Q
CSKIPLOGIC(DVBRTN) ;
;RPC:DVBA CAPRI SKIP CHILD RESET
N DVBLIST,DVBCNT
D GETLST^XPAR(.DVBLIST,"PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SKIP CHILD RESET","I",)
S DVBCNT=$G(DVBLIST)
I DVBCNT=0 S DVBRTN(0)="-1^Parameter Empty" Q
F DVBI=1:1:DVBCNT S DVBRTN(DVBI)=$G(DVBLIST(DVBI))
S DVBRTN(0)=DVBCNT
Q
IEPDREST(DVBRTN) ;
;RPC: DVBA CAPRI CMT IEPD RESET
;BG-CAPRI-15970
N DVBPAR
S DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI CMT IEPD RESET",1,"I")
S DVBRTN=DVBPAR
Q
CONDSKIP(DVBRTN) ;
;RPC:DVBA CAPRI CMT SKIP COND
;BG-CAPRI-18432
N DVBLIST,DVBCNT
D GETLST^XPAR(.DVBLIST,"PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SKIP CONDFIELD","I",)
S DVBCNT=$G(DVBLIST)
I DVBCNT=0 S DVBRTN(0)="-1^Parameter Empty" Q
F DVBI=1:1:DVBCNT S DVBRTN(DVBI)=$G(DVBLIST(DVBI))
S DVBRTN(0)=DVBCNT
Q
WORDWRAP(DVBRTN) ;
;RPC: DVBA CAPRI WORD WRAP
;CAPRI- CP 6/16/25
N DVBPAR
S DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI WORD WRAP",1,"I")
S DVBRTN=DVBPAR
Q
MEDOPFLDS(DVBRTN) ;
;RPC: DVBA CAPRI MED OPN FIELDS
;CAPRI-19702 RJA 06232025
N DVBTMP,DVBERR
K ^TMP("DVBMEDOPFLDS",$J)
D GETWP^XPAR(.DVBTMP,"PKG","DVBAB CAPRI MED OPN FIELDS",1,.DVBERR)
I DVBERR'=0 S DVBRTN="-1^"_DVBERR Q
M ^TMP("DVBMEDOPFLDS",$J)=DVBTMP
S DVBRTN=$NA(^TMP("DVBMEDOPFLDS",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBUTIL 7726 printed Sep 23, 2025@19:35:26 Page 2
DVBUTIL ;ALB/CP/JD/BG - CAPRI UTILITIES RPCS; June 23, 2023@10:20 ; 4/24/25 1:35pm
+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 ; Reference to $$GET^XPAR in ICR #2263
+5 ; Reference to $$NAME^XUSER in ICR #2343
+6 ; Reference to GETLST^XPAR in ICR #2263
+7 QUIT
+8 ;
LOCKUNLOCK(DVBRETURN,DVBIEN,DVBLOCK) ;
+1 ;RPC: DVBA CAPRI UNLOCK EXAM
+2 ;Updates CAPRI-16627 CP 5/10/25
+3 NEW DVBDTTM,DVBPERSON,DVBNOW,DVBLOCKSTA
+4 IF DVBIEN=""
SET DVBRETURN="-1^Missing Worksheet IEN"
QUIT
+5 IF DVBLOCK=""
SET DVBRETURN="-1^Missing Lock Flag"
QUIT
+6 IF "UL"'[$GET(DVBLOCK)
SET DVBRETURN="-1^Invalid Lock Flag"
QUIT
+7 KILL DVBRETURN
+8 SET DVBLOCKSTA=$$GET1^DIQ(396.17,DVBIEN,17,"E")
+9 SET DVBPERSON=$$GET1^DIQ(200,DUZ_",",.01,"E")
+10 ;BG CAPRI-8883
+11 IF DVBLOCK="L"
Begin DoDot:1
+12 IF DVBLOCKSTA'=""
Begin DoDot:2
+13 IF $PIECE(DVBLOCKSTA,":",3)=DUZ
SET DVBRETURN="1"
QUIT
+14 IF $PIECE(DVBLOCKSTA,":",3)'=DUZ
SET DVBRETURN="-1^Current worksheet is locked by "_$PIECE(DVBLOCKSTA,"@",1)_" and cannot be viewed, edited, copied or deleted at this time"
QUIT
End DoDot:2
+15 IF DVBLOCKSTA=""
Begin DoDot:2
+16 SET DVBNOW=$$NOW^XLFDT
+17 SET DVBDTTM=$$FMTE^XLFDT(DVBNOW,"2M")
+18 SET DVBPERSON=DVBPERSON_" on "_DVBDTTM_":"_DUZ
+19 KILL DIE,DA,DR,X,Y
+20 SET DIE=396.17
SET DA=DVBIEN
SET DR="17////"_DVBPERSON
+21 DO ^DIE
+22 IF $PIECE($GET(^DVB(396.17,DVBIEN,8)),U,2)=DVBPERSON
SET DVBRETURN=1
QUIT
+23 SET DVBRETURN="-1^Can not lock worksheet at this time"
QUIT
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 IF DVBLOCK="U"
Begin DoDot:1
+27 IF DVBLOCKSTA=""
SET DVBRETURN=1
QUIT
+28 IF DVBLOCKSTA'=""
IF $PIECE(DVBLOCKSTA,":",3)'=DUZ
SET DVBRETURN="-1^Current worksheet is locked by "_$PIECE(DVBLOCKSTA,"@",1)_" and cannot be viewed, edited, copied or deleted at this time"
QUIT
+29 IF $PIECE(DVBLOCKSTA,":",3)=DUZ
Begin DoDot:2
+30 KILL DIE,DA,DR,X,Y
+31 SET DIE=396.17
SET DA=DVBIEN
SET DR="17///@"
+32 DO ^DIE
+33 IF $PIECE($GET(^DVB(396.17,DVBIEN,8)),U,2)=""
SET DVBRETURN=1
QUIT
+34 SET DVBRETURN="-1^Can not unlock worksheet at this time"
QUIT
End DoDot:2
+35 QUIT
End DoDot:1
+36 KILL DIE,DA,DR,X,Y
+37 QUIT
INVALCHAR(DVBRETURN) ;
+1 ;RPC: DVBA CAPRI INVALID CHAR LIST
+2 NEW DVBSEQ,DVBRCHAR,DVBLEN,DVBCNT,DVBI,DVBINV,DVBLEN2,DVBI2,DVBBAD,DVBGOOD
+3 SET DVBSEQ=0
SET DVBI=1
+4 SET DVBRCHAR=$$GET^XPAR("PKG","DVBAB CAPRI INVALID CHARACTERS",DVBI,"Q")
+5 SET DVBLEN=$LENGTH(DVBRCHAR,",")
+6 FOR DVBCNT=1:1:DVBLEN
Begin DoDot:1
+7 SET DVBI=DVBI+1
+8 SET DVBINV=$$GET^XPAR("PKG","DVBAB CAPRI INVALID CHARACTERS",DVBI,"Q")
+9 SET DVBLEN2=$LENGTH(DVBINV,",")
+10 FOR DVBI2=1:1:DVBLEN2
Begin DoDot:2
+11 SET DVBSEQ=DVBSEQ+1
+12 SET DVBBAD=$PIECE(DVBINV,",",DVBI2)
+13 SET DVBGOOD=$PIECE(DVBRCHAR,",",DVBCNT)
+14 SET DVBRETURN(DVBSEQ)=DVBBAD_U_DVBGOOD
End DoDot:2
End DoDot:1
+15 QUIT
TOGGLE(DVBRETURN) ;
+1 ;BG-CAPRI-9269
+2 ;RPC: DVBA CAPRI CMT TOGGLE
+3 NEW DVBPAR
+4 SET DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI CMT TOGGLE",1,"I")
+5 SET DVBRETURN=DVBPAR
+6 QUIT
+7 ;
EXINFO(DVBRETURN,DVBDUZ,DVBDVI) ;
+1 ;New RPC code for CAPRI-11043. JD - 7/1/24
+2 ;RPC: DVBA CAPRI GET EXAMINER INFO
+3 NEW DVBA,DVBDVCT,DVBDVNM,DVBDVAD1,DVBDVAD2,DVBDVSTA,DVBDVZP,DVBEXNM
+4 SET DVBDUZ=$GET(DVBDUZ)
SET DVBDVI=$GET(DVBDVI)
+5 IF DVBDUZ=""
SET DVBRETURN="-1^No User DUZ was provided"
QUIT
+6 IF DVBDVI=""
SET DVBRETURN="-1^No division IEN was provided"
QUIT
+7 ;Standard name (first MI last) of DVBDUZ
SET DVBEXNM=$$NAME^XUSER(DVBDUZ)
+8 IF DVBEXNM=""
SET DVBRETURN="-1^User with DUZ="_DVBDUZ_" does not exist"
QUIT
+9 ;Division name
SET DVBDVNM=$$GET1^DIQ(4,DVBDVI,".01","E")
+10 IF DVBDVNM=""
SET DVBRETURN="-1^Division with IEN="_DVBDVI_" does not exist"
QUIT
+11 ;Division name
SET DVBDVNM=$$GET1^DIQ(4,DVBDVI,".01","E")
+12 ;Division address 1
SET DVBDVAD1=$$GET1^DIQ(4,DVBDVI,"1.01","E")
+13 ;Division address 2
SET DVBDVAD2=$$GET1^DIQ(4,DVBDVI,"1.02","E")
+14 ;Division city
SET DVBDVCT=$$GET1^DIQ(4,DVBDVI,"1.03","E")
+15 ;Division state IEN
SET DVBA=$$GET1^DIQ(4,DVBDVI,".02","I")
+16 ;Division state abbreviation
SET DVBDVSTA=$$GET1^DIQ(5,DVBA,"1","E")
+17 ;Division zipcode
SET DVBDVZP=$$GET1^DIQ(4,DVBDVI,"1.04","E")
+18 SET DVBRETURN=DVBEXNM_U_DVBDVNM_U_DVBDVAD1_U_DVBDVAD2_U_DVBDVCT_U_DVBDVSTA_U_DVBDVZP
+19 QUIT
SECTOG(DVBRETURN) ;RPC: DVBA CAPRI SECURITY TOGGLE ;CAPRI-11932;JCS
+1 NEW DVBPAR
+2 SET DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI SECURITY TOGGLE",1,"I")
+3 SET DVBRETURN=DVBPAR
+4 QUIT
+5 ;
+6 ;
PDFSIGNM(DVBRTN) ;
+1 ;New RPC code for CAPRI-12469. JD - 7/30/24
+2 ;RPC: DVBA CAPRI PDF SIG FIELD NAMES
+3 NEW DVBARTN,DVBERR
+4 KILL ^TMP("PDFSIGNM",$JOB),DVBERR
+5 SET DVBARTN=$NAME(^TMP("PDFSIGNM",$JOB))
+6 DO GETLST^XPAR(DVBARTN,"PKG","DVBAB CAPRI PDF SIG FLD NAMES","Q",.DVBERR,1)
+7 SET DVBRTN=DVBARTN
+8 IF DVBRTN=""
SET DVBRTN="-1^No data available"
QUIT
+9 IF DVBERR'=0
SET DVBRTN="-1^Unable to retrieve data"
+10 QUIT
HELPINFO(DVBRETURN) ;RPC: DVBA CAPRI SUPPORT MESSAGE ;CAPRI-12817 ;GTR
+1 NEW DVBPAR
+2 SET DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI SUPPORT MESSAGE",1,"I")
+3 SET DVBRETURN=DVBPAR
+4 QUIT
DBQLOGIC(DVBRETURN) ;
+1 ;New RPC to pull list of DBQs with conditional Logic CAPRI-13314 CP 9-4-24
+2 ;RPC: DVBA CAPRI PDF LOGIC TOGGLE
+3 NEW DVBLIST,DVBLEN,DVBSEQ,DVBRTN,DVBERR,DVBDATA,DVBI
+4 KILL ^TMP("DBQLOGIC",$JOB)
+5 SET DVBSEQ=0
SET (DVBLIST,DVBDATA)=""
+6 DO GETWP^XPAR(.DVBLIST,"PKG","DVBAB CAPRI DBQ COND LOGIC",1,.DVBERR)
+7 IF DVBERR'=0
SET DVBRETURN="-1^"_DVBERR
QUIT
+8 SET DVBLEN=$ORDER(DVBLIST(""),-1)
+9 SET DVBRTN=$GET(DVBLIST(1,0))
+10 IF DVBRTN="ALL"
SET DVBDATA="ALL"
+11 IF DVBRTN="NONE"
SET DVBDATA=0
+12 IF DVBDATA=""
FOR DVBI=1:1:DVBLEN
Begin DoDot:1
+13 SET DVBDATA=DVBLEN
+14 SET DVBSEQ=DVBSEQ+1
+15 SET DVBDATA(DVBSEQ)=$GET(DVBLIST(DVBI,0))
+16 QUIT
End DoDot:1
+17 MERGE ^TMP("DBQLOGIC",$JOB)=DVBDATA
+18 SET DVBRETURN=$NAME(^TMP("DBQLOGIC",$JOB))
+19 QUIT
WKSHBYEXAM(DVBRETURN,DVBEXAM) ;
+1 ;New RPC to pull Worksheet IEN from Exam IEN CAPRI-13257 CP 9-11-24
+2 ;RPC: DVBA CAPRI WORKSHEET BY EXAM
+3 NEW DVBIEN1,DVBIEN2
+4 SET DVBIEN1=""
+5 ;
+6 IF DVBEXAM=""
SET DVBRETURN="-1^Missing Exam Reference Number"
QUIT
+7 IF $DATA(^DVB(396.4,"B",DVBEXAM))<10
SET DVBRETURN="-1^Invalid Exam Reference Number"
QUIT
+8 SET DVBIEN1=$ORDER(^DVB(396.4,"B",DVBEXAM,DVBIEN1))
+9 SET DVBIEN2=$GET(^DVB(396.4,DVBIEN1,2))
+10 IF DVBIEN2=""
SET DVBRETURN="-1^NO worksheet IEN found"
QUIT
+11 IF $DATA(^DVB(396.17,DVBIEN2))<10
SET DVBRETURN="-1^Invalid Worksheet pointer saved"
QUIT
+12 SET DVBRETURN=DVBIEN2
+13 QUIT
PNTOG(DVBRTN) ;
+1 ;RPC: DVBA CAPRI PN TOGGLE
+2 ;BG-CAPRI
+3 NEW DVBPAR
+4 SET DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI PN TOGGLE",1,"I")
+5 SET DVBRTN=DVBPAR
+6 QUIT
PCHILDLOGIC(DVBRTN) ;
+1 ;RPC:DVBA CAPRI SKIP PARENTCHILD
+2 ;Return parameter values for Parent child cond logic CAPRI-16410 CP 2-26-25
+3 ;
+4 NEW DVBLIST,DVBCNT
+5 DO GETLST^XPAR(.DVBLIST,"PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SKIP PARENTCHILD","I",)
+6 SET DVBCNT=$GET(DVBLIST)
+7 IF DVBCNT=0
SET DVBRTN(0)="-1^Parameter Empty"
QUIT
+8 FOR DVBI=1:1:DVBCNT
SET DVBRTN(DVBI)=$GET(DVBLIST(DVBI))
+9 SET DVBRTN(0)=DVBCNT
+10 QUIT
CSKIPLOGIC(DVBRTN) ;
+1 ;RPC:DVBA CAPRI SKIP CHILD RESET
+2 NEW DVBLIST,DVBCNT
+3 DO GETLST^XPAR(.DVBLIST,"PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SKIP CHILD RESET","I",)
+4 SET DVBCNT=$GET(DVBLIST)
+5 IF DVBCNT=0
SET DVBRTN(0)="-1^Parameter Empty"
QUIT
+6 FOR DVBI=1:1:DVBCNT
SET DVBRTN(DVBI)=$GET(DVBLIST(DVBI))
+7 SET DVBRTN(0)=DVBCNT
+8 QUIT
IEPDREST(DVBRTN) ;
+1 ;RPC: DVBA CAPRI CMT IEPD RESET
+2 ;BG-CAPRI-15970
+3 NEW DVBPAR
+4 SET DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI CMT IEPD RESET",1,"I")
+5 SET DVBRTN=DVBPAR
+6 QUIT
CONDSKIP(DVBRTN) ;
+1 ;RPC:DVBA CAPRI CMT SKIP COND
+2 ;BG-CAPRI-18432
+3 NEW DVBLIST,DVBCNT
+4 DO GETLST^XPAR(.DVBLIST,"PKG.AUTOMATED MED INFO EXCHANGE","DVBAB CAPRI SKIP CONDFIELD","I",)
+5 SET DVBCNT=$GET(DVBLIST)
+6 IF DVBCNT=0
SET DVBRTN(0)="-1^Parameter Empty"
QUIT
+7 FOR DVBI=1:1:DVBCNT
SET DVBRTN(DVBI)=$GET(DVBLIST(DVBI))
+8 SET DVBRTN(0)=DVBCNT
+9 QUIT
WORDWRAP(DVBRTN) ;
+1 ;RPC: DVBA CAPRI WORD WRAP
+2 ;CAPRI- CP 6/16/25
+3 NEW DVBPAR
+4 SET DVBPAR=$$GET^XPAR("PKG","DVBAB CAPRI WORD WRAP",1,"I")
+5 SET DVBRTN=DVBPAR
+6 QUIT
MEDOPFLDS(DVBRTN) ;
+1 ;RPC: DVBA CAPRI MED OPN FIELDS
+2 ;CAPRI-19702 RJA 06232025
+3 NEW DVBTMP,DVBERR
+4 KILL ^TMP("DVBMEDOPFLDS",$JOB)
+5 DO GETWP^XPAR(.DVBTMP,"PKG","DVBAB CAPRI MED OPN FIELDS",1,.DVBERR)
+6 IF DVBERR'=0
SET DVBRTN="-1^"_DVBERR
QUIT
+7 MERGE ^TMP("DVBMEDOPFLDS",$JOB)=DVBTMP
+8 SET DVBRTN=$NAME(^TMP("DVBMEDOPFLDS",$JOB))
+9 QUIT
