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