- 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 Feb 18, 2025@23:07:03 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
