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

TIUTIUS.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. TASK(AUMTDA) ; Task searching of document for specified text
  1.  N AUMTADD,I,ZTDESC,ZTDTH,ZTRTN,ZTIO,ZTSAVE,X,ZTSK
  1.  I $G(AUMTDA)<1 Q
  1.  ;
  1.  ; Check if document is an addendum
  1.  S AUMTADD=+$$ISADDNDM^TIULC1(AUMTDA)
  1.  ;
  1.  ; If original don't check if cosigned and signer different than cosigner - was checked when signed.
  1.  F I=0,15 S X(I)=$G(^TIU(8925,AUMTDA,I))
  1.  ;TIU*1*346 Remove this line that prevents alerts from being sent when completed by cosigner
  1.  ;I 'AUMTADD,$P(X(15),"^",8),$P(X(15),"^",2),$P(X(15),"^",8)'=$P(X(15),"^",2) Q
  1.  ; If addendum and not complete then don't check.
  1.  I AUMTADD,$P(X(0),"^",5)'=7 Q
  1.  ;
  1.  ; TIU*1.0*324 Pass AUMTADD
  1.  S ZTDTH=$H,ZTIO="",ZTSAVE("AUMTDA")="",ZTSAVE("AUMTADD")=""
  1.  S ZTRTN="DQ^TIUTIUS",ZTDESC="Search TIU document for specified text"
  1.  ; TIU 324 TESTING
  1.  D ^%ZTLOAD
  1.  ; TIU*1.0*324 Call in foreground of it failed to queue
  1.  I '$D(ZTSK) D DQ^TIUTIUS
  1.  Q
  1.  ;
  1.  ;
  1. DQ ; Tasked entry point to search TIU document for specified text 
  1.  ; that should generate an alert to appropriate CPRS team.
  1.  ;
  1.  N AUMTI,AUMTJ,AUMTK,AUMTMSPT,AUMTXT,AUMTVL,AUMTVLS,AUMTXQA,X,X0,X1,Y,AUMTZ,AUMPRT
  1.  ;
  1.  I '$D(^TIU(8925,AUMTDA,0)) Q
  1.  ;
  1.  ; Get visit location
  1.  ; TIU*1.0*324 Get location from parent if an addendum
  1.  I AUMTADD D
  1.  . S AUMTVL=+$P($G(^TIU(8925,AUMTDA,12)),"^",11)
  1.  . I 'AUMTVL D
  1.  . . S AUMPRT=$P(^TIU(8925,AUMTDA,0),U,6)
  1.  . . S AUMTVL=+$P($G(^TIU(8925,AUMPRT,12)),"^",11)
  1.  E  S AUMTVL=+$P($G(^TIU(8925,AUMTDA,12)),"^",11)
  1.  S AUMTVL(0)=$$GET1^DIQ(44,AUMTVL_",",.01)
  1.  ;
  1.  ; Setup array of text events to search in the document.
  1.  S AUMTI=0
  1.  F  S AUMTI=$O(^TIU(8925.71,AUMTI)) Q:'AUMTI  D
  1.  . I '$P(^TIU(8925.71,AUMTI,0),"^",2) Q
  1.  . S X=$G(^TIU(8925.71,AUMTI,3))
  1.  . I X="" Q
  1.  . ; TIU*1.0*324 these parameters no longer used
  1.  . ;S AUMTXT(AUMTI)=$P(^TIU(8925.71,AUMTI,0),"^",3,4)
  1.  . ; TIU*1.0*324 Compare Visit Search String in upper case only
  1.  . S AUMTVLS=$$UPPER^TIULS($P(^TIU(8925.71,AUMTI,0),"^",5))
  1.  . ; TIU*1.0*324 not case sensitive and remove spaces
  1.  . S X=$$LOW^XLFSTR(X),X=$TR(X," ","") S AUMTXT(AUMTI,"T")=X
  1.  . ; visit location or visit location string defined
  1.  . I $O(^TIU(8925.71,AUMTI,5,0))!(AUMTVLS'="") D
  1.  . . I $D(^TIU(8925.71,AUMTI,5,"B",AUMTVL)) S AUMTXT(AUMTI,"VL")="" Q
  1.  . . I AUMTVLS'="",AUMTVL(0)[AUMTVLS S AUMTXT(AUMTI,"VL")="" Q
  1.  . . K AUMTXT(AUMTI)
  1.  ;
  1.  ; TIU*1.0*324 - Removing this logic so all alerts setup are sent even 
  1.  ; for the same search text
  1.  ; Check if same alert text is for two or more events and one of the
  1.  ; events is for this document's visit location then check for specific
  1.  ; location event text and suppress the general event.
  1.  ;S AUMTI=0
  1.  ;F  S AUMTI=$O(AUMTXT(AUMTI)) Q:'AUMTI  D
  1.  ;. I '$D(AUMTXT(AUMTI,"VL")) Q
  1.  ;. S AUMTK=0
  1.  ;. F  S AUMTK=$O(AUMTXT(AUMTK)) Q:'AUMTK  D
  1.  ;. . I AUMTK=AUMTI!($D(AUMTXT(AUMTK,"VL"))) Q
  1.  ;. . I AUMTXT(AUMTK,"T")=AUMTXT(AUMTI,"T") K AUMTXT(AUMTK)
  1.  ;
  1.  ; If no active text events then quit
  1.  I '$D(AUMTXT) Q
  1.  ;
  1.  ; Search the current and preceeding line for matching text, deal with
  1.  ; text that spans two lines.
  1.  ; Skip the event if we've already found a match on a given text event.
  1.  ; TIU*1.0*324 - REWRITE THIS CODE
  1.  ;S AUMTI=0,X1=""
  1.  ;F  S AUMTI=$O(^TIU(8925,AUMTDA,"TEXT",AUMTI)) Q:'AUMTI  D
  1.  ;. S X0=X1,X1=^TIU(8925,AUMTDA,"TEXT",AUMTI,0)
  1.  ;. S X=X0_X1
  1.  ;. S AUMTJ=0
  1.  ;. F  S AUMTJ=$O(AUMTXT(AUMTJ)) Q:AUMTJ=""  I '$D(AUMTXQA(AUMTJ)) D
  1.  ;. . S Y=X
  1.  ;. . S Y=$$LOW^XLFSTR(Y)
  1.  ;. . I '$P(AUMTXT(AUMTJ),"^",2) S Y=$TR(Y," ","")
  1.  ;. . S AUMTZ=0 F  S AUMTZ=$O(AUMTXT(AUMTZ)) Q:AUMTZ=""  S AUMTJ=AUMTZ D
  1.  ;...I $G(Y)'="" S:Y[AUMTXT(AUMTJ,"T") AUMTXQA(AUMTJ)=AUMTJ
  1.  ;
  1.  ; TIU*1.0*324 REPLACEMENT CODE
  1.  S AUMTI=0,X1=""
  1.  F  S AUMTI=$O(^TIU(8925,AUMTDA,"TEXT",AUMTI)) Q:'AUMTI  D
  1.  . S X1=X1_^TIU(8925,AUMTDA,"TEXT",AUMTI,0)
  1.  S X1=$$LOW^XLFSTR(X1)
  1.  ;strip out spaces (should all punctuation be stripped?
  1.  S X1=$TR(X1," ",""),AUMTJ=0
  1.  F  S AUMTJ=$O(AUMTXT(AUMTJ)) Q:AUMTJ=""  D
  1.  . S:X1[AUMTXT(AUMTJ,"T") AUMTXQA(AUMTJ)=AUMTJ
  1.  ; Send any alerts
  1.  S AUMTZ=0 S AUMTZ=$O(AUMTXQA(AUMTZ)) D:AUMTZ'="" SENDXQA
  1.  ;
  1.  K AUMTDA
  1.  Q
  1.  ;
  1.  ;
  1. SENDXQA ; Send Kernel alert to appropriate team or team device 
  1.  ;
  1.  N AUMTHL,AUMTSKIP,AUMTEAM,AUMTI,AUMTJ,AUMTK,AUMTSA
  1.  N DFN,TIU0,TIUPNM,TIUSSN,VA,XQA,XQADATA,XQAID,XQAMSG,XQAROU,XQATEXT
  1.  ;
  1.  S TIU0=$G(^TIU(8925,AUMTDA,0)),DFN=+$P(TIU0,U,2)
  1.  S TIUPNM=$E($$PTNAME^TIULC1(DFN),1,9)
  1.  D PID^VADPT6
  1.  S TIUSSN=$E(TIUPNM,1)_VA("BID")
  1.  ;
  1.  ; Get hospital location for alert message text
  1.  S AUMTHL=+$P($G(^TIU(8925,AUMTDA,12)),"^",5)
  1.  S AUMTHL(0)=$$GET1^DIQ(44,AUMTHL_",",1)
  1.  ;
  1.  ; Send alert to each team's members and other additional recipients.
  1.  S AUMTI=0
  1.  F  S AUMTI=$O(AUMTXQA(AUMTI)) Q:AUMTI=""  D
  1.  . K XQA,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU,XQATEXT
  1.  . S XQAID="TIUADD"_AUMTDA,XQADATA=AUMTDA_"^",XQAROU="ACTADD^TIUALRT"
  1.  . S XQAMSG=TIUPNM_" ("_TIUSSN_"): ("_AUMTHL(0)_") "_$P($G(^TIU(8925.71,AUMTI,2)),"^")
  1.  . S AUMTK=0
  1.  . F  S AUMTK=$O(^TIU(8925.71,AUMTI,4,AUMTK)) Q:'AUMTK  D
  1.  . . K AUMTEAM
  1.  . . S AUMTEAM=+^TIU(8925.71,AUMTI,4,AUMTK,0)
  1.  . . I AUMTEAM>0 D ADDTEAM(AUMTEAM)
  1.  . D ADDRECP
  1.  . I $D(XQA) D SETUP^XQALERT
  1.  ;
  1.  ; Send alert to signer that teams have been notified.
  1.  I $D(AUMTSA) D SENDSA
  1.  Q
  1.  ;
  1.  ;
  1. SENDSA ; Build and sent alerts to signer
  1.  ;
  1.  N AUMTCNT,AUMTDUZ,AUMTI,AUMTMSG
  1.  N XQA,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU,XQATEXT
  1.  ;
  1.  S AUMTDUZ=+$P($G(^TIU(8925,AUMTDA,15)),"^",2)
  1.  I 'AUMTDUZ Q
  1.  S AUMTI=0,AUMTMSG="Alert(s) Sent: "
  1.  F  S AUMTI=$O(AUMTSA(AUMTI)) Q:'AUMTI  S AUMTMSG=AUMTMSG_$P($G(^TIU(8925.71,AUMTI,2)),"^",2)_"," D
  1.  . S XQAID="AUMTIU,"_AUMTDA
  1.  . S XQAMSG=TIUPNM_" ("_TIUSSN_"): "_AUMTMSG
  1.  . S XQA(AUMTDUZ)=""
  1.  . D SETUP^XQALERT
  1.  Q
  1.  ;
  1.  ;
  1. SKIP() ; Check if we should skip alerting this team if they already have been sent an alert.
  1.  ;
  1.  N AUMTJ,AUMTSKIP
  1.  S (AUMTJ,AUMTSKIP)=0
  1.  F  S AUMTJ=$O(AUMTSA(AUMTJ)) Q:'AUMTJ!(AUMTJ>AUMTI)  D
  1.  . I AUMTI'=AUMTJ,$D(AUMTSA(AUMTJ,AUMTEAM)) S AUMTSKIP=1 Q
  1.  Q AUMTSKIP
  1.  ;
  1.  ;
  1. ADDRECP ; Send to additional notification recipients.
  1.  ; If no associate PC provider(3) then check and send to PC provider (1).
  1.  ; If team (6) then check if patient is member of team.
  1.  ; If PCP (7-19) checks for associated PCP in PATIENT file (#2) , fields 695021-695033
  1.  ;
  1.  N AUMTJ,AUMTK,AUMTL,AUMTX
  1.  S (AUMTJ,AUMTK,AUMTL)=0
  1.  F  S AUMTL=$O(^TIU(8925.71,AUMTI,4.5,AUMTL)) Q:'AUMTL  D
  1.  . S AUMTL(0)=^TIU(8925.71,AUMTI,4.5,AUMTL,0)
  1.  . S AUMTK=$P(AUMTL(0),"^")
  1.  . I AUMTK<4 D  Q
  1.  . . S AUMTJ=$$NMPCPR^SCAPMCU2(DFN,DT,AUMTK)
  1.  . . I AUMTK=3,AUMTJ<1 S AUMTJ=$$NMPCPR^SCAPMCU2(DFN,DT,1)
  1.  . . S:AUMTJ>0 XQA($P(AUMTJ,"^"))=""
  1.  . I AUMTK>3,AUMTK<6 D  Q
  1.  . . D ATTPRIM^ORQPTQ3(.AUMTX,DFN)
  1.  . . I $P(AUMTX,";",AUMTK-3) S XQA($P($P(AUMTX,";",AUMTK-3),"^"))=""
  1.  . I AUMTK=6 D CHKTEAM($P(AUMTL(0),"^",2)) Q
  1.  . I AUMTK>6,AUMTK<20 D  Q
  1.  . . S AUMTX=$G(^DPT(DFN,695002))
  1.  . . I $P(AUMTX,"^",AUMTK-6) S XQA($P(AUMTX,"^",AUMTK-6))=""
  1.  Q
  1.  ;
  1.  ;
  1. CHKTEAM(AUMTEAM) ; Check if this patient is linked to this team
  1.  ;
  1.  ; Call with AUMTEAM = ien of team in file 100.21
  1.  ;
  1.  N I
  1.  I '$D(AUMTMSPT) D TMSPT^ORQPTQ1(.AUMTMSPT,DFN)
  1.  S I=0
  1.  F  S I=$O(AUMTMSPT(I)) Q:'I  I $P(AUMTMSPT(I),"^")=AUMTEAM D ADDTEAM(AUMTEAM)
  1.  Q
  1.  ;
  1.  ;
  1. ADDTEAM(AUMTEAM) ; Add members of team to list of recipients
  1.  ;
  1.  ; Call with AUMTEAM = ien of team in file 100.21
  1.  ;
  1.  N AUMTD,AUMTDEV,AUMTJ
  1.  ;I $$SKIP Q
  1.  S AUMTD=$P($$TMDEV^ORB31(AUMTEAM),"^",2)
  1.  I AUMTD'="" S AUMTDEV(AUMTD)="" D REGDEV^ORB31(.AUMTDEV)
  1.  D TEAMPROV^ORQPTQ1(.AUMTEAM,AUMTEAM)
  1.  I '$G(AUMTEAM(1)) Q
  1.  S AUMTSA(AUMTI,AUMTEAM)=""
  1.  S AUMTJ=0
  1.  F  S AUMTJ=$O(AUMTEAM(AUMTJ)) Q:'AUMTJ  S XQA(+AUMTEAM(AUMTJ))=""
  1.  Q