TIUTIUS ; MILW/JMC - Functions to search TIU documents; May 24, 2006 ; 2/16/16 1:49pm
;;1.0;TEXT INTEGRATION UTILITIES;**296,324,346**;JUN 20, 1997;Build 1;Build 13
;
;
TASK(AUMTDA) ; Task searching of document for specified text
N AUMTADD,I,ZTDESC,ZTDTH,ZTRTN,ZTIO,ZTSAVE,X,ZTSK
I $G(AUMTDA)<1 Q
;
; Check if document is an addendum
S AUMTADD=+$$ISADDNDM^TIULC1(AUMTDA)
;
; If original don't check if cosigned and signer different than cosigner - was checked when signed.
F I=0,15 S X(I)=$G(^TIU(8925,AUMTDA,I))
;TIU*1*346 Remove this line that prevents alerts from being sent when completed by cosigner
;I 'AUMTADD,$P(X(15),"^",8),$P(X(15),"^",2),$P(X(15),"^",8)'=$P(X(15),"^",2) Q
; If addendum and not complete then don't check.
I AUMTADD,$P(X(0),"^",5)'=7 Q
;
; TIU*1.0*324 Pass AUMTADD
S ZTDTH=$H,ZTIO="",ZTSAVE("AUMTDA")="",ZTSAVE("AUMTADD")=""
S ZTRTN="DQ^TIUTIUS",ZTDESC="Search TIU document for specified text"
; TIU 324 TESTING
D ^%ZTLOAD
; TIU*1.0*324 Call in foreground of it failed to queue
I '$D(ZTSK) D DQ^TIUTIUS
Q
;
;
DQ ; Tasked entry point to search TIU document for specified text
; that should generate an alert to appropriate CPRS team.
;
N AUMTI,AUMTJ,AUMTK,AUMTMSPT,AUMTXT,AUMTVL,AUMTVLS,AUMTXQA,X,X0,X1,Y,AUMTZ,AUMPRT
;
I '$D(^TIU(8925,AUMTDA,0)) Q
;
; Get visit location
; TIU*1.0*324 Get location from parent if an addendum
I AUMTADD D
. S AUMTVL=+$P($G(^TIU(8925,AUMTDA,12)),"^",11)
. I 'AUMTVL D
. . S AUMPRT=$P(^TIU(8925,AUMTDA,0),U,6)
. . S AUMTVL=+$P($G(^TIU(8925,AUMPRT,12)),"^",11)
E S AUMTVL=+$P($G(^TIU(8925,AUMTDA,12)),"^",11)
S AUMTVL(0)=$$GET1^DIQ(44,AUMTVL_",",.01)
;
; Setup array of text events to search in the document.
S AUMTI=0
F S AUMTI=$O(^TIU(8925.71,AUMTI)) Q:'AUMTI D
. I '$P(^TIU(8925.71,AUMTI,0),"^",2) Q
. S X=$G(^TIU(8925.71,AUMTI,3))
. I X="" Q
. ; TIU*1.0*324 these parameters no longer used
. ;S AUMTXT(AUMTI)=$P(^TIU(8925.71,AUMTI,0),"^",3,4)
. ; TIU*1.0*324 Compare Visit Search String in upper case only
. S AUMTVLS=$$UPPER^TIULS($P(^TIU(8925.71,AUMTI,0),"^",5))
. ; TIU*1.0*324 not case sensitive and remove spaces
. S X=$$LOW^XLFSTR(X),X=$TR(X," ","") S AUMTXT(AUMTI,"T")=X
. ; visit location or visit location string defined
. I $O(^TIU(8925.71,AUMTI,5,0))!(AUMTVLS'="") D
. . I $D(^TIU(8925.71,AUMTI,5,"B",AUMTVL)) S AUMTXT(AUMTI,"VL")="" Q
. . I AUMTVLS'="",AUMTVL(0)[AUMTVLS S AUMTXT(AUMTI,"VL")="" Q
. . K AUMTXT(AUMTI)
;
; TIU*1.0*324 - Removing this logic so all alerts setup are sent even
; for the same search text
; Check if same alert text is for two or more events and one of the
; events is for this document's visit location then check for specific
; location event text and suppress the general event.
;S AUMTI=0
;F S AUMTI=$O(AUMTXT(AUMTI)) Q:'AUMTI D
;. I '$D(AUMTXT(AUMTI,"VL")) Q
;. S AUMTK=0
;. F S AUMTK=$O(AUMTXT(AUMTK)) Q:'AUMTK D
;. . I AUMTK=AUMTI!($D(AUMTXT(AUMTK,"VL"))) Q
;. . I AUMTXT(AUMTK,"T")=AUMTXT(AUMTI,"T") K AUMTXT(AUMTK)
;
; If no active text events then quit
I '$D(AUMTXT) Q
;
; Search the current and preceeding line for matching text, deal with
; text that spans two lines.
; Skip the event if we've already found a match on a given text event.
; TIU*1.0*324 - REWRITE THIS CODE
;S AUMTI=0,X1=""
;F S AUMTI=$O(^TIU(8925,AUMTDA,"TEXT",AUMTI)) Q:'AUMTI D
;. S X0=X1,X1=^TIU(8925,AUMTDA,"TEXT",AUMTI,0)
;. S X=X0_X1
;. S AUMTJ=0
;. F S AUMTJ=$O(AUMTXT(AUMTJ)) Q:AUMTJ="" I '$D(AUMTXQA(AUMTJ)) D
;. . S Y=X
;. . S Y=$$LOW^XLFSTR(Y)
;. . I '$P(AUMTXT(AUMTJ),"^",2) S Y=$TR(Y," ","")
;. . S AUMTZ=0 F S AUMTZ=$O(AUMTXT(AUMTZ)) Q:AUMTZ="" S AUMTJ=AUMTZ D
;...I $G(Y)'="" S:Y[AUMTXT(AUMTJ,"T") AUMTXQA(AUMTJ)=AUMTJ
;
; TIU*1.0*324 REPLACEMENT CODE
S AUMTI=0,X1=""
F S AUMTI=$O(^TIU(8925,AUMTDA,"TEXT",AUMTI)) Q:'AUMTI D
. S X1=X1_^TIU(8925,AUMTDA,"TEXT",AUMTI,0)
S X1=$$LOW^XLFSTR(X1)
;strip out spaces (should all punctuation be stripped?
S X1=$TR(X1," ",""),AUMTJ=0
F S AUMTJ=$O(AUMTXT(AUMTJ)) Q:AUMTJ="" D
. S:X1[AUMTXT(AUMTJ,"T") AUMTXQA(AUMTJ)=AUMTJ
; Send any alerts
S AUMTZ=0 S AUMTZ=$O(AUMTXQA(AUMTZ)) D:AUMTZ'="" SENDXQA
;
K AUMTDA
Q
;
;
SENDXQA ; Send Kernel alert to appropriate team or team device
;
N AUMTHL,AUMTSKIP,AUMTEAM,AUMTI,AUMTJ,AUMTK,AUMTSA
N DFN,TIU0,TIUPNM,TIUSSN,VA,XQA,XQADATA,XQAID,XQAMSG,XQAROU,XQATEXT
;
S TIU0=$G(^TIU(8925,AUMTDA,0)),DFN=+$P(TIU0,U,2)
S TIUPNM=$E($$PTNAME^TIULC1(DFN),1,9)
D PID^VADPT6
S TIUSSN=$E(TIUPNM,1)_VA("BID")
;
; Get hospital location for alert message text
S AUMTHL=+$P($G(^TIU(8925,AUMTDA,12)),"^",5)
S AUMTHL(0)=$$GET1^DIQ(44,AUMTHL_",",1)
;
; Send alert to each team's members and other additional recipients.
S AUMTI=0
F S AUMTI=$O(AUMTXQA(AUMTI)) Q:AUMTI="" D
. K XQA,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU,XQATEXT
. S XQAID="TIUADD"_AUMTDA,XQADATA=AUMTDA_"^",XQAROU="ACTADD^TIUALRT"
. S XQAMSG=TIUPNM_" ("_TIUSSN_"): ("_AUMTHL(0)_") "_$P($G(^TIU(8925.71,AUMTI,2)),"^")
. S AUMTK=0
. F S AUMTK=$O(^TIU(8925.71,AUMTI,4,AUMTK)) Q:'AUMTK D
. . K AUMTEAM
. . S AUMTEAM=+^TIU(8925.71,AUMTI,4,AUMTK,0)
. . I AUMTEAM>0 D ADDTEAM(AUMTEAM)
. D ADDRECP
. I $D(XQA) D SETUP^XQALERT
;
; Send alert to signer that teams have been notified.
I $D(AUMTSA) D SENDSA
Q
;
;
SENDSA ; Build and sent alerts to signer
;
N AUMTCNT,AUMTDUZ,AUMTI,AUMTMSG
N XQA,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU,XQATEXT
;
S AUMTDUZ=+$P($G(^TIU(8925,AUMTDA,15)),"^",2)
I 'AUMTDUZ Q
S AUMTI=0,AUMTMSG="Alert(s) Sent: "
F S AUMTI=$O(AUMTSA(AUMTI)) Q:'AUMTI S AUMTMSG=AUMTMSG_$P($G(^TIU(8925.71,AUMTI,2)),"^",2)_"," D
. S XQAID="AUMTIU,"_AUMTDA
. S XQAMSG=TIUPNM_" ("_TIUSSN_"): "_AUMTMSG
. S XQA(AUMTDUZ)=""
. D SETUP^XQALERT
Q
;
;
SKIP() ; Check if we should skip alerting this team if they already have been sent an alert.
;
N AUMTJ,AUMTSKIP
S (AUMTJ,AUMTSKIP)=0
F S AUMTJ=$O(AUMTSA(AUMTJ)) Q:'AUMTJ!(AUMTJ>AUMTI) D
. I AUMTI'=AUMTJ,$D(AUMTSA(AUMTJ,AUMTEAM)) S AUMTSKIP=1 Q
Q AUMTSKIP
;
;
ADDRECP ; Send to additional notification recipients.
; If no associate PC provider(3) then check and send to PC provider (1).
; If team (6) then check if patient is member of team.
; If PCP (7-19) checks for associated PCP in PATIENT file (#2) , fields 695021-695033
;
N AUMTJ,AUMTK,AUMTL,AUMTX
S (AUMTJ,AUMTK,AUMTL)=0
F S AUMTL=$O(^TIU(8925.71,AUMTI,4.5,AUMTL)) Q:'AUMTL D
. S AUMTL(0)=^TIU(8925.71,AUMTI,4.5,AUMTL,0)
. S AUMTK=$P(AUMTL(0),"^")
. I AUMTK<4 D Q
. . S AUMTJ=$$NMPCPR^SCAPMCU2(DFN,DT,AUMTK)
. . I AUMTK=3,AUMTJ<1 S AUMTJ=$$NMPCPR^SCAPMCU2(DFN,DT,1)
. . S:AUMTJ>0 XQA($P(AUMTJ,"^"))=""
. I AUMTK>3,AUMTK<6 D Q
. . D ATTPRIM^ORQPTQ3(.AUMTX,DFN)
. . I $P(AUMTX,";",AUMTK-3) S XQA($P($P(AUMTX,";",AUMTK-3),"^"))=""
. I AUMTK=6 D CHKTEAM($P(AUMTL(0),"^",2)) Q
. I AUMTK>6,AUMTK<20 D Q
. . S AUMTX=$G(^DPT(DFN,695002))
. . I $P(AUMTX,"^",AUMTK-6) S XQA($P(AUMTX,"^",AUMTK-6))=""
Q
;
;
CHKTEAM(AUMTEAM) ; Check if this patient is linked to this team
;
; Call with AUMTEAM = ien of team in file 100.21
;
N I
I '$D(AUMTMSPT) D TMSPT^ORQPTQ1(.AUMTMSPT,DFN)
S I=0
F S I=$O(AUMTMSPT(I)) Q:'I I $P(AUMTMSPT(I),"^")=AUMTEAM D ADDTEAM(AUMTEAM)
Q
;
;
ADDTEAM(AUMTEAM) ; Add members of team to list of recipients
;
; Call with AUMTEAM = ien of team in file 100.21
;
N AUMTD,AUMTDEV,AUMTJ
;I $$SKIP Q
S AUMTD=$P($$TMDEV^ORB31(AUMTEAM),"^",2)
I AUMTD'="" S AUMTDEV(AUMTD)="" D REGDEV^ORB31(.AUMTDEV)
D TEAMPROV^ORQPTQ1(.AUMTEAM,AUMTEAM)
I '$G(AUMTEAM(1)) Q
S AUMTSA(AUMTI,AUMTEAM)=""
S AUMTJ=0
F S AUMTJ=$O(AUMTEAM(AUMTJ)) Q:'AUMTJ S XQA(+AUMTEAM(AUMTJ))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUTIUS 7823 printed Nov 22, 2024@17:56:14 Page 2
TIUTIUS ; MILW/JMC - Functions to search TIU documents; May 24, 2006 ; 2/16/16 1:49pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**296,324,346**;JUN 20, 1997;Build 1;Build 13
+2 ;
+3 ;
TASK(AUMTDA) ; Task searching of document for specified text
+1 NEW AUMTADD,I,ZTDESC,ZTDTH,ZTRTN,ZTIO,ZTSAVE,X,ZTSK
+2 IF $GET(AUMTDA)<1
QUIT
+3 ;
+4 ; Check if document is an addendum
+5 SET AUMTADD=+$$ISADDNDM^TIULC1(AUMTDA)
+6 ;
+7 ; If original don't check if cosigned and signer different than cosigner - was checked when signed.
+8 FOR I=0,15
SET X(I)=$GET(^TIU(8925,AUMTDA,I))
+9 ;TIU*1*346 Remove this line that prevents alerts from being sent when completed by cosigner
+10 ;I 'AUMTADD,$P(X(15),"^",8),$P(X(15),"^",2),$P(X(15),"^",8)'=$P(X(15),"^",2) Q
+11 ; If addendum and not complete then don't check.
+12 IF AUMTADD
IF $PIECE(X(0),"^",5)'=7
QUIT
+13 ;
+14 ; TIU*1.0*324 Pass AUMTADD
+15 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTSAVE("AUMTDA")=""
SET ZTSAVE("AUMTADD")=""
+16 SET ZTRTN="DQ^TIUTIUS"
SET ZTDESC="Search TIU document for specified text"
+17 ; TIU 324 TESTING
+18 DO ^%ZTLOAD
+19 ; TIU*1.0*324 Call in foreground of it failed to queue
+20 IF '$DATA(ZTSK)
DO DQ^TIUTIUS
+21 QUIT
+22 ;
+23 ;
DQ ; Tasked entry point to search TIU document for specified text
+1 ; that should generate an alert to appropriate CPRS team.
+2 ;
+3 NEW AUMTI,AUMTJ,AUMTK,AUMTMSPT,AUMTXT,AUMTVL,AUMTVLS,AUMTXQA,X,X0,X1,Y,AUMTZ,AUMPRT
+4 ;
+5 IF '$DATA(^TIU(8925,AUMTDA,0))
QUIT
+6 ;
+7 ; Get visit location
+8 ; TIU*1.0*324 Get location from parent if an addendum
+9 IF AUMTADD
Begin DoDot:1
+10 SET AUMTVL=+$PIECE($GET(^TIU(8925,AUMTDA,12)),"^",11)
+11 IF 'AUMTVL
Begin DoDot:2
+12 SET AUMPRT=$PIECE(^TIU(8925,AUMTDA,0),U,6)
+13 SET AUMTVL=+$PIECE($GET(^TIU(8925,AUMPRT,12)),"^",11)
End DoDot:2
End DoDot:1
+14 IF '$TEST
SET AUMTVL=+$PIECE($GET(^TIU(8925,AUMTDA,12)),"^",11)
+15 SET AUMTVL(0)=$$GET1^DIQ(44,AUMTVL_",",.01)
+16 ;
+17 ; Setup array of text events to search in the document.
+18 SET AUMTI=0
+19 FOR
SET AUMTI=$ORDER(^TIU(8925.71,AUMTI))
if 'AUMTI
QUIT
Begin DoDot:1
+20 IF '$PIECE(^TIU(8925.71,AUMTI,0),"^",2)
QUIT
+21 SET X=$GET(^TIU(8925.71,AUMTI,3))
+22 IF X=""
QUIT
+23 ; TIU*1.0*324 these parameters no longer used
+24 ;S AUMTXT(AUMTI)=$P(^TIU(8925.71,AUMTI,0),"^",3,4)
+25 ; TIU*1.0*324 Compare Visit Search String in upper case only
+26 SET AUMTVLS=$$UPPER^TIULS($PIECE(^TIU(8925.71,AUMTI,0),"^",5))
+27 ; TIU*1.0*324 not case sensitive and remove spaces
+28 SET X=$$LOW^XLFSTR(X)
SET X=$TRANSLATE(X," ","")
SET AUMTXT(AUMTI,"T")=X
+29 ; visit location or visit location string defined
+30 IF $ORDER(^TIU(8925.71,AUMTI,5,0))!(AUMTVLS'="")
Begin DoDot:2
+31 IF $DATA(^TIU(8925.71,AUMTI,5,"B",AUMTVL))
SET AUMTXT(AUMTI,"VL")=""
QUIT
+32 IF AUMTVLS'=""
IF AUMTVL(0)[AUMTVLS
SET AUMTXT(AUMTI,"VL")=""
QUIT
+33 KILL AUMTXT(AUMTI)
End DoDot:2
End DoDot:1
+34 ;
+35 ; TIU*1.0*324 - Removing this logic so all alerts setup are sent even
+36 ; for the same search text
+37 ; Check if same alert text is for two or more events and one of the
+38 ; events is for this document's visit location then check for specific
+39 ; location event text and suppress the general event.
+40 ;S AUMTI=0
+41 ;F S AUMTI=$O(AUMTXT(AUMTI)) Q:'AUMTI D
+42 ;. I '$D(AUMTXT(AUMTI,"VL")) Q
+43 ;. S AUMTK=0
+44 ;. F S AUMTK=$O(AUMTXT(AUMTK)) Q:'AUMTK D
+45 ;. . I AUMTK=AUMTI!($D(AUMTXT(AUMTK,"VL"))) Q
+46 ;. . I AUMTXT(AUMTK,"T")=AUMTXT(AUMTI,"T") K AUMTXT(AUMTK)
+47 ;
+48 ; If no active text events then quit
+49 IF '$DATA(AUMTXT)
QUIT
+50 ;
+51 ; Search the current and preceeding line for matching text, deal with
+52 ; text that spans two lines.
+53 ; Skip the event if we've already found a match on a given text event.
+54 ; TIU*1.0*324 - REWRITE THIS CODE
+55 ;S AUMTI=0,X1=""
+56 ;F S AUMTI=$O(^TIU(8925,AUMTDA,"TEXT",AUMTI)) Q:'AUMTI D
+57 ;. S X0=X1,X1=^TIU(8925,AUMTDA,"TEXT",AUMTI,0)
+58 ;. S X=X0_X1
+59 ;. S AUMTJ=0
+60 ;. F S AUMTJ=$O(AUMTXT(AUMTJ)) Q:AUMTJ="" I '$D(AUMTXQA(AUMTJ)) D
+61 ;. . S Y=X
+62 ;. . S Y=$$LOW^XLFSTR(Y)
+63 ;. . I '$P(AUMTXT(AUMTJ),"^",2) S Y=$TR(Y," ","")
+64 ;. . S AUMTZ=0 F S AUMTZ=$O(AUMTXT(AUMTZ)) Q:AUMTZ="" S AUMTJ=AUMTZ D
+65 ;...I $G(Y)'="" S:Y[AUMTXT(AUMTJ,"T") AUMTXQA(AUMTJ)=AUMTJ
+66 ;
+67 ; TIU*1.0*324 REPLACEMENT CODE
+68 SET AUMTI=0
SET X1=""
+69 FOR
SET AUMTI=$ORDER(^TIU(8925,AUMTDA,"TEXT",AUMTI))
if 'AUMTI
QUIT
Begin DoDot:1
+70 SET X1=X1_^TIU(8925,AUMTDA,"TEXT",AUMTI,0)
End DoDot:1
+71 SET X1=$$LOW^XLFSTR(X1)
+72 ;strip out spaces (should all punctuation be stripped?
+73 SET X1=$TRANSLATE(X1," ","")
SET AUMTJ=0
+74 FOR
SET AUMTJ=$ORDER(AUMTXT(AUMTJ))
if AUMTJ=""
QUIT
Begin DoDot:1
+75 if X1[AUMTXT(AUMTJ,"T")
SET AUMTXQA(AUMTJ)=AUMTJ
End DoDot:1
+76 ; Send any alerts
+77 SET AUMTZ=0
SET AUMTZ=$ORDER(AUMTXQA(AUMTZ))
if AUMTZ'=""
DO SENDXQA
+78 ;
+79 KILL AUMTDA
+80 QUIT
+81 ;
+82 ;
SENDXQA ; Send Kernel alert to appropriate team or team device
+1 ;
+2 NEW AUMTHL,AUMTSKIP,AUMTEAM,AUMTI,AUMTJ,AUMTK,AUMTSA
+3 NEW DFN,TIU0,TIUPNM,TIUSSN,VA,XQA,XQADATA,XQAID,XQAMSG,XQAROU,XQATEXT
+4 ;
+5 SET TIU0=$GET(^TIU(8925,AUMTDA,0))
SET DFN=+$PIECE(TIU0,U,2)
+6 SET TIUPNM=$EXTRACT($$PTNAME^TIULC1(DFN),1,9)
+7 DO PID^VADPT6
+8 SET TIUSSN=$EXTRACT(TIUPNM,1)_VA("BID")
+9 ;
+10 ; Get hospital location for alert message text
+11 SET AUMTHL=+$PIECE($GET(^TIU(8925,AUMTDA,12)),"^",5)
+12 SET AUMTHL(0)=$$GET1^DIQ(44,AUMTHL_",",1)
+13 ;
+14 ; Send alert to each team's members and other additional recipients.
+15 SET AUMTI=0
+16 FOR
SET AUMTI=$ORDER(AUMTXQA(AUMTI))
if AUMTI=""
QUIT
Begin DoDot:1
+17 KILL XQA,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU,XQATEXT
+18 SET XQAID="TIUADD"_AUMTDA
SET XQADATA=AUMTDA_"^"
SET XQAROU="ACTADD^TIUALRT"
+19 SET XQAMSG=TIUPNM_" ("_TIUSSN_"): ("_AUMTHL(0)_") "_$PIECE($GET(^TIU(8925.71,AUMTI,2)),"^")
+20 SET AUMTK=0
+21 FOR
SET AUMTK=$ORDER(^TIU(8925.71,AUMTI,4,AUMTK))
if 'AUMTK
QUIT
Begin DoDot:2
+22 KILL AUMTEAM
+23 SET AUMTEAM=+^TIU(8925.71,AUMTI,4,AUMTK,0)
+24 IF AUMTEAM>0
DO ADDTEAM(AUMTEAM)
End DoDot:2
+25 DO ADDRECP
+26 IF $DATA(XQA)
DO SETUP^XQALERT
End DoDot:1
+27 ;
+28 ; Send alert to signer that teams have been notified.
+29 IF $DATA(AUMTSA)
DO SENDSA
+30 QUIT
+31 ;
+32 ;
SENDSA ; Build and sent alerts to signer
+1 ;
+2 NEW AUMTCNT,AUMTDUZ,AUMTI,AUMTMSG
+3 NEW XQA,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU,XQATEXT
+4 ;
+5 SET AUMTDUZ=+$PIECE($GET(^TIU(8925,AUMTDA,15)),"^",2)
+6 IF 'AUMTDUZ
QUIT
+7 SET AUMTI=0
SET AUMTMSG="Alert(s) Sent: "
+8 FOR
SET AUMTI=$ORDER(AUMTSA(AUMTI))
if 'AUMTI
QUIT
SET AUMTMSG=AUMTMSG_$PIECE($GET(^TIU(8925.71,AUMTI,2)),"^",2)_","
Begin DoDot:1
+9 SET XQAID="AUMTIU,"_AUMTDA
+10 SET XQAMSG=TIUPNM_" ("_TIUSSN_"): "_AUMTMSG
+11 SET XQA(AUMTDUZ)=""
+12 DO SETUP^XQALERT
End DoDot:1
+13 QUIT
+14 ;
+15 ;
SKIP() ; Check if we should skip alerting this team if they already have been sent an alert.
+1 ;
+2 NEW AUMTJ,AUMTSKIP
+3 SET (AUMTJ,AUMTSKIP)=0
+4 FOR
SET AUMTJ=$ORDER(AUMTSA(AUMTJ))
if 'AUMTJ!(AUMTJ>AUMTI)
QUIT
Begin DoDot:1
+5 IF AUMTI'=AUMTJ
IF $DATA(AUMTSA(AUMTJ,AUMTEAM))
SET AUMTSKIP=1
QUIT
End DoDot:1
+6 QUIT AUMTSKIP
+7 ;
+8 ;
ADDRECP ; Send to additional notification recipients.
+1 ; If no associate PC provider(3) then check and send to PC provider (1).
+2 ; If team (6) then check if patient is member of team.
+3 ; If PCP (7-19) checks for associated PCP in PATIENT file (#2) , fields 695021-695033
+4 ;
+5 NEW AUMTJ,AUMTK,AUMTL,AUMTX
+6 SET (AUMTJ,AUMTK,AUMTL)=0
+7 FOR
SET AUMTL=$ORDER(^TIU(8925.71,AUMTI,4.5,AUMTL))
if 'AUMTL
QUIT
Begin DoDot:1
+8 SET AUMTL(0)=^TIU(8925.71,AUMTI,4.5,AUMTL,0)
+9 SET AUMTK=$PIECE(AUMTL(0),"^")
+10 IF AUMTK<4
Begin DoDot:2
+11 SET AUMTJ=$$NMPCPR^SCAPMCU2(DFN,DT,AUMTK)
+12 IF AUMTK=3
IF AUMTJ<1
SET AUMTJ=$$NMPCPR^SCAPMCU2(DFN,DT,1)
+13 if AUMTJ>0
SET XQA($PIECE(AUMTJ,"^"))=""
End DoDot:2
QUIT
+14 IF AUMTK>3
IF AUMTK<6
Begin DoDot:2
+15 DO ATTPRIM^ORQPTQ3(.AUMTX,DFN)
+16 IF $PIECE(AUMTX,";",AUMTK-3)
SET XQA($PIECE($PIECE(AUMTX,";",AUMTK-3),"^"))=""
End DoDot:2
QUIT
+17 IF AUMTK=6
DO CHKTEAM($PIECE(AUMTL(0),"^",2))
QUIT
+18 IF AUMTK>6
IF AUMTK<20
Begin DoDot:2
+19 SET AUMTX=$GET(^DPT(DFN,695002))
+20 IF $PIECE(AUMTX,"^",AUMTK-6)
SET XQA($PIECE(AUMTX,"^",AUMTK-6))=""
End DoDot:2
QUIT
End DoDot:1
+21 QUIT
+22 ;
+23 ;
CHKTEAM(AUMTEAM) ; Check if this patient is linked to this team
+1 ;
+2 ; Call with AUMTEAM = ien of team in file 100.21
+3 ;
+4 NEW I
+5 IF '$DATA(AUMTMSPT)
DO TMSPT^ORQPTQ1(.AUMTMSPT,DFN)
+6 SET I=0
+7 FOR
SET I=$ORDER(AUMTMSPT(I))
if 'I
QUIT
IF $PIECE(AUMTMSPT(I),"^")=AUMTEAM
DO ADDTEAM(AUMTEAM)
+8 QUIT
+9 ;
+10 ;
ADDTEAM(AUMTEAM) ; Add members of team to list of recipients
+1 ;
+2 ; Call with AUMTEAM = ien of team in file 100.21
+3 ;
+4 NEW AUMTD,AUMTDEV,AUMTJ
+5 ;I $$SKIP Q
+6 SET AUMTD=$PIECE($$TMDEV^ORB31(AUMTEAM),"^",2)
+7 IF AUMTD'=""
SET AUMTDEV(AUMTD)=""
DO REGDEV^ORB31(.AUMTDEV)
+8 DO TEAMPROV^ORQPTQ1(.AUMTEAM,AUMTEAM)
+9 IF '$GET(AUMTEAM(1))
QUIT
+10 SET AUMTSA(AUMTI,AUMTEAM)=""
+11 SET AUMTJ=0
+12 FOR
SET AUMTJ=$ORDER(AUMTEAM(AUMTJ))
if 'AUMTJ
QUIT
SET XQA(+AUMTEAM(AUMTJ))=""
+13 QUIT
