PXRMCALT ;SLC/AGP - Check for Active SMART Alert ;Jan 10, 2020@12:23
;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
;
;
;DBIA USED
;2265 EN3^RAO7PC1
;2630 ^RADPT
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,INC,ISFALT,NODE,PROCNAME,RESULT,SEX,WVIEN,Y
S WVIEN=0,ISFALT=0
I ALTID'="",$G(PXRMARYD)'="" D
.S DTE=$P($P($G(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),0)),U),".") I DTE="" Q
.I '$D(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),"P",$P(PXRMARYD,"~",2),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)
.S WVIEN=$O(^WV(790.1,"E",CASE,"")) I WVIEN>0 S ISFALT=1
S SEX=$P(^DPT(DFN,0),U,2)
I SEX="F",WVIEN>0 S NFOUND=NFOUND+1 D PROCDURE^PXRMCWH(ALTID,PXRMARYD,WVIEN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
I SEX="M" D MALE(DFN,PXRMARYD,CASE,ALTID,.NFOUND,.DATE,.DATA,.TEXT)
I $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(^RADPT(DFN,"DT",$P(PXRMARYD,"~"),"P",$P(PXRMARYD,"~",2),0),U,17)
S RPTCASE=$P(PXRMARYD,"~",2)_","_$P(PXRMARYD,"~")_","_DFN_","
D RADREP^WVALERTR(RPTCASE,RPTIEN)
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)
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")
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 +$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
;
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 9312 printed Apr 07, 2021@14:54:10 Page 2
PXRMCALT ;SLC/AGP - Check for Active SMART Alert ;Jan 10, 2020@12:23
+1 ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
+2 ;
+3 ;
+4 ;DBIA USED
+5 ;2265 EN3^RAO7PC1
+6 ;2630 ^RADPT
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,INC,ISFALT,NODE,PROCNAME,RESULT,SEX,WVIEN,Y
+2 SET WVIEN=0
SET ISFALT=0
+3 IF ALTID'=""
IF $GET(PXRMARYD)'=""
Begin DoDot:1
+4 SET DTE=$PIECE($PIECE($GET(^RADPT(DFN,"DT",$PIECE(PXRMARYD,"~"),0)),U),".")
IF DTE=""
QUIT
+5 IF '$DATA(^RADPT(DFN,"DT",$PIECE(PXRMARYD,"~"),"P",$PIECE(PXRMARYD,"~",2),0))
QUIT
+6 SET CASE=$EXTRACT(DTE,4,7)_$EXTRACT(DTE,2,3)_"-"_$PIECE($GET(^RADPT(DFN,"DT",$PIECE(PXRMARYD,"~"),"P",$PIECE(PXRMARYD,"~",2),0)),U)
+7 SET WVIEN=$ORDER(^WV(790.1,"E",CASE,""))
IF WVIEN>0
SET ISFALT=1
End DoDot:1
+8 SET SEX=$PIECE(^DPT(DFN,0),U,2)
+9 IF SEX="F"
IF WVIEN>0
SET NFOUND=NFOUND+1
DO PROCDURE^PXRMCWH(ALTID,PXRMARYD,WVIEN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
+10 IF SEX="M"
DO MALE(DFN,PXRMARYD,CASE,ALTID,.NFOUND,.DATE,.DATA,.TEXT)
+11 IF $GET(ALTID)'=""
SET DATA(NFOUND,"ACTIVE ALERT ID")=ALTID
+12 QUIT
+13 ;
MALE(DFN,PXRMARYD,CASE,ALTID,NFOUND,DATE,DATA,TEXT) ;
+1 NEW ERR,I,RPTIEN,RPTCASE
+2 SET RPTIEN=+$PIECE(^RADPT(DFN,"DT",$PIECE(PXRMARYD,"~"),"P",$PIECE(PXRMARYD,"~",2),0),U,17)
+3 SET RPTCASE=$PIECE(PXRMARYD,"~",2)_","_$PIECE(PXRMARYD,"~")_","_DFN_","
+4 DO RADREP^WVALERTR(RPTCASE,RPTIEN)
+5 SET NFOUND=1
SET DATE(1)=9999999-$PIECE(PXRMARYD,"~")
+6 IF $GET(CASE)'=""
SET DATA(1,"CASE")=CASE
SET TEST(1)=1
+7 SET DATA(1,"PATIENT SEX")=SEX
+8 SET DATA(1,"ACTIVE ALERT ID")=ALTID
+9 SET DATA(1,"ACTIVE ALERT DATA")=PXRMARYD
+10 SET DATA(1,"DIALOG")=1
+11 SET DATA(1,"PACKAGE")="ORDER ENTRY/RESULTS REPORTING"
+12 SET DATA(1,"PACKAGE PREFIX")="OR"
+13 SET DATA(1,"DAS")=ALTID
+14 SET DATA(1,"NOTIFICATION NUMBER")=+$PIECE(ALTID,",",3)
+15 SET I=0
FOR
SET I=$ORDER(^TMP("WV RPT",$JOB,I))
if I'>0
QUIT
Begin DoDot:1
+16 SET TEXT(1,I)=^TMP("WV RPT",$JOB,I,0)
+17 IF TEXT(1,I)["PRIMARY DIAGNOSIS:"
SET DATA(1,"DIAGNOSIS")=$PIECE(TEXT(1,I),"PRIMARY DIAGNOSIS: ",2)
End DoDot:1
+18 KILL ^TMP($JOB,"WV RPT"),^TMP($JOB,"WV CH")
+19 QUIT
+20 ;
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 ;I +$P(ALTID,",",3)=80,REQALT[80 D ALT80(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT) Q
+6 ;I +$P(ALTID,",",3)=83,REQALT[83 D ALT83(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT) Q
+7 IF +$PIECE(ALTID,",",3)=84
IF REQALT[84
DO ALT85(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
QUIT
+8 IF +$PIECE(ALTID,",",3)=85
IF REQALT[85
DO ALT85(ALTID,PXRMARYD,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)
QUIT
+9 QUIT
+10 ;
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 SET PXRMRETURN=$NAME(^TMP("PXRMCALTOBJ",$JOB))
+7 KILL @PXRMRETURN
+8 SET PXRMLINE=0
+9 ;
+10 IF $GET(^TMP("ORSMART CURRENT ALERT",$JOB))=""
Begin DoDot:1
+11 SET PXRMLINE=PXRMLINE+1
+12 SET @PXRMRETURN@(PXRMLINE,0)="This object can only be used in the text of a SMART alert."
QUIT
End DoDot:1
QUIT "~@"_PXRMRETURN
+13 ;
+14 DO ACTALRTD(DFN,1,"","",.PXRMFOUND,"ALL",.PXRMDATE,.PXRMDATA,.PXRMTEXT)
+15 ;
+16 SET PXRMI=0
+17 FOR
SET PXRMI=$ORDER(PXRMTEXT(1,PXRMI))
if 'PXRMI
QUIT
Begin DoDot:1
+18 SET PXRMLINE=PXRMLINE+1
+19 SET PXRMX=$GET(PXRMTEXT(1,PXRMI))
+20 SET PXRML=$LENGTH(PXRMX)
+21 IF PXRML>1
IF $EXTRACT(PXRMX,PXRML-1,PXRML)="\\"
SET PXRMX=$EXTRACT(PXRMX,1,PXRML-2)
+22 SET @PXRMRETURN@(PXRMLINE,0)=PXRMX
End DoDot:1
+23 ;
+24 IF PXRMLINE=0
Begin DoDot:1
+25 SET PXRMLINE=PXRMLINE+1
+26 SET @PXRMRETURN@(PXRMLINE,0)="The procedure text is not available."
End DoDot:1
+27 ;
+28 QUIT "~@"_PXRMRETURN
+29 ;
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
