Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBCREPT

DVBCREPT.m

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