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

PXRMCALT.m

Go to the documentation of this file. 
  1. PXRMCALT ;SLC/AGP - Check for Active SMART Alert ;May 03, 2021@13:48:17
  1.  ;;2.0;CLINICAL REMINDERS;**45,75,71**;Feb 04, 2005;Build 43
  1.  ;
  1.  ;
  1.  ;SACC EXEMPTIONS SECTION
  1.  ;2.3.1.10.1 and 2.3.1.10.2
  1.  ;
  1.  ;DBIA   USED
  1.  ;2265   EN3^RAO7PC1
  1.  ;2630   ^RADPT
  1.  ;871    EN^ORX8
  1.  ;7245   GETDATA^ORWORB
  1.  ;6824   WV(790.1
  1.  ;2479   File 74 FileMan read
  1.  ;7246   RADCASE^WVALERTR,RADREP^WVALERTR
  1.  ;6341   SMALERTS^ORBSMART
  1.  ;
  1. ALT80(ALTID,PXRMARYD,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
  1.  N CNT,DAS,I,ORUPCHUK
  1.  I $P(PXRMARYD,":")'="OR" Q
  1.  S DAS=$P(PXRMARYD,":",2) I +DAS=0 Q
  1.  S NFOUND=NFOUND+1
  1.  S DATA(NFOUND,"DIALOG")=1
  1.  S DATA(NFOUND,"PACKAGE")="ORDER ENTRY/RESULTS REPORTING"
  1.  S DATA(NFOUND,"PACKAGE PREFIX")="OR"
  1.  S DATA(NFOUND,"DAS")=DAS
  1.  S DATA(NFOUND,"ACTIVE ALERT ID")=ALTID
  1.  S DATA(NFOUND,"STATUS")="OPEN"
  1.  S DATE(NFOUND)=DT
  1.  S TEST(NFOUND)=1
  1.  D EN^ORX8(DAS)
  1.  S (CNT,I)=0 F  S I=$O(ORUPCHUK("ORTX",I)) Q:I'>0  D
  1.  .S CNT=CNT+1,TEXT(NFOUND,CNT)="<br>"_ORUPCHUK("ORTX",I)
  1.  ;
  1.  I +$G(ORUPCHUK("ORSTRT"))>0 S CNT=CNT+1,TEXT(NFOUND,CNT)="<br>Start Date: "_$$FMTE^XLFDT(ORUPCHUK("ORSTRT"))
  1.  I $P($G(ORUPCHUK("ORPV")),U,2)'="" S TEXT(NFOUND,CNT)="<br>Provider: "_$P($G(ORUPCHUK("ORPV")),U,2)
  1.  Q
  1.  ;
  1. ALT83(ALTID,PXRMARYD,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
  1.  N ACCESS,DCNT,INC,NODE,PUR,PURIEN,PXRMDIAG,WNIEN,WVIEN
  1.  S NFOUND=NFOUND+1
  1.  S TEST(NFOUND)=1
  1.  S DATE(NFOUND)=DT
  1.  I $G(ALTID)'="" S DATA(NFOUND,"ACTIVE ALERT ID")=ALTID
  1.  Q
  1.  ;
  1. ALT85(ALTID,PXRMARYD,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
  1.  N CASE,DTE,ERR,INC,ISFALT,LIST,NODE,PROCNAME,REPIEN,RESULT,SEX,TEMPCASE,WVIEN,X,Y
  1.  N DIAGNS,WVIENS,WVRPTIEN,WVSECDXS
  1.  S CASE="",WVIEN=0,ISFALT=0
  1.  I ALTID'="",$G(PXRMARYD)'="" D
  1.  .S DTE=$P($P($G(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),0)),U),".") I DTE="" S DATA("RADIOLOGY REPORT FOUND")=0 Q
  1.  .I '$D(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),"P",$P(PXRMARYD,"~",2),0)) S DATA("RADIOLOGY REPORT FOUND")=0 Q
  1.  .S CASE=$E(DTE,4,7)_$E(DTE,2,3)_"-"_$P($G(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),"P",$P(PXRMARYD,"~",2),0)),U)
  1.  .I CASE="" S DATA("RADIOLOGY REPORT FOUND")=0 Q
  1.  .;AGP TODO LOOK at if I have a case # but no report uncomment out the next line
  1.  .I +$P($G(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),"P",$P(PXRMARYD,"~",2),0)),U,17)=0 S DATA("RADIOLOGY REPORT FOUND")=0 Q
  1.  .S WVIEN=+$O(^WV(790.1,"E",CASE,"")) I WVIEN=0  D
  1.  ..S REPIEN=$$FIND1^DIC(74,"","X",CASE,"","","ERR") I REPIEN=0 Q
  1.  ..D LIST^DIC(74.05,","_REPIEN_",","","","","","","","","","LIST","ERR")
  1.  ..S X=0 F  S X=$O(LIST("DILIST",1,X)) Q:X'>0!(WVIEN>0)  D
  1.  ...S TEMPCASE=$G(LIST("DILIST",1,X)) I TEMPCASE="" Q
  1.  ...S WVIEN=+$O(^WV(790.1,"E",TEMPCASE,""))
  1.  .I WVIEN>0 S ISFALT=1
  1.  I $G(DATA("RADIOLOGY REPORT FOUND"))=0 Q
  1.  S SEX=$P(^DPT(DFN,0),U,2)
  1.  I SEX="F" D
  1.  .K DIAGNS,WVIENS,WVRPTIEN,WVSECDXS
  1.  .I WVIEN>0 D
  1.  ..S DATA("RADIOLOGY REPORT FOUND")=1
  1.  ..D RADCASE^WVALERTR(WVIEN,.DIAGNS,.WVIENS,.WVRPTIEN,.WVSECDXS)
  1.  ..I +$G(WVRPTIEN)=0 S DATA("RADIOLOGY REPORT FOUND")=0
  1.  .I $G(DATA("RADIOLOGY REPORT FOUND"))=0 Q
  1.  .I WVIEN>0 S NFOUND=NFOUND+1 D PROCDURE^PXRMCWH(ALTID,PXRMARYD,WVIEN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
  1.  .;S DATA("RADIOLOGY REPORT FOUND")=1
  1.  I SEX="M" D
  1.  .D MALE(DFN,PXRMARYD,CASE,ALTID,.NFOUND,.DATE,.DATA,.TEXT)
  1.  .;I '$D(DATA) S DATA("RADIOLOGY REPORT FOUND")=0 Q
  1.  .S DATA(NFOUND,"RADIOLOGY REPORT FOUND")=1
  1.  I $D(DATA),$G(ALTID)'="" S DATA(NFOUND,"ACTIVE ALERT ID")=ALTID
  1.  Q
  1.  ;
  1. MALE(DFN,PXRMARYD,CASE,ALTID,NFOUND,DATE,DATA,TEXT) ;
  1.  N ERR,I,RPTIEN,RPTCASE
  1.  S RPTIEN=+$P($G(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),"P",$P(PXRMARYD,"~",2),0)),U,17)
  1.  I RPTIEN=0 S DATA("RADIOLOGY REPORT FOUND")=0 Q
  1.  S RPTCASE=$P(PXRMARYD,"~",2)_","_$P(PXRMARYD,"~")_","_DFN_","
  1.  ;S DATA(1,"RADIOLOGY REPORT FOUND")=0
  1.  I RPTIEN>0 D
  1.  .K ^TMP("WV RPT",$J)
  1.  .D RADREP^WVALERTR(RPTCASE,RPTIEN)
  1.  .S DATA(1,"RADIOLOGY REPORT FOUND")=1
  1.  S NFOUND=1,DATE(1)=9999999-$P(PXRMARYD,"~")
  1.  I $G(CASE)'="" S DATA(1,"CASE")=CASE,TEST(1)=1
  1.  S DATA(1,"PATIENT SEX")=SEX
  1.  S DATA(1,"ACTIVE ALERT ID")=ALTID
  1.  S DATA(1,"ACTIVE ALERT DATA")=PXRMARYD
  1.  S DATA(1,"DIALOG")=1
  1.  S DATA(1,"PACKAGE")="ORDER ENTRY/RESULTS REPORTING"
  1.  S DATA(1,"PACKAGE PREFIX")="OR"
  1.  S DATA(1,"DAS")=ALTID
  1.  S DATA(1,"NOTIFICATION NUMBER")=+$P(ALTID,",",3)
  1.  I RPTIEN=0 D  Q
  1.  .S TEXT(1,1)="Radiology Report text not found in the radiology package. Please review the Imaging report on the Reports Tab."
  1.  S I=0 F  S I=$O(^TMP("WV RPT",$J,I)) Q:I'>0  D
  1.  .S TEXT(1,I)=^TMP("WV RPT",$J,I,0)
  1.  .I TEXT(1,I)["PRIMARY DIAGNOSIS:" S DATA(1,"DIAGNOSIS")=$P(TEXT(1,I),"PRIMARY DIAGNOSIS: ",2)
  1.  ;K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
  1.  K ^TMP("WV RPT",$J)
  1.  Q
  1.  ;
  1. GETALT(ALTID,PXRMARYD) ;
  1.  S ALTID=$G(^TMP("ORSMART CURRENT ALERT",$J))
  1.  I ALTID'="" D GETDATA^ORWORB(.PXRMARYD,ALTID)
  1.  Q
  1.  ;
  1. ACTALRTD(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
  1.  N ADDVALUE,ALTID,PXRMARYD,REQALT
  1.  S NFOUND=0,REQALT=TEST
  1.  I REQALT="ALL" S REQALT="84;85"
  1.  D GETALT(.ALTID,.PXRMARYD)
  1.  I $G(PXRMARYD)="" D  Q
  1.  .S TEXT(1,1)="Radiology Report text not found in the radiology package. Please review the Imaging report on the Reports Tab."
  1.  .S DATA("RADIOLOGY REPORT FOUND")=0
  1.  ;I +$P(ALTID,",",3)=80,REQALT[80 D ALT80(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT) Q
  1.  ;I +$P(ALTID,",",3)=83,REQALT[83 D ALT83(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT) Q
  1.  I +$P(ALTID,",",3)=84,REQALT[84 D ALT85(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT) Q
  1.  I +$P(ALTID,",",3)=85,REQALT[85 D ALT85(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT) Q
  1.  Q
  1.  ;
  1. ACTALERT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
  1.  N ALTID,PXRMALTD
  1.  S NFOUND=0,REQALT=TEST
  1.  D GETALT(.ALTID,.PXRMALTD)
  1.  I REQALT'="",REQALT'[+$P(ALTID,",",3) Q
  1.  I ALTID="" Q
  1.  S NFOUND=NFOUND+1
  1.  S TEST(NFOUND)=1
  1.  S DATE(NFOUND)=DT
  1.  S DATA(NFOUND,"ACTIVE ALERT ID")=ALTID
  1.  I PXRMALTD'="" S DATA(NFOUND,"ACTIVE ALERT DATA")=PXRMALTD
  1.  S DATA(NFOUND,"DIALOG")=1
  1.  S DATA(NFOUND,"PACKAGE")="ORDER ENTRY/RESULTS REPORTING"
  1.  S DATA(NFOUND,"PACKAGE PREFIX")="OR"
  1.  S DATA(NFOUND,"DAS")=ALTID
  1.  S DATA(NFOUND,"NOTIFICATION NUMBER")=+$P(ALTID,",",3)
  1.  Q
  1.  ;
  1.  ;===============================================
  1. ALERT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for active
  1.  ;SMART alerts
  1.  N ID,IDS,IND,PIECES,PXRMALRT,OD,TDATE,TDATA,TTEST,X,XQAID
  1.  S IDS=TEST
  1.  I +$G(NFOUND)=0 S NFOUND=0
  1.  S PIECES=$L(TEST,":")
  1.  D SMALERTS^ORBSMART(DFN,DUZ,"PXRMALRT")
  1.  F X=1:1:PIECES D
  1.  .S ID=$P(IDS,":",X)
  1.  .I '$D(PXRMALRT(ID)) Q
  1.  .S XQAID="" F  S XQAID=$O(PXRMALRT(ID,XQAID)) Q:XQAID=""  D
  1.  ..S NFOUND=NFOUND+1,TDATA(NFOUND,"XQAID")=XQAID,TDATE(NFOUND)=$P(PXRMALRT(ID,XQAID,"DATE"),U),TTEST(NFOUND)=1
  1.  ..S TDATA(NFOUND,"SOURCE")=PXRMALRT(ID,XQAID,"DATA")
  1.  ;
  1.  N DATE1,CNT1,JND,TCNT
  1.  F IND=1:1:NFOUND S OD(TDATE(IND),IND)=""
  1.  S CNT1=0,IND=""
  1.  F  S IND=$O(OD(IND),-1) Q:IND=""  D
  1.  . S JND=0
  1.  . F  S JND=$O(OD(IND,JND)) Q:JND=""  D
  1.  .. S CNT1=CNT1+1
  1.  .. S DATE(CNT1)=IND
  1.  .. S TEST(CNT1)=TTEST(JND)
  1.  .. M DATA(CNT1)=TDATA(JND)
  1.  Q
  1.  ;
  1. MAMALERT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for active
  1.  ;SMART mammogram alerts
  1.  N CODE,I,RADDIAG,RADID,RADTXT,X,Y
  1.  D ALERT(DFN,.NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
  1.  I +$G(NFOUND)=0 Q
  1.  I $G(TEST(1))=0 Q
  1.  F I=1:1:NFOUND D
  1.  .S RADID=$P(DATA(I,"SOURCE"),"~")
  1.  .D WH(.DATA,.TEXT,I) Q
  1.  .D REPORT(DFN,RADID,.RADTXT,.RADDIAG)
  1.  .M TEXT(I)=RADTXT
  1.  .S X=0,CODE="" F  S CODE=$O(RADDIAG(CODE)) Q:CODE=""  D
  1.  ..S X=X+1,DATA(I,"DIAGNOSIS",X)=CODE
  1.  .S DATA(I,"DAS")=DFN_";"_RADID
  1.  .S DATA(I,"DIALOG")=1
  1.  .S DATA(I,"PACKAGE")="PCE PATIENT CARE ENCOUNTER"
  1.  .S DATA(I,"PACKAGE PREFIX")="PX"
  1.  Q
  1.  ;
  1. REPORT(DFN,RADID,RADTXT,RADDIAG) ;
  1.  K ^TMP($J,"RAE2")
  1.  N CNT,CODE,NAME,X,Y
  1.  D EN3^RAO7PC1(DFN_U_RADID)
  1.  S CNT=0
  1.  S NAME=^TMP($J,"RAE2",DFN,"ORD",1)
  1.  S CNT=CNT+1,RADTXT(CNT)="Image Report\\"
  1.  S CNT=CNT+1,RADTXT(CNT)="Order: "_^TMP($J,"RAE2",DFN,"ORD",1)_"\\"
  1.  S CNT=CNT+1,RADTXT(CNT)="Report Status: "_$P($G(^TMP($J,"RAE2",DFN,1,NAME)),U)_"\\"
  1.  S CNT=CNT+1,RADTXT(CNT)="Verifing Provider: "_$P($G(^TMP($J,"RAE2",DFN,1,NAME,"V")),U,2)_"\\"
  1.  S CNT=CNT+1,RADTXT(CNT)="Report Text:\\"
  1.  S X=0 F  S X=$O(^TMP($J,"RAE2",DFN,1,NAME,"R",X)) Q:X'>0  D
  1.  .S CNT=CNT+1,RADTXT(CNT)=$G(^TMP($J,"RAE2",DFN,1,NAME,"R",X))_"\\"
  1.  S CNT=CNT+1,RADTXT(CNT)="Impression Text:\\"
  1.  S X=0 F  S X=$O(^TMP($J,"RAE2",DFN,1,NAME,"I",X)) Q:X'>0  D
  1.  .S CNT=CNT+1,RADTXT(CNT)=$G(^TMP($J,"RAE2",DFN,1,NAME,"I",X))_"\\"
  1.  S CNT=CNT+1,RADTXT(CNT)="DX Codes:\\"
  1.  S X=0 F  S X=$O(^TMP($J,"RAE2",DFN,1,NAME,"D",X)) Q:X'>0  D
  1.  .S CODE=$G(^TMP($J,"RAE2",DFN,1,NAME,"D",X))
  1.  .S CNT=CNT+1,RADTXT(CNT)=CODE
  1.  .S RADDIAG(CODE)=""
  1.  K ^TMP($J,"RAE2")
  1.  Q
  1.  ;
  1. WH(DATA,TEXT,I) ;
  1.  N DATE,CASE,ID,NAME,NODE,PROCIEN,PXRMDIAG,SOURCE,WVIEN,WVNIEN,X,Y
  1.  S DATA(I,"DIALOG")=1
  1.  S DATA(I,"PACKAGE")="WOMEN'S HEALTH"
  1.  S DATA(I,"PACKAGE PREFIX")="WV"
  1.  S SOURCE=DATA(I,"SOURCE")
  1.  S DATE=$P($P($G(^RADPT(DFN,"DT",$P(SOURCE,"~"),0)),U),".") I DATE="" Q
  1.  I '$D(^RADPT(DFN,"DT",$P(SOURCE,"~"),"P",$P(SOURCE,"~",2),0)) Q
  1.  S CASE=$E(DATE,4,7)_$E(DATE,2,3)_"-"_$P($G(^RADPT(DFN,"DT",$P(SOURCE,"~"),"P",$P(SOURCE,"~",2),0)),U)
  1.  S PROCIEN=$O(^WV(790.1,"E",CASE,"")) I PROCIEN'>0 Q
  1.  S WVIEN=PROCIEN
  1.  D GETTEST^PXRMCWH(WVIEN,I,0,.TEXT,.PXRMDIAG)
  1.  ;K ^TMP("WV RPT",$J)
  1.  ;D EN^WVALERTR(WVIEN,.PXRMDIAG)
  1.  S DATA(I,"DIAGNOSIS",1)=PXRMDIAG
  1.  ;S Y=0 F  S Y=$O(^TMP("WV RPT",$J,Y)) Q:Y'>0  S TEXT(I,Y)=$G(^TMP("WV RPT",$J,Y,0))
  1.  ;K ^TMP("WV RPT",$J)
  1.  S NODE=^WV(790.1,WVIEN,0)
  1.  S DATA(I,"DAS")=WVIEN_","
  1.  S DATA(I,"ACCESSION")=$P(NODE,U)
  1.  S X=$P(NODE,U,5) I X>0 D
  1.  .S NAME=$P($G(^WV(790.31,X,0)),U) S DATA(I,"BI-RAD")=NAME
  1.  S WVNIEN=$O(^WV(790.4,"C",$P(NODE,U),"")) I WVNIEN'>0 Q
  1.  S NODE=$G(^WV(790.4,WVNIEN,0))
  1.  S X=$P(NODE,U,4) I X>0 D
  1.  .S NAME=$P($G(^WV(790.404,X,0)),U) S DATA(I,"PURPOSE OF NOTIFICATION")=NAME
  1.  S X=$P(NODE,U,3) I X>0 D
  1.  .S NAME=$P($G(^WV(790.403,X,0)),U) S DATA(I,"TYPE OF NOTIFICATION")=NAME
  1.  Q
  1.  ;
  1. ALTOBJ(DFN) ;
  1.  ; TIU object that returns procedure information for
  1.  ; inclusion in the text of a SMART alert
  1.  ;
  1.  N PXRMDATA,PXRMDATE,PXRMFOUND,PXRMI,PXRML,PXRMLINE,PXRMRETURN,PXRMTEXT,PXRMX
  1.  ;
  1.  K ^TMP("PXRMCALTOBJ",$J)
  1.  S PXRMRETURN=$NA(^TMP("PXRMCALTOBJ",$J))
  1.  K @PXRMRETURN
  1.  S PXRMLINE=0
  1.  ;
  1.  I $G(^TMP("ORSMART CURRENT ALERT",$J))="" D  Q "~@"_PXRMRETURN
  1.  . S PXRMLINE=PXRMLINE+1
  1.  . S @PXRMRETURN@(PXRMLINE,0)="This object can only be used in the text of a SMART alert." Q
  1.  ;
  1.  D ACTALRTD(DFN,1,"","",.PXRMFOUND,"ALL",.PXRMDATE,.PXRMDATA,.PXRMTEXT)
  1.  ;
  1.  S PXRMI=0
  1.  F  S PXRMI=$O(PXRMTEXT(1,PXRMI)) Q:'PXRMI  D
  1.  . S PXRMLINE=PXRMLINE+1
  1.  . S PXRMX=$G(PXRMTEXT(1,PXRMI))
  1.  . S PXRML=$L(PXRMX)
  1.  . I PXRML>1,$E(PXRMX,PXRML-1,PXRML)="\\" S PXRMX=$E(PXRMX,1,PXRML-2)
  1.  . S @PXRMRETURN@(PXRMLINE,0)=PXRMX
  1.  ;
  1.  I PXRMLINE=0 D
  1.  . S PXRMLINE=PXRMLINE+1
  1.  . S @PXRMRETURN@(PXRMLINE,0)="The procedure text is not available."
  1.  ;
  1.  Q "~@"_PXRMRETURN
  1.  ;
  1. ALTDATA(RESULT,DFN,ALTID) ;
  1.  N BDT,DATA,DATE,EDT,NFOUND,PXRMDARY,TEST,TEXT
  1.  S BDT=0,EDT=DT,NFOUND=0
  1.  D GETDATA^ORWORB(.PXRMARYD,ALTID)
  1.  I +$P(ALTID,",",3)=84 D ALT85(ALTID,PXRMARYD,1,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
  1.  I +$P(ALTID,",",3)=85 D ALT85(ALTID,PXRMARYD,1,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
  1.  M RESULT("DATA")=DATA
  1.  M RESULT("TEXT")=TEXT
  1.  Q
  1.  ;