DVBAB85 ;ALB/SPH; CAPRI REPORTS ; 1/12/22 10:10am
;;2.7;AMIE;**90,185,237,240**;Apr 10, 1995;Build 15
;Per VHA Directive 6402 this routine should not be modified
;
;237/240 - added new status' for reporting
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
N DVBATMP,DVBADLMTR,X,XEXAMS
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)
. I DVBTEMP]"",DVBDTE>DVBDSTRT,DVBDTE-1<DVBDBEND D
.. S DVBNM=$P(^DPT(+DVBTEMP,0),"^",1),DVBAUT=$P(^VA(200,$P(DVBTEMP,"^",2),0),"^",1),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(^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
... S ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_DVBEXAMS_$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"
.... S ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_XEXAMS
.... 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 2415 printed Dec 13, 2024@01:40:40 Page 2
DVBAB85 ;ALB/SPH; CAPRI REPORTS ; 1/12/22 10:10am
+1 ;;2.7;AMIE;**90,185,237,240**;Apr 10, 1995;Build 15
+2 ;Per VHA Directive 6402 this routine should not be modified
+3 ;
+4 ;237/240 - added new status' for reporting
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 NEW DVBATMP,DVBADLMTR,X,XEXAMS
+6 SET DVBADLMTR="^"
+7 IF '$DATA(DVBDLMT)
SET DVBDLMT=0
+8 IF DVBDLMT'=1
SET DVBDLMT=0
+9 KILL ^TMP("DVBARPT",DUZ)
+10 SET DVBABIEN=0
SET DVBABCNT=0
SET ST("P")="REVIEW PENDING"
SET ST("N")="NOT REQUIRED"
SET ST("S")="SENT BACK"
+11 SET ST("C")="COMPLETE"
SET ST("D")="DRAFT"
SET ST("A")="AWAITING SIGNATURE"
SET ST("U")="UNCOSIGNED"
+12 SET ST("E")="TRANSMISSION ERROR"
SET ST("F")="PERMANENT FAILURE"
SET ST("G")="SIGNED"
+13 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
+14 FOR
SET DVBABIEN=$ORDER(^DVB(396.17,DVBABIEN))
if 'DVBABIEN
QUIT
Begin DoDot:1
+15 SET DVBTEMP=$GET(^DVB(396.17,DVBABIEN,0))
SET DVBDTE=$PIECE(DVBTEMP,"^",3)
+16 IF DVBTEMP]""
IF DVBDTE>DVBDSTRT
IF DVBDTE-1<DVBDBEND
Begin DoDot:2
+17 SET DVBNM=$PIECE(^DPT(+DVBTEMP,0),"^",1)
SET DVBAUT=$PIECE(^VA(200,$PIECE(DVBTEMP,"^",2),0),"^",1)
SET Y=$PIECE(DVBTEMP,"^",3)
+18 XECUTE ^DD("DD")
SET DVBDTE=Y
SET Y=$PIECE(DVBTEMP,"^",5)
XECUTE ^DD("DD")
+19 SET DVBDTL=Y
SET DVBEXAMS=""
SET DVBABIE2=0
SET DVBST=$PIECE(^DVB(396.17,DVBABIEN,5),"^",2)
+20 if $DATA(ST(DVBST))
SET DVBST=ST(DVBST)
+21 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)
+22 ;
+23 IF DVBDLMT'=1
Begin DoDot:3
+24 SET DVBABCNT=DVBABCNT+1
+25 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_DVBEXAMS_$CHAR(13)
End DoDot:3
+26 ;
+27 IF DVBDLMT=1
Begin DoDot:3
+28 FOR X=1:1:$LENGTH(DVBEXAMS,"|")
Begin DoDot:4
+29 SET XEXAMS=$PIECE(DVBEXAMS,"|",X)
+30 if XEXAMS=""
QUIT
+31 IF DVBDTL="JAN 1,1980"
SET DVBDTL="UNSIGNED"
+32 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBNM_"^"_DVBAUT_"^"_DVBDTE_"^"_DVBDTL_"^"_DVBST_"^"_XEXAMS
+33 SET DVBATMP=^TMP("DVBARPT",DUZ,DVBABCNT)
+34 FOR I=1:1:$LENGTH(DVBATMP,DVBADLMTR)
IF $PIECE(DVBATMP,DVBADLMTR,I)[","
SET $PIECE(DVBATMP,DVBADLMTR,I)=""""_$PIECE(DVBATMP,DVBADLMTR,I)_""""
+35 SET DVBATMP=$TRANSLATE(DVBATMP,DVBADLMTR,",")
+36 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=DVBATMP
+37 SET ^TMP("DVBARPT",DUZ,DVBABCNT)=^TMP("DVBARPT",DUZ,DVBABCNT)_$CHAR(13)
+38 SET DVBABCNT=DVBABCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 ;
+40 SET Y=$NAME(^TMP("DVBARPT",DUZ))
+41 QUIT
