- 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 Feb 18, 2025@23:14:51 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