DVBAB85 ;ALB/SPH/JD - CAPRI REPORTS ; 1/12/22 10:10am
;;2.7;AMIE;**90,185,237,240,252**;Apr 10, 1995;Build 92
;Per VHA Directive 6402 this routine should not be modified
;
;237/240 - added new status' for reporting
;Made changes for CAPRI-11238. JD - 6/18/24
RPTSTAT(Y,DVBDSTRT,DVBDBEND,DVBDLMT) ;
; REPORT FORMAT:
; PT NAME + AUTHOR + DATE/TIME ENTERED + DATE/TIME LOCKED + STATUS
; FORM 1, FORM 2, ETC.
N DVBABIEN,DVBABCNT,DVBABIE2,DVBTEMP,DVBNM,DVBAUT,DVBDTE,DVBDTL,DVBST,DVBEXAMS,ST
;Added DVBWOI,DVBWON to the list for CAPRI-11238.
N DVBATMP,DVBADLMTR,X,XEXAMS,DVBWOI,DVBWON
S DVBADLMTR="^"
I '$D(DVBDLMT) S DVBDLMT=0
I DVBDLMT'=1 S DVBDLMT=0
K ^TMP("DVBARPT",DUZ)
S DVBABIEN=0,DVBABCNT=0,ST("P")="REVIEW PENDING",ST("N")="NOT REQUIRED",ST("S")="SENT BACK"
S ST("C")="COMPLETE",ST("D")="DRAFT",ST("A")="AWAITING SIGNATURE",ST("U")="UNCOSIGNED"
S ST("E")="TRANSMISSION ERROR",ST("F")="PERMANENT FAILURE",ST("G")="SIGNED"
I $G(DVBDLMT)=1 S ^TMP("DVBARPT",DUZ,DVBABCNT)="Patient Name,Author,Date/Time Created,Date/Time Signed,Status,Template"_$C(13),DVBABCNT=DVBABCNT+1
F S DVBABIEN=$O(^DVB(396.17,DVBABIEN)) Q:'DVBABIEN D
. S DVBTEMP=$G(^DVB(396.17,DVBABIEN,0)),DVBDTE=$P(DVBTEMP,"^",3)
.;Next line added for CAPRI-11238.
. S DVBWOI=$P(DVBTEMP,"^",6),DVBWON=$S(DVBWOI'="":$$GET1^DIQ(200,DVBWOI,.01,"E"),1:"")
. I DVBTEMP]"",DVBDTE>DVBDSTRT,DVBDTE-1<DVBDBEND D
.. S DVBNM=$P(^DPT(+DVBTEMP,0),"^",1),DVBAUT=$$GET1^DIQ(200,$P(DVBTEMP,"^",2),.01,"E"),Y=$P(DVBTEMP,"^",3)
.. X ^DD("DD") S DVBDTE=Y,Y=$P(DVBTEMP,"^",5) X ^DD("DD")
.. S DVBDTL=Y,DVBEXAMS="",DVBABIE2=0,DVBST=$P($G(^DVB(396.17,DVBABIEN,5)),"^",2)
.. S:$D(ST(DVBST)) DVBST=ST(DVBST)
.. F S DVBABIE2=$O(^DVB(396.17,DVBABIEN,1,DVBABIE2)) Q:'DVBABIE2 S DVBEXAMS=DVBEXAMS_"|"_$P(^DVB(396.17,DVBABIEN,1,DVBABIE2,0),"^",2)
.. ;
.. I DVBDLMT'=1 D
... S DVBABCNT=DVBABCNT+1
...;Added the Worksheet Originator (DVBWON) to the list for CAPRI-11238.
... S ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_DVBEXAMS_"^"_DVBWON_$C(13)
.. ;
.. I DVBDLMT=1 D
... F X=1:1:$L(DVBEXAMS,"|") D
.... S XEXAMS=$P(DVBEXAMS,"|",X)
.... Q:XEXAMS=""
.... I DVBDTL="JAN 1,1980" S DVBDTL="UNSIGNED"
....;Added the Worksheet Originator (DVBWOI, DVBWON) to the list for CAPRI-11238.
.... S ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_XEXAMS_"^"_DVBWON
.... S DVBATMP=^TMP("DVBARPT",DUZ,DVBABCNT)
.... F I=1:1:$L(DVBATMP,DVBADLMTR) I $P(DVBATMP,DVBADLMTR,I)["," S $P(DVBATMP,DVBADLMTR,I)=""""_$P(DVBATMP,DVBADLMTR,I)_""""
.... S DVBATMP=$TR(DVBATMP,DVBADLMTR,",")
.... S ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBATMP
.... S ^TMP("DVBARPT",DUZ,DVBABCNT)=^TMP("DVBARPT",DUZ,DVBABCNT)_$C(13)
.... S DVBABCNT=DVBABCNT+1
;
S Y=$NA(^TMP("DVBARPT",DUZ))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB85 2850 printed Sep 23, 2025@19:16:39 Page 2
DVBAB85 ;ALB/SPH/JD - CAPRI REPORTS ; 1/12/22 10:10am
+1 ;;2.7;AMIE;**90,185,237,240,252**;Apr 10, 1995;Build 92
+2 ;Per VHA Directive 6402 this routine should not be modified
+3 ;
+4 ;237/240 - added new status' for reporting
+5 ;Made changes for CAPRI-11238. JD - 6/18/24
RPTSTAT(Y,DVBDSTRT,DVBDBEND,DVBDLMT) ;
+1 ; REPORT FORMAT:
+2 ; PT NAME + AUTHOR + DATE/TIME ENTERED + DATE/TIME LOCKED + STATUS
+3 ; FORM 1, FORM 2, ETC.
+4 NEW DVBABIEN,DVBABCNT,DVBABIE2,DVBTEMP,DVBNM,DVBAUT,DVBDTE,DVBDTL,DVBST,DVBEXAMS,ST
+5 ;Added DVBWOI,DVBWON to the list for CAPRI-11238.
+6 NEW DVBATMP,DVBADLMTR,X,XEXAMS,DVBWOI,DVBWON
+7 SET DVBADLMTR="^"
+8 IF '$DATA(DVBDLMT)
SET DVBDLMT=0
+9 IF DVBDLMT'=1
SET DVBDLMT=0
+10 KILL ^TMP("DVBARPT",DUZ)
+11 SET DVBABIEN=0
SET DVBABCNT=0
SET ST("P")="REVIEW PENDING"
SET ST("N")="NOT REQUIRED"
SET ST("S")="SENT BACK"
+12 SET ST("C")="COMPLETE"
SET ST("D")="DRAFT"
SET ST("A")="AWAITING SIGNATURE"
SET ST("U")="UNCOSIGNED"
+13 SET ST("E")="TRANSMISSION ERROR"
SET ST("F")="PERMANENT FAILURE"
SET ST("G")="SIGNED"
+14 IF $GET(DVBDLMT)=1
SET ^TMP("DVBARPT",DUZ,DVBABCNT)="Patient Name,Author,Date/Time Created,Date/Time Signed,Status,Template"_$CHAR(13)
SET DVBABCNT=DVBABCNT+1
+15 FOR
SET DVBABIEN=$ORDER(^DVB(396.17,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+16 SET DVBTEMP=$GET(^DVB(396.17,DVBABIEN,0))
SET DVBDTE=$PIECE(DVBTEMP,"^",3)
+17 ;Next line added for CAPRI-11238.
+18 SET DVBWOI=$PIECE(DVBTEMP,"^",6)
SET DVBWON=$SELECT(DVBWOI'="":$$GET1^DIQ(200,DVBWOI,.01,"E"),1:"")
+19 IF DVBTEMP]""
IF DVBDTE>DVBDSTRT
IF DVBDTE-1<DVBDBEND
Begin DoDot:2
+20 SET DVBNM=$PIECE(^DPT(+DVBTEMP,0),"^",1)
SET DVBAUT=$$GET1^DIQ(200,$PIECE(DVBTEMP,"^",2),.01,"E")
SET Y=$PIECE(DVBTEMP,"^",3)
+21 XECUTE ^DD("DD")
SET DVBDTE=Y
SET Y=$PIECE(DVBTEMP,"^",5)
XECUTE ^DD("DD")
+22 SET DVBDTL=Y
SET DVBEXAMS=""
SET DVBABIE2=0
SET DVBST=$PIECE($GET(^DVB(396.17,DVBABIEN,5)),"^",2)
+23 if $DATA(ST(DVBST))
SET DVBST=ST(DVBST)
+24 FOR
SET DVBABIE2=$ORDER(^DVB(396.17,DVBABIEN,1,DVBABIE2))
if 'DVBABIE2
QUIT
SET DVBEXAMS=DVBEXAMS_"|"_$PIECE(^DVB(396.17,DVBABIEN,1,DVBABIE2,0),"^",2)
+25 ;
+26 IF DVBDLMT'=1
Begin DoDot:3
+27 SET DVBABCNT=DVBABCNT+1
+28 ;Added the Worksheet Originator (DVBWON) to the list for CAPRI-11238.
+29 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_DVBEXAMS_"^"_DVBWON_$CHAR(13)
End DoDot:3
+30 ;
+31 IF DVBDLMT=1
Begin DoDot:3
+32 FOR X=1:1:$LENGTH(DVBEXAMS,"|")
Begin DoDot:4
+33 SET XEXAMS=$PIECE(DVBEXAMS,"|",X)
+34 if XEXAMS=""
QUIT
+35 IF DVBDTL="JAN 1,1980"
SET DVBDTL="UNSIGNED"
+36 ;Added the Worksheet Originator (DVBWOI, DVBWON) to the list for CAPRI-11238.
+37 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_XEXAMS_"^"_DVBWON
+38 SET DVBATMP=^TMP("DVBARPT",DUZ,DVBABCNT)
+39 FOR I=1:1:$LENGTH(DVBATMP,DVBADLMTR)
IF $PIECE(DVBATMP,DVBADLMTR,I)[","
SET $PIECE(DVBATMP,DVBADLMTR,I)=""""_$PIECE(DVBATMP,DVBADLMTR,I)_""""
+40 SET DVBATMP=$TRANSLATE(DVBATMP,DVBADLMTR,",")
+41 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBATMP
+42 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=^TMP("DVBARPT",DUZ,DVBABCNT)_$CHAR(13)
+43 SET DVBABCNT=DVBABCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+44 ;
+45 SET Y=$NAME(^TMP("DVBARPT",DUZ))
+46 QUIT
