DVBCREPT ;ALB/BG - CAPRI REPORT BUILDER RPC; SEP 7, 2022@16:20 ; 2/2/23 7:18am
;;2.7;AMIE;**226,227,243**;Apr 10, 1995;Build 13
;Per VHA Directive 6402 this routine should not be modified
;Reference to TGET^TIUSRVR1 supported with IA #1635
;Reference to LIST^ORQQCN supported with IA #1671
;Reference to CUM^OWRLR supported with IA #1687
;Reference to ORWRP REPORT TEXT supported with IA #1841
;Reference to ORQQPL PROBLEM LIST supported with IA #3365
;Reference to ORWORR AGET supported with IA #3366
;Reference to ORWORR GET4LST supported with IA #3367
;Reference to ORWLRR MICRO supported with IA #3368
;Reference to GETDLG^ORCD and GETORDER^ORCD supported with IA #5493
;Reference to DATA^PSS50 supported with IA #4533
Q
;
REPORT(DVNEWRPT,DVBARRAY) ;
N DVBI,DVBRPC,DVBARPC,DVBDATA,DVBRPT,DVBTAG,DVBRPCAL
N DVRPT,DVBROU,DVNCT
N DVBINST,DVBPL,DVBTITLE,DVBVSIT,DVBRPT2,DVA,DVB,DVBB,DVBCT,DVBLOG,DVBMSG,DVCLASS,DVBTXT,DVGRG,DVI
K ^TMP("CAPRI REPORT",$J)
S DVNCT=""
S DVBI="" F S DVBI=$O(DVBARRAY(DVBI)) Q:DVBI="" D
.N DVBRPC,DVBDATA,DVBARPC,DVBTAG,DVBAIEN,DVBN1,DVBN2,DVBN3,DVBN4
.N DVBN5,DVBN6,DVBHOSP,DVBDIV,DVBRPT,DVBEDDT,DVBBGDT,DVBREP
.S DVBRPC=$P(DVBARRAY(DVBI),U) S DVBARPC=$O(^XWB(8994,"B",DVBRPC,""))
.S DVBDATA=$G(^XWB(8994,DVBARPC,0))
.S DVBTAG=$P(DVBDATA,U,2),DVBROU=$P(DVBDATA,U,3)
.S DVBAIEN=$P(DVBARRAY(DVBI),U,2),DVBN1=$P(DVBARRAY(DVBI),U,3)
.S DVBN2=$P(DVBARRAY(DVBI),U,4),DVBN3=$P(DVBARRAY(DVBI),U,5)
.S DVBN4=$P(DVBARRAY(DVBI),U,6),DVBN5=$P(DVBARRAY(DVBI),U,7),DVBN6=$P(DVBARRAY(DVBI),U,8)
.I (DVBRPC["ORWRP")&($P(DVBARRAY(DVBI),U,3)'=11)&($P(DVBARRAY(DVBI),U,3)'=20)&($P(DVBARRAY(DVBI),U,3)'=5) D DVBMOST Q
.I (DVBRPC["ORWRP")&($P(DVBARRAY(DVBI),U,3)=11) D DVBORSUM Q
.I (DVBRPC["CUMU")!($P(DVBARRAY(DVBI),U,3)=20) D DVBLABCM Q
.I (DVBRPC["ORWRP")&($P(DVBARRAY(DVBI),U,3)=5) D DVBVITAL Q
.I DVBRPC["MICRO" D DVBMICRO
.I DVBRPC["ORWORR" D DVBMED Q
.I (DVBRPC["ORQQCN")!(DVBRPC["TIU") D DVBTGET Q
.I DVBRPC["ORQQPL" D DVBPROBL Q
S DVNEWRPT=$NA(^TMP("CAPRI REPORT",$J))
K ORDIALOG
Q
S DVNCT=DVNCT+1 S ^TMP("CAPRI REPORT",$J,DVNCT)=$$REPEAT^XLFSTR("*",2)_DVBTITLE_$$REPEAT^XLFSTR("*",70)
Q
MIDDLE ;
S DVNCT=DVNCT+1 S ^TMP("CAPRI REPORT",$J,DVNCT)=$$REPEAT^XLFSTR("-",85)
Q
END ;
S DVNCT=DVNCT+1 S ^TMP("CAPRI REPORT",$J,DVNCT)=$$REPEAT^XLFSTR(" ",2)
Q
DVBPROBL ;
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_")"
D @DVBRPCAL
S DVBTITLE="PROBLEM LIST" D HEADER D END D MIDDLE
I $G(DVBRPT(0))=0 S DVBRPT2="No Problems Found" D
.M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBRPT2
I $G(DVBRPT(0))'=0 S DVBPL=0 F S DVBPL=$O(DVBRPT(DVBPL)) Q:DVBPL="" D
.S DVBRPT2=$P(DVBRPT(DVBPL),U,2)_" "_$P(DVBRPT(DVBPL),U,3)_" "_$P($P(DVBRPT(DVBPL),U,12),";",2)_" "_"Onset:"_$$FMTE^XLFDT($P(DVBRPT(DVBPL),U,5))
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBRPT2
D END
Q
DVBORSUM ;
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_","_")"
D @DVBRPCAL
S DVBTITLE="ORDER SUMMARY" D HEADER D END D MIDDLE
I '$D(@DVBRPT) S DVBRPT="No Orders Found" D Q
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBRPT
.D END
S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=@DVBRPT
D END
Q
DVBMICRO ;
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_")"
D @DVBRPCAL
M DVBREP=@DVBRPT
S DVBTITLE="LAB" D HEADER D END D MIDDLE
I $G(DVBREP(2))["No Data" S DVBREP(2)="No data found in the date range specified..." D Q
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP D END Q
S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
D END
Q
DVBLABCM ;
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_")"
D @DVBRPCAL
M DVBREP=@DVBRPT
S DVBTITLE="LAB"
D HEADER D END D MIDDLE
I $G(DVBREP(2))["No Data" S DVBREP="No data found in the date range specified..." D Q
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
I $G(DVBREP(.001))["[HIDDEN" S DVBCT=$P(DVBREP(.001),U,2) D
.S DVB=.001 F DVI=1:1:DVBCT K DVBREP(DVB) S DVB=DVB+.001
S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
D END
Q
DVBTGET ;
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,DVBAIEN)"
D @DVBRPCAL
M DVBREP=@DVBRPT
I DVBRPC["ORQQCN" S DVBTITLE="CONSULTS" D Q
.D HEADER D END D MIDDLE S DVNCT=DVNCT+1
.M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP D END
I $D(DVBREP) S DVBHOSP=$$GET1^DIQ(8925,DVBAIEN,1205,"I")
I $G(DVBHOSP)="" S DVBVSIT=$$GET1^DIQ(8925,DVBAIEN,.03,"I") S DVBHOSP=$$GET1^DIQ(9000010,$G(DVBVSIT),.22,"I")
S DVBBGDT=$$GET1^DIQ(8925,DVBAIEN,.07,"E"),DVBEDDT=$$GET1^DIQ(8925,DVBAIEN,.08,"E")
S DVBINST=$$GET1^DIQ(44,$G(DVBHOSP),3),DVBDIV=$$GET1^DIQ(44,$G(DVBHOSP),3.5)
I $P(DVBARRAY(DVBI),U,3)="PN" D
.S DVBTITLE="PROGRESS NOTES"
.S DVBREP(4,1)=" INSTITUTION: "_DVBINST
.S DVBREP(4,2)=" DIVISION: "_DVBDIV
I $P(DVBARRAY(DVBI),U,3)="DS" D
.S DVBTITLE="DISCHARGE SUMMARIES"
.S DVBREP(4,1)="EPISODE BEGIN DATE/TIME: "_DVBBGDT
.S DVBREP(4,2)="EPISODE END DATE/TIME: "_DVBEDDT
.S DVBREP(4,3)=" INSTITUTION: "_DVBINST
.S DVBREP(4,4)=" DIVISION: "_DVBDIV
D HEADER D MIDDLE D END
S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
D END
Q
DVBNUTR ;
S DVBTITLE="NUTRITIONAL ASSESSMENTS"
D HEADER D END D MIDDLE
I '$D(DVBREP) D
.S DVBREP="No Nutritional Assessments Found"
.M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
I $D(DVBREP) D
.S DVBXX="" F S DVBXX=$O(DVBREP(DVBXX)) Q:DVBXX="" D
..S DVBX="" F S DVBX=$O(DVBREP(DVBXX,"WP",3,1,DVBX)) Q:DVBX="" D
...S DVCT="",DVCT=DVCT+1 S DVARR(DVCT)=$P(DVBREP(DVBXX,"WP",3,1,DVBX),U,2)
...S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVARR
D END
Q
DVBVITAL ;
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_","_"DVBN4"_","_"DVBN5"_","_"DVBN6"_")"
D @DVBRPCAL
M DVBREP=@DVBRPT
S DVBTITLE="VITAL SIGNS"
S DVBMSG="No cumulative vitals data for this patient within the selected date range"
D HEADER D END D MIDDLE
I '$D(DVBREP) D Q
.S DVBREP=DVBMSG
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
.D END
I $D(DVBREP) D Q
.S DVBXX="" F S DVBXX=$O(DVBREP(DVBXX)) Q:DVBXX="" D
..I DVBREP(DVBXX)["***" S DVBREP(DVBXX)=""
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
D END
Q
DVBMOST ;
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_","_"DVBN4"_","_"DVBN5"_","_"DVBN6"_")"
D @DVBRPCAL
M DVBREP=@DVBRPT
I $P(DVBARRAY(DVBI),U,3)[13 S DVBTITLE="MEDICATIONS"
;I $P(DVBARRAY(DVBI),U,3)=5 S DVBTITLE="VITAL SIGNS",DVBMSG="No cumulative vitals data for this patient within the selected date range"
I $P(DVBARRAY(DVBI),U,3)[17 D DVBNUTR Q
I ($P(DVBARRAY(DVBI),U,3)[13)!($P(DVBARRAY(DVBI),U,3)[22) S DVBMSG="There is no data for the requested search criteria."
I $P(DVBARRAY(DVBI),U,3)=18 S DVBTITLE="IMAGING",DVBMSG="No Images available"
I $P(DVBARRAY(DVBI),U,3)=4 S DVBTITLE="DIETS",DVBMSG="No data available"
I $P(DVBARRAY(DVBI),U,3)=19 S DVBTITLE="PROCEDURES",DVBMSG="No data available"
I $P(DVBARRAY(DVBI),U,3)[22 S DVBTITLE="MED ADMIN HISTORY"
I $P(DVBARRAY(DVBI),U,3)=20 S DVBTITLE="LAB"
I $P(DVBARRAY(DVBI),U,3)=1093 S DVBTITLE="LAB"
I $P(DVBARRAY(DVBI),U,3)=2 S DVBTITLE="LAB"
D HEADER D END D MIDDLE
I '$D(DVBREP) D Q
.S DVBREP=DVBMSG
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
.D END
I $D(DVBREP) D Q
.S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
.D END
Q
DVBMED ;
N DVBX,DVCT,DVARR,DVBRT,DVBPROV,DVCLASS,DVBSTOP
N DVBSTRT,DVBREP1,DVBREP2,DVDRG,DVBXX
S DVBN1=$P(DVBARRAY(DVBI),U,3)_"^"_$P(DVBARRAY(DVBI),U,4)
S DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN3"_","_"DVBN4"_","_"DVBN5"_")"
D @DVBRPCAL
S DVNCT=DVNCT+1,DVCT=0
M DVBREP=@DVBRPT
S DVBTITLE="MEDICATIONS"
D HEADER D END D MIDDLE
I $P(DVBREP(.1),U)=0 D Q
.S DVBREP="There is no data for the requested search criteria."
.K DVBREP(.1) S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP
.D END
I $P(DVBREP(.1),U)'=0 D Q
.S DVBX="" F S DVBX=$O(DVBREP(DVBX)) Q:DVBX="" D
..S DVCT=DVCT+1 S DVARR(DVCT)=$P(DVBREP(DVBX),U)
.D GET4V11^ORWORR(.DVBRT,DVBAIEN,-1,.DVARR)
.S DVBXX="" F S DVBXX=$O(DVBRT(DVBXX)) Q:DVBXX="" D
..I DVBRT(DVBXX)["~",$P(DVBRT(DVBXX),U,2)="" Q
..I DVBRT(DVBXX)["~" D PROV
..I (DVBN3=4),(DVBRT(DVBXX)["~") D DRUG(.DVBREP2)
..I DVBRT(DVBXX)["t" D TPRINT
.D END
Q
PROV ;
S DVBPROV=$P(DVBRT(DVBXX),U,11)
S DVBSTRT=$$FMTE^XLFDT($P(DVBRT(DVBXX),U,4))
S DVBSTOP=$$FMTE^XLFDT($P(DVBRT(DVBXX),U,5))
I DVBN3=4 S DVGRG=$P($P(DVBRT(DVBXX),";",1),"~",2)
S DVBREP1="Provider: "_DVBPROV_" START DATE: "_DVBSTRT_" STOP DATE: "_DVBSTOP
D END
S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP1
Q
TPRINT ;
S DVNCT=DVNCT+1
I DVBRT(DVBXX)["tQ" D
.I ($G(DVBRT(DVBXX+1))["~")!($G(DVBRT(DVBXX+1))="") D
..I DVBN3=4 S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP2
I DVBRT(DVBXX)["t<" D
.I DVBN3=4 S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP2
I DVBRT(DVBXX)["t" D
.S DVBTXT=$E(DVBRT(DVBXX),2,99) S DVBREP1=DVBTXT
.M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP1
.I ($G(DVBRT(DVBXX+1))["~")!($G(DVBRT(DVBXX+1))="") D
..I DVBN3=4 S DVNCT=DVNCT+1 M ^TMP("CAPRI REPORT",$J,DVNCT)=DVBREP2
Q
DRUG(DVBREP2) ;
I DVGRG="" Q
S DVBB=$G(^OR(100,+DVGRG,0)) S DVBLOG=+$P(DVBB,U,5)
D GETDLG^ORCD(DVBLOG)
D GETORDER^ORCD(+DVGRG)
S DVA=$P($G(ORDIALOG("B","DISPENSE DRUG")),"^",2)
I DVA="" S DVBREP2="VA DRUG CLASS-NOT AVAILABLE" Q
S DVDRG=$G(ORDIALOG(DVA,1))
I DVDRG="" S DVBREP2="VA DRUG CLASS-NOT AVAILABLE" Q
D DATA^PSS50(DVDRG,,,,,"DVRPT")
I $P($G(^TMP($J,"DVRPT",0)),U,1)="-1" S DVBREP2="VA DRUG CLASS-NOT AVAILABLE" Q
S DVCLASS=$G(^TMP($J,"DVRPT",DVDRG,2))
S DVBREP2="VA DRUG CLASS-"_DVCLASS_" "_$P($G(^TMP($J,"DVRPT",DVDRG,25)),U,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCREPT 9944 printed Oct 16, 2024@17:49:16 Page 2
DVBCREPT ;ALB/BG - CAPRI REPORT BUILDER RPC; SEP 7, 2022@16:20 ; 2/2/23 7:18am
+1 ;;2.7;AMIE;**226,227,243**;Apr 10, 1995;Build 13
+2 ;Per VHA Directive 6402 this routine should not be modified
+3 ;Reference to TGET^TIUSRVR1 supported with IA #1635
+4 ;Reference to LIST^ORQQCN supported with IA #1671
+5 ;Reference to CUM^OWRLR supported with IA #1687
+6 ;Reference to ORWRP REPORT TEXT supported with IA #1841
+7 ;Reference to ORQQPL PROBLEM LIST supported with IA #3365
+8 ;Reference to ORWORR AGET supported with IA #3366
+9 ;Reference to ORWORR GET4LST supported with IA #3367
+10 ;Reference to ORWLRR MICRO supported with IA #3368
+11 ;Reference to GETDLG^ORCD and GETORDER^ORCD supported with IA #5493
+12 ;Reference to DATA^PSS50 supported with IA #4533
+13 QUIT
+14 ;
REPORT(DVNEWRPT,DVBARRAY) ;
+1 NEW DVBI,DVBRPC,DVBARPC,DVBDATA,DVBRPT,DVBTAG,DVBRPCAL
+2 NEW DVRPT,DVBROU,DVNCT
+3 NEW DVBINST,DVBPL,DVBTITLE,DVBVSIT,DVBRPT2,DVA,DVB,DVBB,DVBCT,DVBLOG,DVBMSG,DVCLASS,DVBTXT,DVGRG,DVI
+4 KILL ^TMP("CAPRI REPORT",$JOB)
+5 SET DVNCT=""
+6 SET DVBI=""
FOR
SET DVBI=$ORDER(DVBARRAY(DVBI))
if DVBI=""
QUIT
Begin DoDot:1
+7 NEW DVBRPC,DVBDATA,DVBARPC,DVBTAG,DVBAIEN,DVBN1,DVBN2,DVBN3,DVBN4
+8 NEW DVBN5,DVBN6,DVBHOSP,DVBDIV,DVBRPT,DVBEDDT,DVBBGDT,DVBREP
+9 SET DVBRPC=$PIECE(DVBARRAY(DVBI),U)
SET DVBARPC=$ORDER(^XWB(8994,"B",DVBRPC,""))
+10 SET DVBDATA=$GET(^XWB(8994,DVBARPC,0))
+11 SET DVBTAG=$PIECE(DVBDATA,U,2)
SET DVBROU=$PIECE(DVBDATA,U,3)
+12 SET DVBAIEN=$PIECE(DVBARRAY(DVBI),U,2)
SET DVBN1=$PIECE(DVBARRAY(DVBI),U,3)
+13 SET DVBN2=$PIECE(DVBARRAY(DVBI),U,4)
SET DVBN3=$PIECE(DVBARRAY(DVBI),U,5)
+14 SET DVBN4=$PIECE(DVBARRAY(DVBI),U,6)
SET DVBN5=$PIECE(DVBARRAY(DVBI),U,7)
SET DVBN6=$PIECE(DVBARRAY(DVBI),U,8)
+15 IF (DVBRPC["ORWRP")&($PIECE(DVBARRAY(DVBI),U,3)'=11)&($PIECE(DVBARRAY(DVBI),U,3)'=20)&($PIECE(DVBARRAY(DVBI),U,3)'=5)
DO DVBMOST
QUIT
+16 IF (DVBRPC["ORWRP")&($PIECE(DVBARRAY(DVBI),U,3)=11)
DO DVBORSUM
QUIT
+17 IF (DVBRPC["CUMU")!($PIECE(DVBARRAY(DVBI),U,3)=20)
DO DVBLABCM
QUIT
+18 IF (DVBRPC["ORWRP")&($PIECE(DVBARRAY(DVBI),U,3)=5)
DO DVBVITAL
QUIT
+19 IF DVBRPC["MICRO"
DO DVBMICRO
+20 IF DVBRPC["ORWORR"
DO DVBMED
QUIT
+21 IF (DVBRPC["ORQQCN")!(DVBRPC["TIU")
DO DVBTGET
QUIT
+22 IF DVBRPC["ORQQPL"
DO DVBPROBL
QUIT
End DoDot:1
+23 SET DVNEWRPT=$NAME(^TMP("CAPRI REPORT",$JOB))
+24 KILL ORDIALOG
+25 QUIT
+1 SET DVNCT=DVNCT+1
SET ^TMP("CAPRI REPORT",$JOB,DVNCT)=$$REPEAT^XLFSTR("*",2)_DVBTITLE_$$REPEAT^XLFSTR("*",70)
+2 QUIT
MIDDLE ;
+1 SET DVNCT=DVNCT+1
SET ^TMP("CAPRI REPORT",$JOB,DVNCT)=$$REPEAT^XLFSTR("-",85)
+2 QUIT
END ;
+1 SET DVNCT=DVNCT+1
SET ^TMP("CAPRI REPORT",$JOB,DVNCT)=$$REPEAT^XLFSTR(" ",2)
+2 QUIT
DVBPROBL ;
+1 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_")"
+2 DO @DVBRPCAL
+3 SET DVBTITLE="PROBLEM LIST"
DO HEADER
DO END
DO MIDDLE
+4 IF $GET(DVBRPT(0))=0
SET DVBRPT2="No Problems Found"
Begin DoDot:1
+5 MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBRPT2
End DoDot:1
+6 IF $GET(DVBRPT(0))'=0
SET DVBPL=0
FOR
SET DVBPL=$ORDER(DVBRPT(DVBPL))
if DVBPL=""
QUIT
Begin DoDot:1
+7 SET DVBRPT2=$PIECE(DVBRPT(DVBPL),U,2)_" "_$PIECE(DVBRPT(DVBPL),U,3)_" "_$PIECE($PIECE(DVBRPT(DVBPL),U,12),";",2)_" "_"Onset:"_$$FMTE^XLFDT($PIECE(DVBRPT(DVBPL),U,5))
+8 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBRPT2
End DoDot:1
+9 DO END
+10 QUIT
DVBORSUM ;
+1 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_","_")"
+2 DO @DVBRPCAL
+3 SET DVBTITLE="ORDER SUMMARY"
DO HEADER
DO END
DO MIDDLE
+4 IF '$DATA(@DVBRPT)
SET DVBRPT="No Orders Found"
Begin DoDot:1
+5 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBRPT
+6 DO END
End DoDot:1
QUIT
+7 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=@DVBRPT
+8 DO END
+9 QUIT
DVBMICRO ;
+1 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_")"
+2 DO @DVBRPCAL
+3 MERGE DVBREP=@DVBRPT
+4 SET DVBTITLE="LAB"
DO HEADER
DO END
DO MIDDLE
+5 IF $GET(DVBREP(2))["No Data"
SET DVBREP(2)="No data found in the date range specified..."
Begin DoDot:1
+6 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
DO END
QUIT
End DoDot:1
QUIT
+7 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
+8 DO END
+9 QUIT
DVBLABCM ;
+1 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_")"
+2 DO @DVBRPCAL
+3 MERGE DVBREP=@DVBRPT
+4 SET DVBTITLE="LAB"
+5 DO HEADER
DO END
DO MIDDLE
+6 IF $GET(DVBREP(2))["No Data"
SET DVBREP="No data found in the date range specified..."
Begin DoDot:1
+7 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
End DoDot:1
QUIT
+8 IF $GET(DVBREP(.001))["[HIDDEN"
SET DVBCT=$PIECE(DVBREP(.001),U,2)
Begin DoDot:1
+9 SET DVB=.001
FOR DVI=1:1:DVBCT
KILL DVBREP(DVB)
SET DVB=DVB+.001
End DoDot:1
+10 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
+11 DO END
+12 QUIT
DVBTGET ;
+1 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,DVBAIEN)"
+2 DO @DVBRPCAL
+3 MERGE DVBREP=@DVBRPT
+4 IF DVBRPC["ORQQCN"
SET DVBTITLE="CONSULTS"
Begin DoDot:1
+5 DO HEADER
DO END
DO MIDDLE
SET DVNCT=DVNCT+1
+6 MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
DO END
End DoDot:1
QUIT
+7 IF $DATA(DVBREP)
SET DVBHOSP=$$GET1^DIQ(8925,DVBAIEN,1205,"I")
+8 IF $GET(DVBHOSP)=""
SET DVBVSIT=$$GET1^DIQ(8925,DVBAIEN,.03,"I")
SET DVBHOSP=$$GET1^DIQ(9000010,$GET(DVBVSIT),.22,"I")
+9 SET DVBBGDT=$$GET1^DIQ(8925,DVBAIEN,.07,"E")
SET DVBEDDT=$$GET1^DIQ(8925,DVBAIEN,.08,"E")
+10 SET DVBINST=$$GET1^DIQ(44,$GET(DVBHOSP),3)
SET DVBDIV=$$GET1^DIQ(44,$GET(DVBHOSP),3.5)
+11 IF $PIECE(DVBARRAY(DVBI),U,3)="PN"
Begin DoDot:1
+12 SET DVBTITLE="PROGRESS NOTES"
+13 SET DVBREP(4,1)=" INSTITUTION: "_DVBINST
+14 SET DVBREP(4,2)=" DIVISION: "_DVBDIV
End DoDot:1
+15 IF $PIECE(DVBARRAY(DVBI),U,3)="DS"
Begin DoDot:1
+16 SET DVBTITLE="DISCHARGE SUMMARIES"
+17 SET DVBREP(4,1)="EPISODE BEGIN DATE/TIME: "_DVBBGDT
+18 SET DVBREP(4,2)="EPISODE END DATE/TIME: "_DVBEDDT
+19 SET DVBREP(4,3)=" INSTITUTION: "_DVBINST
+20 SET DVBREP(4,4)=" DIVISION: "_DVBDIV
End DoDot:1
+21 DO HEADER
DO MIDDLE
DO END
+22 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
+23 DO END
+24 QUIT
DVBNUTR ;
+1 SET DVBTITLE="NUTRITIONAL ASSESSMENTS"
+2 DO HEADER
DO END
DO MIDDLE
+3 IF '$DATA(DVBREP)
Begin DoDot:1
+4 SET DVBREP="No Nutritional Assessments Found"
+5 MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
End DoDot:1
+6 IF $DATA(DVBREP)
Begin DoDot:1
+7 SET DVBXX=""
FOR
SET DVBXX=$ORDER(DVBREP(DVBXX))
if DVBXX=""
QUIT
Begin DoDot:2
+8 SET DVBX=""
FOR
SET DVBX=$ORDER(DVBREP(DVBXX,"WP",3,1,DVBX))
if DVBX=""
QUIT
Begin DoDot:3
+9 SET DVCT=""
SET DVCT=DVCT+1
SET DVARR(DVCT)=$PIECE(DVBREP(DVBXX,"WP",3,1,DVBX),U,2)
+10 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVARR
End DoDot:3
End DoDot:2
End DoDot:1
+11 DO END
+12 QUIT
DVBVITAL ;
+1 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_","_"DVBN4"_","_"DVBN5"_","_"DVBN6"_")"
+2 DO @DVBRPCAL
+3 MERGE DVBREP=@DVBRPT
+4 SET DVBTITLE="VITAL SIGNS"
+5 SET DVBMSG="No cumulative vitals data for this patient within the selected date range"
+6 DO HEADER
DO END
DO MIDDLE
+7 IF '$DATA(DVBREP)
Begin DoDot:1
+8 SET DVBREP=DVBMSG
+9 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
+10 DO END
End DoDot:1
QUIT
+11 IF $DATA(DVBREP)
Begin DoDot:1
+12 SET DVBXX=""
FOR
SET DVBXX=$ORDER(DVBREP(DVBXX))
if DVBXX=""
QUIT
Begin DoDot:2
+13 IF DVBREP(DVBXX)["***"
SET DVBREP(DVBXX)=""
End DoDot:2
+14 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
End DoDot:1
QUIT
+15 DO END
+16 QUIT
DVBMOST ;
+1 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN2"_","_"DVBN3"_","_"DVBN4"_","_"DVBN5"_","_"DVBN6"_")"
+2 DO @DVBRPCAL
+3 MERGE DVBREP=@DVBRPT
+4 IF $PIECE(DVBARRAY(DVBI),U,3)[13
SET DVBTITLE="MEDICATIONS"
+5 ;I $P(DVBARRAY(DVBI),U,3)=5 S DVBTITLE="VITAL SIGNS",DVBMSG="No cumulative vitals data for this patient within the selected date range"
+6 IF $PIECE(DVBARRAY(DVBI),U,3)[17
DO DVBNUTR
QUIT
+7 IF ($PIECE(DVBARRAY(DVBI),U,3)[13)!($PIECE(DVBARRAY(DVBI),U,3)[22)
SET DVBMSG="There is no data for the requested search criteria."
+8 IF $PIECE(DVBARRAY(DVBI),U,3)=18
SET DVBTITLE="IMAGING"
SET DVBMSG="No Images available"
+9 IF $PIECE(DVBARRAY(DVBI),U,3)=4
SET DVBTITLE="DIETS"
SET DVBMSG="No data available"
+10 IF $PIECE(DVBARRAY(DVBI),U,3)=19
SET DVBTITLE="PROCEDURES"
SET DVBMSG="No data available"
+11 IF $PIECE(DVBARRAY(DVBI),U,3)[22
SET DVBTITLE="MED ADMIN HISTORY"
+12 IF $PIECE(DVBARRAY(DVBI),U,3)=20
SET DVBTITLE="LAB"
+13 IF $PIECE(DVBARRAY(DVBI),U,3)=1093
SET DVBTITLE="LAB"
+14 IF $PIECE(DVBARRAY(DVBI),U,3)=2
SET DVBTITLE="LAB"
+15 DO HEADER
DO END
DO MIDDLE
+16 IF '$DATA(DVBREP)
Begin DoDot:1
+17 SET DVBREP=DVBMSG
+18 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
+19 DO END
End DoDot:1
QUIT
+20 IF $DATA(DVBREP)
Begin DoDot:1
+21 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
+22 DO END
End DoDot:1
QUIT
+23 QUIT
DVBMED ;
+1 NEW DVBX,DVCT,DVARR,DVBRT,DVBPROV,DVCLASS,DVBSTOP
+2 NEW DVBSTRT,DVBREP1,DVBREP2,DVDRG,DVBXX
+3 SET DVBN1=$PIECE(DVBARRAY(DVBI),U,3)_"^"_$PIECE(DVBARRAY(DVBI),U,4)
+4 SET DVBRPCAL=DVBTAG_"^"_DVBROU_"(.DVBRPT,"_"DVBAIEN"_","_"DVBN1"_","_"DVBN3"_","_"DVBN4"_","_"DVBN5"_")"
+5 DO @DVBRPCAL
+6 SET DVNCT=DVNCT+1
SET DVCT=0
+7 MERGE DVBREP=@DVBRPT
+8 SET DVBTITLE="MEDICATIONS"
+9 DO HEADER
DO END
DO MIDDLE
+10 IF $PIECE(DVBREP(.1),U)=0
Begin DoDot:1
+11 SET DVBREP="There is no data for the requested search criteria."
+12 KILL DVBREP(.1)
SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP
+13 DO END
End DoDot:1
QUIT
+14 IF $PIECE(DVBREP(.1),U)'=0
Begin DoDot:1
+15 SET DVBX=""
FOR
SET DVBX=$ORDER(DVBREP(DVBX))
if DVBX=""
QUIT
Begin DoDot:2
+16 SET DVCT=DVCT+1
SET DVARR(DVCT)=$PIECE(DVBREP(DVBX),U)
End DoDot:2
+17 DO GET4V11^ORWORR(.DVBRT,DVBAIEN,-1,.DVARR)
+18 SET DVBXX=""
FOR
SET DVBXX=$ORDER(DVBRT(DVBXX))
if DVBXX=""
QUIT
Begin DoDot:2
+19 IF DVBRT(DVBXX)["~"
IF $PIECE(DVBRT(DVBXX),U,2)=""
QUIT
+20 IF DVBRT(DVBXX)["~"
DO PROV
+21 IF (DVBN3=4)
IF (DVBRT(DVBXX)["~")
DO DRUG(.DVBREP2)
+22 IF DVBRT(DVBXX)["t"
DO TPRINT
End DoDot:2
+23 DO END
End DoDot:1
QUIT
+24 QUIT
PROV ;
+1 SET DVBPROV=$PIECE(DVBRT(DVBXX),U,11)
+2 SET DVBSTRT=$$FMTE^XLFDT($PIECE(DVBRT(DVBXX),U,4))
+3 SET DVBSTOP=$$FMTE^XLFDT($PIECE(DVBRT(DVBXX),U,5))
+4 IF DVBN3=4
SET DVGRG=$PIECE($PIECE(DVBRT(DVBXX),";",1),"~",2)
+5 SET DVBREP1="Provider: "_DVBPROV_" START DATE: "_DVBSTRT_" STOP DATE: "_DVBSTOP
+6 DO END
+7 SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP1
+8 QUIT
TPRINT ;
+1 SET DVNCT=DVNCT+1
+2 IF DVBRT(DVBXX)["tQ"
Begin DoDot:1
+3 IF ($GET(DVBRT(DVBXX+1))["~")!($GET(DVBRT(DVBXX+1))="")
Begin DoDot:2
+4 IF DVBN3=4
SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP2
End DoDot:2
End DoDot:1
+5 IF DVBRT(DVBXX)["t<"
Begin DoDot:1
+6 IF DVBN3=4
SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP2
End DoDot:1
+7 IF DVBRT(DVBXX)["t"
Begin DoDot:1
+8 SET DVBTXT=$EXTRACT(DVBRT(DVBXX),2,99)
SET DVBREP1=DVBTXT
+9 MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP1
+10 IF ($GET(DVBRT(DVBXX+1))["~")!($GET(DVBRT(DVBXX+1))="")
Begin DoDot:2
+11 IF DVBN3=4
SET DVNCT=DVNCT+1
MERGE ^TMP("CAPRI REPORT",$JOB,DVNCT)=DVBREP2
End DoDot:2
End DoDot:1
+12 QUIT
DRUG(DVBREP2) ;
+1 IF DVGRG=""
QUIT
+2 SET DVBB=$GET(^OR(100,+DVGRG,0))
SET DVBLOG=+$PIECE(DVBB,U,5)
+3 DO GETDLG^ORCD(DVBLOG)
+4 DO GETORDER^ORCD(+DVGRG)
+5 SET DVA=$PIECE($GET(ORDIALOG("B","DISPENSE DRUG")),"^",2)
+6 IF DVA=""
SET DVBREP2="VA DRUG CLASS-NOT AVAILABLE"
QUIT
+7 SET DVDRG=$GET(ORDIALOG(DVA,1))
+8 IF DVDRG=""
SET DVBREP2="VA DRUG CLASS-NOT AVAILABLE"
QUIT
+9 DO DATA^PSS50(DVDRG,,,,,"DVRPT")
+10 IF $PIECE($GET(^TMP($JOB,"DVRPT",0)),U,1)="-1"
SET DVBREP2="VA DRUG CLASS-NOT AVAILABLE"
QUIT
+11 SET DVCLASS=$GET(^TMP($JOB,"DVRPT",DVDRG,2))
+12 SET DVBREP2="VA DRUG CLASS-"_DVCLASS_" "_$PIECE($GET(^TMP($JOB,"DVRPT",DVDRG,25)),U,3)
+13 QUIT
