DVBSIGN ;ALB/CP - CAPRI Signature RPCS; July, 2 2024@08:34 ; 7/2/24 8:35am
;;2.7;AMIE;**252**;Apr 10, 1995;Build 92
; Per VHA Directive 6402 this routine should not be modified
; Reference to $$NOW^XLFDT in ICR #10103
; Reference to ^TIU(8925 in IA #3376
; Reference to $$GET1^DIQ(2 in DBIA #10035
;
Q
;
SAVESIGN(DVBRTN,DVBIEN,DVBCOSIGNER) ;
;;New Routine for Signer Saves CAPRI-11532 CP 7-2-24
N DVBSIGNER,DVBFLAG,DVBDT,DVBDATA,DVBERR
S DVBSIGNER=DUZ
S DVBDT=$$NOW^XLFDT
S DVBDATA(396.17,DVBIEN_",",4)=DVBDT
S DVBFLAG=$S(DVBCOSIGNER="":"0",1:1)
S DVBDATA(396.17,DVBIEN_",",29)=DVBFLAG
;If yes then set DUZ, flag, and Update status to "U" for Uncosigned
I DVBFLAG=1 D
. S DVBDATA(396.17,DVBIEN_",",11)="U"
. S DVBDATA(396.17,DVBIEN_",",28)=DVBSIGNER
. S DVBDATA(396.17,DVBIEN_",",30)=DVBCOSIGNER
. K DVBERR D FILE^DIE(,"DVBDATA","DVBERR")
. I $D(DVBERR)>0 S DVBRTN="-1^Details not Saved"
. I $D(DVBERR)=0 S DVBRTN="2^Signed Ready for CoSignature"
. Q
;If no then set DUZ and set Status to "G" for Signed
I DVBFLAG=0 D
. S DVBDATA(396.17,DVBIEN_",",11)="G"
. S DVBDATA(396.17,DVBIEN_",",28)=DVBSIGNER
. S DVBDATA(396.17,DVBIEN_",",30)=""
. K DVBERR D FILE^DIE(,"DVBDATA","DVBERR")
. I $D(DVBERR)>0 S DVBRTN="-1^Details not Saved"
. I $D(DVBERR)=0 S DVBRTN="1^Signed Ready for Transmission"
. Q
Q
ALERTCNT(DVBRTN) ;
;;New RPC for Cosign Count CAPRI-11533 CP 7-26-24
;;RPC: DVBA CAPRI UNCOSIGN COUNT
N DVBIEN,DVBSTAT,DVBCNT
S (DVBIEN,DVBSTAT)=""
S DVBCNT=0
F S DVBIEN=$O(^DVB(396.17,"H",DUZ,DVBIEN)) Q:DVBIEN="" D
. S DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,11,"I")
. I DVBSTAT'="U" Q
. S DVBCNT=DVBCNT+1
S DVBRTN=DVBCNT
Q
;
UNCSINFO(DVBRTN) ;
;New RPC code for CAPRI-11533. JD - 7/11/24
;RPC: DVBA CAPRI UNCOSIGNED INFO
;
N DVBCNT,DVBCPFL,DVBCPTX,DVBDTUPE,DVBDTUPI,DVBIEN,DVBPTIE,DVBPTNM,DVBSTAT,DVBTIUDM,DVBTIUDN
S (DVBIEN,DVBSTAT)="",DVBCNT=0
K ^TMP("UNCOSIGNALERTINFO",$J)
F S DVBIEN=$O(^DVB(396.17,"H",DUZ,DVBIEN)) Q:DVBIEN="" D
. S DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,11,"I")
. I DVBSTAT'="U" Q ;Only the Review Status of Uncosigned is allowed
. S DVBPTIE=$$GET1^DIQ(396.17,DVBIEN,.01,"I") ;Patient IEN
. S DVBPTNM=$$GET1^DIQ(396.17,DVBIEN,.01,"E") ;Patient name
. S DVBDTUPE=$$GET1^DIQ(396.17,DVBIEN,4,"E") ;Date/time updated (External format)
. S DVBDTUPI=$$GET1^DIQ(396.17,DVBIEN,4,"I") ;Date/time updated (Fileman format)
. S DVBCPFL=$$GET1^DIQ(396.17,DVBIEN,25,"I") ;VHA internal DBQ referral(Y/N)
. S DVBTIUDN=$$GET1^DIQ(396.17,DVBIEN,7,"I") ;TIU document number
. S DVBTIUDM=$$GET1^DIQ(8925,DVBTIUDN,.01,"E") ;TIU document name
. S DVBCPTX=$S(DVBCPFL="N":"",1:"NON-")
. S DVBCPTX="UNCOSIGNED "_DVBCPTX_DVBTIUDM_" available for COSIGNATURE"
. S DVBCNT=DVBCNT+1
. S ^TMP("UNCOSIGNALERTINFO",$J,-DVBDTUPI,DVBCNT)=DVBPTIE_U_DVBPTNM_U_DVBDTUPE_U_DVBCPTX_U_DVBIEN_U_DVBTIUDN
I DVBCNT'>0 S DVBRTN="-1^No data available" Q
S DVBRTN=$NA(^TMP("UNCOSIGNALERTINFO",$J))
Q
REVIEWSAVE(DVBRTN,DVBIEN,DVBTYP,DVBREVCMT) ;
;;New RPC for Review Updates CAPRI-12506 CP-8/13/24
;;DVBA CAPRI SAVE REVIEW DATA
N DVBDTTM,DVBREVSEQ,DVBAFDA,DVBDOCMAN,DVBERR,DVBNEXTSEQ
;;'P' FOR REVIEW PENDING;'S' FOR SENT BACK;'A' FOR AWAITING SIGNATURE;'T' for Trainee Details
K DIC,DIE,DA,DR,DLAYGO,X,Y
;;
I DVBIEN="" S DVBRTN="-1^No Worksheet IEN sent" Q
I $D(^DVB(396.17,DVBIEN))<10 S DVBRTN="-1^Invalid Worksheet IEN" Q
I "TPSA"'[DVBTYP S DVBRTN="-1^Invalid Status" Q
I DVBTYP="T",$G(DVBREVCMT(1))'?1"TRAINEE^".N1"^".N S DVBRTN="-1^Invalid Comments" Q
I DVBTYP="T",$D(^VA(200,$P($G(DVBREVCMT(1)),"^",2)))<10 S DVBRTN="-1^Invalid Trainee DUZ" Q
I DVBTYP="A",$G(DVBREVCMT(1))'?.N,$D(^VA(200,$G(DVBREVCMT(1))))<10 S DVBRTN="-1^Invalid Signer DUZ" Q
;;
S DVBDTTM=$$NOW^XLFDT
I DVBTYP="P" S DVBSIGNER=DUZ
I DVBTYP="A" S DVBDOCMAN=$G(DVBREVCMT(1))
I DVBTYP="A" S DVBREVCMT(1)="Sending for Signature"
S DVBREVSEQ=$P($G(^DVB(396.17,DVBIEN,6,0)),"^",3)
S DA(1)=DVBIEN,DA=DVBREVSEQ+1,X=DVBDTTM
S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",6,",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///"_DVBDTTM_";1///"_DUZ
D ^DIE
I $G(DVBREVCMT(1))'="" D WP^DIE(396.1714,DVBNEXTSEQ_","_DVBIEN_",",4,"K","DVBREVCMT","DVBERR")
I $D(DVBERR) S DVBRTN="-1^Review Comments not saved" Q
I '$D(DVBERR) S DVBRTN=1
I DVBTYP="T" S DVBRTN="1^Trainee DUZ and DIV Saved" Q
S DVBAFDA(396.17,DVBIEN_",",4)=DVBDTTM
S DVBAFDA(396.17,DVBIEN_",",11)=DVBTYP
S DVBAFDA(396.17,DVBIEN_",",19)="1"
I DVBTYP="P" S DVBAFDA(396.17,DVBIEN_",",28)=DVBSIGNER,DVBAFDA(396.17,DVBIEN_",",29)=0
I DVBTYP="S" S DVBAFDA(396.17,DVBIEN_",",2)=$P($G(^DVB(396.17,DVBIEN,16)),U,1)
I DVBTYP="A" S DVBAFDA(396.17,DVBIEN_",",2)=DVBDOCMAN
K DVBERR D FILE^DIE(,"DVBAFDA","DVBERR")
I $D(DVBERR)>0 S DVBRTN="-1^Worksheet not updated"
I $D(DVBERR)=0 S DVBRTN="1^Review Details saved and Worksheet Updated"
Q
DOCMAN(DVBRTN,DVBIEN) ;
;;Used B4 signature validation CAPRI-12506 CP-8/13/24
;;DVBA CAPRI TRAINEE DOC MANAGER
S DVBRTN="-1^No Update"
I DVBIEN="" S DVBRTN="-1^No Worksheet IEN sent" Q
I $D(^DVB(396.17,DVBIEN))<10 S DVBRTN="-1^Invalid Worksheet IEN" Q
S DVBTRAINEE=$P($G(^DVB(396.17,DVBIEN,16)),U,1)
K DIE,DA,DR,X,Y
S DIE=396.17,DA=DVBIEN,DR="2///"_DVBTRAINEE
D ^DIE
S DVBRTN=1
K DVBTRAINEE
Q
TRAINSIG(DVBRTN,DVBIEN) ;
;;Send the DUZ and DIV for the Trainee CAPRI-12506 CP-8/13/24
;;DVBA CAPRI TRAINEE SIGNATURE
N DVBDATA,DVBMULT
S DVBRTN=""
I DVBIEN="" S DVBRTN="-1^No Worksheet IEN sent" Q
I $D(^DVB(396.17,DVBIEN))<10 S DVBRTN="-1^Invalid Worksheet IEN" Q
I $D(^DVB(396.17,DVBIEN,6))<10 S DVBRTN="-1^No Review Data Saved"
S DVBMULT=""
F S DVBMULT=$O(^DVB(396.17,DVBIEN,6,DVBMULT)) Q:DVBMULT="" Q:DVBRTN'="" D
. S DVBDATA=$G(^DVB(396.17,DVBIEN,6,DVBMULT,1,1,0))
. I $P(DVBDATA,U,1)="TRAINEE" S DVBRTN=$P(DVBDATA,U,2,3) Q
I DVBRTN="" S DVBRTN="-1^No details found" Q
Q
;
STATCNT(DVBRTN) ;
;New RPC code for CAPRI-12825. JD - 8/14/24
;RPC: DVBA CAPRI STATUS COUNT
;Added statuses D=Draft/Not Ready and O=Outdated Template. JD - 8/21/24
;
;Returns the count for the following worksheet review statuses:
;A=Awaiting Signature, D=Draft/Not ready, O=Outdated Template, P=Review Pending, S=Sent Back
;
N DVBCNTA,DVBCNTD,DVBCNTO,DVBCNTP,DVBCNTS,DVBIEN,DVBP,DVBSTAT
S (DVBSTAT,DVBRTN)=""
S (DVBCNTA,DVBCNTD,DVBCNTO,DVBCNTP,DVBCNTS)=0
F S DVBSTAT=$O(^DVB(396.17,"RS",DVBSTAT)) Q:DVBSTAT="" D
. I "ADOPS"'[DVBSTAT Q
. S DVBIEN=""
. F S DVBIEN=$O(^DVB(396.17,"RS",DVBSTAT,DVBIEN)) Q:DVBIEN="" D
.. S DVBP="" D PASCALCHK^DVBCTPDF(.DVBP,DVBIEN) I DVBP="P" Q ;CMT worksheets only!
.. I DVBSTAT="P" S DVBCNTP=DVBCNTP+1
.. I DUZ'=$$GET1^DIQ(396.17,DVBIEN,2,"I") Q ;Document Manager
.. I DVBSTAT="A" S DVBCNTA=DVBCNTA+1
.. I DVBSTAT="D" S DVBCNTD=DVBCNTD+1
.. I DVBSTAT="O" S DVBCNTO=DVBCNTO+1
.. I DVBSTAT="S" S DVBCNTS=DVBCNTS+1
S DVBRTN=DVBCNTA_U_DVBCNTD_U_DVBCNTO_U_DVBCNTP_U_DVBCNTS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBSIGN 7084 printed Aug 26, 2025@22:15:03 Page 2
DVBSIGN ;ALB/CP - CAPRI Signature RPCS; July, 2 2024@08:34 ; 7/2/24 8:35am
+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 in ICR #10103
+4 ; Reference to ^TIU(8925 in IA #3376
+5 ; Reference to $$GET1^DIQ(2 in DBIA #10035
+6 ;
+7 QUIT
+8 ;
SAVESIGN(DVBRTN,DVBIEN,DVBCOSIGNER) ;
+1 ;;New Routine for Signer Saves CAPRI-11532 CP 7-2-24
+2 NEW DVBSIGNER,DVBFLAG,DVBDT,DVBDATA,DVBERR
+3 SET DVBSIGNER=DUZ
+4 SET DVBDT=$$NOW^XLFDT
+5 SET DVBDATA(396.17,DVBIEN_",",4)=DVBDT
+6 SET DVBFLAG=$SELECT(DVBCOSIGNER="":"0",1:1)
+7 SET DVBDATA(396.17,DVBIEN_",",29)=DVBFLAG
+8 ;If yes then set DUZ, flag, and Update status to "U" for Uncosigned
+9 IF DVBFLAG=1
Begin DoDot:1
+10 SET DVBDATA(396.17,DVBIEN_",",11)="U"
+11 SET DVBDATA(396.17,DVBIEN_",",28)=DVBSIGNER
+12 SET DVBDATA(396.17,DVBIEN_",",30)=DVBCOSIGNER
+13 KILL DVBERR
DO FILE^DIE(,"DVBDATA","DVBERR")
+14 IF $DATA(DVBERR)>0
SET DVBRTN="-1^Details not Saved"
+15 IF $DATA(DVBERR)=0
SET DVBRTN="2^Signed Ready for CoSignature"
+16 QUIT
End DoDot:1
+17 ;If no then set DUZ and set Status to "G" for Signed
+18 IF DVBFLAG=0
Begin DoDot:1
+19 SET DVBDATA(396.17,DVBIEN_",",11)="G"
+20 SET DVBDATA(396.17,DVBIEN_",",28)=DVBSIGNER
+21 SET DVBDATA(396.17,DVBIEN_",",30)=""
+22 KILL DVBERR
DO FILE^DIE(,"DVBDATA","DVBERR")
+23 IF $DATA(DVBERR)>0
SET DVBRTN="-1^Details not Saved"
+24 IF $DATA(DVBERR)=0
SET DVBRTN="1^Signed Ready for Transmission"
+25 QUIT
End DoDot:1
+26 QUIT
ALERTCNT(DVBRTN) ;
+1 ;;New RPC for Cosign Count CAPRI-11533 CP 7-26-24
+2 ;;RPC: DVBA CAPRI UNCOSIGN COUNT
+3 NEW DVBIEN,DVBSTAT,DVBCNT
+4 SET (DVBIEN,DVBSTAT)=""
+5 SET DVBCNT=0
+6 FOR
SET DVBIEN=$ORDER(^DVB(396.17,"H",DUZ,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:1
+7 SET DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,11,"I")
+8 IF DVBSTAT'="U"
QUIT
+9 SET DVBCNT=DVBCNT+1
End DoDot:1
+10 SET DVBRTN=DVBCNT
+11 QUIT
+12 ;
UNCSINFO(DVBRTN) ;
+1 ;New RPC code for CAPRI-11533. JD - 7/11/24
+2 ;RPC: DVBA CAPRI UNCOSIGNED INFO
+3 ;
+4 NEW DVBCNT,DVBCPFL,DVBCPTX,DVBDTUPE,DVBDTUPI,DVBIEN,DVBPTIE,DVBPTNM,DVBSTAT,DVBTIUDM,DVBTIUDN
+5 SET (DVBIEN,DVBSTAT)=""
SET DVBCNT=0
+6 KILL ^TMP("UNCOSIGNALERTINFO",$JOB)
+7 FOR
SET DVBIEN=$ORDER(^DVB(396.17,"H",DUZ,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:1
+8 SET DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,11,"I")
+9 ;Only the Review Status of Uncosigned is allowed
IF DVBSTAT'="U"
QUIT
+10 ;Patient IEN
SET DVBPTIE=$$GET1^DIQ(396.17,DVBIEN,.01,"I")
+11 ;Patient name
SET DVBPTNM=$$GET1^DIQ(396.17,DVBIEN,.01,"E")
+12 ;Date/time updated (External format)
SET DVBDTUPE=$$GET1^DIQ(396.17,DVBIEN,4,"E")
+13 ;Date/time updated (Fileman format)
SET DVBDTUPI=$$GET1^DIQ(396.17,DVBIEN,4,"I")
+14 ;VHA internal DBQ referral(Y/N)
SET DVBCPFL=$$GET1^DIQ(396.17,DVBIEN,25,"I")
+15 ;TIU document number
SET DVBTIUDN=$$GET1^DIQ(396.17,DVBIEN,7,"I")
+16 ;TIU document name
SET DVBTIUDM=$$GET1^DIQ(8925,DVBTIUDN,.01,"E")
+17 SET DVBCPTX=$SELECT(DVBCPFL="N":"",1:"NON-")
+18 SET DVBCPTX="UNCOSIGNED "_DVBCPTX_DVBTIUDM_" available for COSIGNATURE"
+19 SET DVBCNT=DVBCNT+1
+20 SET ^TMP("UNCOSIGNALERTINFO",$JOB,-DVBDTUPI,DVBCNT)=DVBPTIE_U_DVBPTNM_U_DVBDTUPE_U_DVBCPTX_U_DVBIEN_U_DVBTIUDN
End DoDot:1
+21 IF DVBCNT'>0
SET DVBRTN="-1^No data available"
QUIT
+22 SET DVBRTN=$NAME(^TMP("UNCOSIGNALERTINFO",$JOB))
+23 QUIT
REVIEWSAVE(DVBRTN,DVBIEN,DVBTYP,DVBREVCMT) ;
+1 ;;New RPC for Review Updates CAPRI-12506 CP-8/13/24
+2 ;;DVBA CAPRI SAVE REVIEW DATA
+3 NEW DVBDTTM,DVBREVSEQ,DVBAFDA,DVBDOCMAN,DVBERR,DVBNEXTSEQ
+4 ;;'P' FOR REVIEW PENDING;'S' FOR SENT BACK;'A' FOR AWAITING SIGNATURE;'T' for Trainee Details
+5 KILL DIC,DIE,DA,DR,DLAYGO,X,Y
+6 ;;
+7 IF DVBIEN=""
SET DVBRTN="-1^No Worksheet IEN sent"
QUIT
+8 IF $DATA(^DVB(396.17,DVBIEN))<10
SET DVBRTN="-1^Invalid Worksheet IEN"
QUIT
+9 IF "TPSA"'[DVBTYP
SET DVBRTN="-1^Invalid Status"
QUIT
+10 IF DVBTYP="T"
IF $GET(DVBREVCMT(1))'?1"TRAINEE^".N1"^".N
SET DVBRTN="-1^Invalid Comments"
QUIT
+11 IF DVBTYP="T"
IF $DATA(^VA(200,$PIECE($GET(DVBREVCMT(1)),"^",2)))<10
SET DVBRTN="-1^Invalid Trainee DUZ"
QUIT
+12 IF DVBTYP="A"
IF $GET(DVBREVCMT(1))'?.N
IF $DATA(^VA(200,$GET(DVBREVCMT(1))))<10
SET DVBRTN="-1^Invalid Signer DUZ"
QUIT
+13 ;;
+14 SET DVBDTTM=$$NOW^XLFDT
+15 IF DVBTYP="P"
SET DVBSIGNER=DUZ
+16 IF DVBTYP="A"
SET DVBDOCMAN=$GET(DVBREVCMT(1))
+17 IF DVBTYP="A"
SET DVBREVCMT(1)="Sending for Signature"
+18 SET DVBREVSEQ=$PIECE($GET(^DVB(396.17,DVBIEN,6,0)),"^",3)
+19 SET DA(1)=DVBIEN
SET DA=DVBREVSEQ+1
SET X=DVBDTTM
+20 SET (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",6,"
SET DIC(0)="LZ"
+21 DO ^DIC
+22 IF Y=-1
KILL DIC
SET DVBRTN="-1^New version not saved"
QUIT
+23 SET DVBNEXTSEQ=+Y
+24 SET DIE=DIC
+25 SET DR=".01///"_DVBDTTM_";1///"_DUZ
+26 DO ^DIE
+27 IF $GET(DVBREVCMT(1))'=""
DO WP^DIE(396.1714,DVBNEXTSEQ_","_DVBIEN_",",4,"K","DVBREVCMT","DVBERR")
+28 IF $DATA(DVBERR)
SET DVBRTN="-1^Review Comments not saved"
QUIT
+29 IF '$DATA(DVBERR)
SET DVBRTN=1
+30 IF DVBTYP="T"
SET DVBRTN="1^Trainee DUZ and DIV Saved"
QUIT
+31 SET DVBAFDA(396.17,DVBIEN_",",4)=DVBDTTM
+32 SET DVBAFDA(396.17,DVBIEN_",",11)=DVBTYP
+33 SET DVBAFDA(396.17,DVBIEN_",",19)="1"
+34 IF DVBTYP="P"
SET DVBAFDA(396.17,DVBIEN_",",28)=DVBSIGNER
SET DVBAFDA(396.17,DVBIEN_",",29)=0
+35 IF DVBTYP="S"
SET DVBAFDA(396.17,DVBIEN_",",2)=$PIECE($GET(^DVB(396.17,DVBIEN,16)),U,1)
+36 IF DVBTYP="A"
SET DVBAFDA(396.17,DVBIEN_",",2)=DVBDOCMAN
+37 KILL DVBERR
DO FILE^DIE(,"DVBAFDA","DVBERR")
+38 IF $DATA(DVBERR)>0
SET DVBRTN="-1^Worksheet not updated"
+39 IF $DATA(DVBERR)=0
SET DVBRTN="1^Review Details saved and Worksheet Updated"
+40 QUIT
DOCMAN(DVBRTN,DVBIEN) ;
+1 ;;Used B4 signature validation CAPRI-12506 CP-8/13/24
+2 ;;DVBA CAPRI TRAINEE DOC MANAGER
+3 SET DVBRTN="-1^No Update"
+4 IF DVBIEN=""
SET DVBRTN="-1^No Worksheet IEN sent"
QUIT
+5 IF $DATA(^DVB(396.17,DVBIEN))<10
SET DVBRTN="-1^Invalid Worksheet IEN"
QUIT
+6 SET DVBTRAINEE=$PIECE($GET(^DVB(396.17,DVBIEN,16)),U,1)
+7 KILL DIE,DA,DR,X,Y
+8 SET DIE=396.17
SET DA=DVBIEN
SET DR="2///"_DVBTRAINEE
+9 DO ^DIE
+10 SET DVBRTN=1
+11 KILL DVBTRAINEE
+12 QUIT
TRAINSIG(DVBRTN,DVBIEN) ;
+1 ;;Send the DUZ and DIV for the Trainee CAPRI-12506 CP-8/13/24
+2 ;;DVBA CAPRI TRAINEE SIGNATURE
+3 NEW DVBDATA,DVBMULT
+4 SET DVBRTN=""
+5 IF DVBIEN=""
SET DVBRTN="-1^No Worksheet IEN sent"
QUIT
+6 IF $DATA(^DVB(396.17,DVBIEN))<10
SET DVBRTN="-1^Invalid Worksheet IEN"
QUIT
+7 IF $DATA(^DVB(396.17,DVBIEN,6))<10
SET DVBRTN="-1^No Review Data Saved"
+8 SET DVBMULT=""
+9 FOR
SET DVBMULT=$ORDER(^DVB(396.17,DVBIEN,6,DVBMULT))
if DVBMULT=""
QUIT
if DVBRTN'=""
QUIT
Begin DoDot:1
+10 SET DVBDATA=$GET(^DVB(396.17,DVBIEN,6,DVBMULT,1,1,0))
+11 IF $PIECE(DVBDATA,U,1)="TRAINEE"
SET DVBRTN=$PIECE(DVBDATA,U,2,3)
QUIT
End DoDot:1
+12 IF DVBRTN=""
SET DVBRTN="-1^No details found"
QUIT
+13 QUIT
+14 ;
STATCNT(DVBRTN) ;
+1 ;New RPC code for CAPRI-12825. JD - 8/14/24
+2 ;RPC: DVBA CAPRI STATUS COUNT
+3 ;Added statuses D=Draft/Not Ready and O=Outdated Template. JD - 8/21/24
+4 ;
+5 ;Returns the count for the following worksheet review statuses:
+6 ;A=Awaiting Signature, D=Draft/Not ready, O=Outdated Template, P=Review Pending, S=Sent Back
+7 ;
+8 NEW DVBCNTA,DVBCNTD,DVBCNTO,DVBCNTP,DVBCNTS,DVBIEN,DVBP,DVBSTAT
+9 SET (DVBSTAT,DVBRTN)=""
+10 SET (DVBCNTA,DVBCNTD,DVBCNTO,DVBCNTP,DVBCNTS)=0
+11 FOR
SET DVBSTAT=$ORDER(^DVB(396.17,"RS",DVBSTAT))
if DVBSTAT=""
QUIT
Begin DoDot:1
+12 IF "ADOPS"'[DVBSTAT
QUIT
+13 SET DVBIEN=""
+14 FOR
SET DVBIEN=$ORDER(^DVB(396.17,"RS",DVBSTAT,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:2
+15 ;CMT worksheets only!
SET DVBP=""
DO PASCALCHK^DVBCTPDF(.DVBP,DVBIEN)
IF DVBP="P"
QUIT
+16 IF DVBSTAT="P"
SET DVBCNTP=DVBCNTP+1
+17 ;Document Manager
IF DUZ'=$$GET1^DIQ(396.17,DVBIEN,2,"I")
QUIT
+18 IF DVBSTAT="A"
SET DVBCNTA=DVBCNTA+1
+19 IF DVBSTAT="D"
SET DVBCNTD=DVBCNTD+1
+20 IF DVBSTAT="O"
SET DVBCNTO=DVBCNTO+1
+21 IF DVBSTAT="S"
SET DVBCNTS=DVBCNTS+1
End DoDot:2
End DoDot:1
+22 SET DVBRTN=DVBCNTA_U_DVBCNTD_U_DVBCNTO_U_DVBCNTP_U_DVBCNTS
+23 QUIT
