TIUALRT ; SLC/JER,AJB - SEND ALERTS ;11/08/23 10:36
;;1.0;TEXT INTEGRATION UTILITIES;**21,84,79,88,58,61,151,158,175,221,227,259,355,358,353,357**;Jun 20, 1997;Build 5
;
; Reference to ^DPT( supported by ICR #10035
; Reference to ^VA(200 supported by ICR #4329
; Reference to ONEHR^ORACCESS supported by ICR #7356
;
Q
SEND(DA,OVERDUE,TIUXQA) ;
; DA document IEN
; [OVERDUE] send alert as overdue
; [TIUXQA] third party alerts, passed by reference, TIUXQA(<IEN>)="" recipients
; TIUXQA=0 delete current alerts, TIUXQA=1 keep current alerts
N ADDENDUM,FDA,NODE,TIUAAALRT,TIUDPRM,TIUPRM0,TIUPRM1,XQA,XQAARCH,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU
S NODE(0)=$G(^TIU(8925,+DA,0)) Q:'NODE(0) S NODE(12)=$G(^(12)),NODE(13)=$G(^(13))
S NODE(14)=$G(^TIU(8925,+DA,14)),NODE(15)=$G(^(15)),OVERDUE=+$G(OVERDUE,0),ZTREQ="@"
S ADDENDUM=$S($P($G(^TIU(8925.1,+NODE(0),0)),U)["ADDENDUM"&$P(NODE(0),U,6):1,1:0) ; is document an addendum?
I '$G(TIUXQA) D ALERTDEL(DA) ; delete alerts for a document
D SETPARM^TIULE S (TIUDPRM(0),TIUDPRM(5))="" D DOCPRM^TIULC1(+NODE(0),.TIUDPRM,DA) ; get basic & document parameters
S TIUAAALRT=$G(TIUADDL,0) ; from nightly task, if additional signer overdue, TIUADDL=1
Q:'$D(TIUDPRM(0)) ; quit if no document parameters (? - original code)
Q:'+$P(TIUPRM1,U,7) ; quit if notification enable date not set
Q:+$P(TIUPRM1,U,7)>+$P(NODE(12),U) ; quit if entry date/time earlier than notification date
Q:$P(NODE(0),U,5)=15 ; quit, document status is retracted
N TIU S TIU("Status")=$P(NODE(0),U,5),TIU("Author/Dictator")=$P(NODE(12),U,2) ; set field data
S TIU("Expected Signer")=$P(NODE(12),U,4),TIU("Signature Date/Time")=$P(NODE(15),U)
S TIU("Expected Co-signer")=$P(NODE(12),U,8),TIU("Attending Physician")=$P(NODE(12),U,9)
S TIU("Co-signature Date/Time")=$P(NODE(15),U,7)
I +$G(TIUXQA)!(TIU("Status")>6) G TPA ; send only third party or additional signer alerts
I +$P(TIUDPRM(0),U,2),TIU("Status")=3,'+$P(NODE(13),U,4) Q ; requires release, unreleased, no release date/time
I +$P(TIUDPRM(0),U,3),TIU("Status")=4,'+$P(NODE(13),U,5) Q ; requires verification, unverified, no verification date/time
I 'TIU("Expected Signer"),TIU("Author/Dictator") D ; no expected signer, set expected signer to author/dictator
. S TIU("Expected Signer")=TIU("Author/Dictator")
. S FDA(8925,DA_",",1204)=TIU("Expected Signer") D FILE^DIE(,"FDA")
I 'TIU("Expected Co-signer"),TIU("Attending Physician") D ; no co-signer, set expected co-signer to attending physician
. S TIU("Expected Co-signer")=TIU("Attending Physician")
. S FDA(8925,DA_",",1208)=$P(NODE(12),U,9) D FILE^DIE(,"FDA")
; signer as recipient
I $P(TIUDPRM(0),U,4),'TIU("Signature Date/Time"),TIU("Expected Signer") D ; require author to sign, no signature
. Q:TIU("Status")>5 S XQA(TIU("Expected Signer"))="" ; verify status, add as recipient
; co-signer as recipient
I TIU("Expected Co-signer"),'TIU("Co-signature Date/Time"),TIU("Status")<7 D
. I '$P(TIUDPRM(0),U,20),$P(TIUDPRM(0),U,4),'TIU("Signature Date/Time") Q ; send co-signer alert, require author to sign, unsigned
. S XQA(TIU("Expected Co-signer"))=""
TPA S TIUXQA=0 F S TIUXQA=$O(TIUXQA(TIUXQA)) Q:'TIUXQA S XQA(TIUXQA)="" ; set third party alert recipients
I ADDENDUM,'TIUAAALRT D SENDADD(DA) ; if from nightly task, do not send addendum added alert
Q:'$D(XQA)&'$O(^TIU(8925.7,"B",DA,0)) ; quit, no recipients or additional signers
N D0,PT,XQALERR D PATVADPT^TIULV(.PT,$P(NODE(0),U,2)) ; get patient demographics
; if recipients, setup alert data and send alert
I $D(XQA) D XQADATA(DA,.PT),SETUP^XQALERT Q:+$G(TIUXQA) K XQA ; send , if third party alert quit
I $P(NODE(0),U,5)>5,$O(^TIU(8925.7,"B",DA,0)) D ; for a signed document, check for additional signers
. N I S I=0 F S I=$O(^TIU(8925.7,"AC",+NODE(12),DA,I)) Q:'I D ; traverse "AC" for outstanding additional signers
. . I '$D(^TIU(8925.7,I,0)) K ^TIU(8925.7,"AC",+NODE(12),DA,I) Q ; remove "AC" if no entry
. . I +$P($G(^TIU(8925.7,I,0)),U,4) K ^TIU(8925.7,"AC",+NODE(12),DA,I) Q ; remove "AC" if signed
. . N USR S USR=$P($G(^TIU(8925.7,I,0)),U,3) S:+USR XQA(USR)="" ; set additional signer
Q:'$D(XQA) ; quit, no outstanding additional signers
D XQADATA(DA,.PT,1),SETUP^XQALERT ; send additional signer alert(s)
Q
XQADATA(DA,PT,AS) ; setup message text
; DA document IEN PT patient demographics [passed by reference]
; AS additional signer [default 0]
S XQAARCH=24000,XQADATA=+DA_U,XQADFN=$P(NODE(0),U,2),XQAID="TIU"_DA,XQAROU="ACT^TIUALRT"
S XQAMSG=PT("PNM")_" ("_$E(PT("PNM"),1)_$P(PT("SSN"),"-",3)_"): "
S XQAMSG=XQAMSG_$S(TIU("Status")=5&TIU("Expected Co-signer")&$P(TIUDPRM(0),U,20):"UNSIGNED/UNCOSIGNED",1:$$UP^XLFSTR($$GET1^DIQ(8925,DA,.05)))
S XQAMSG=XQAMSG_$S($P(NODE(0),U,9)="P":" STAT ",1:" ")_$$PNAME^TIULC1(+NODE(0))
S XQAMSG=XQAMSG_$S(OVERDUE:" Dated "_$$DATE^TIULS(+NODE(13))_" OVERDUE for ",1:" available for ")
S XQAMSG=XQAMSG_$S(TIU("Status")'>5:"SIGNATURE",TIU("Status")=6&('$G(AS)):"COSIGNATURE",1:"ADDITIONAL SIGNATURE")
Q
ACT ; Act on alerts
N TIUQUIK,TIUDA,TIUPRM0,TIUPRM1,TIUPRM3,RSTOK S TIUQUIK=1 K XQAKILL
I $$ONEHR^ORACCESS D Q ; *353 agp
. W !,"Site has migrated to Electronic Health Record."
. W !,"TIU List Manager access not allowed."
. I $$READ^TIUU("EA","RETURN to continue...")
S TIUDA=$P(XQADATA,U)
I '$D(^TIU(8925,+TIUDA,0)) D ALERTDEL(TIUDA) Q
S RSTOK=$$DOCCHK^TIULRR(TIUDA)
I RSTOK'>0 D Q
. W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
. I $$READ^TIUU("EA","RETURN to continue...") ; pause
I $P(^TIU(8925,+TIUDA,0),U,5)>6,'+$$ISSIGNR(TIUDA,DUZ) S XQAKILL=1 ; *357
D:'$D(TIUPRM0)!'$D(TIUPRM1) SETPARM^TIULE
D EN^VALM("TIU BROWSE FOR CLINICIAN")
Q
ISSIGNR(DA,USER) ; *357, is user an additional signer (or surrogate for) and is signature outstanding?
N TIUAS,TIUY S (TIUAS,TIUY)=0
F S TIUAS=$O(^TIU(8925.7,"AE",DA,TIUAS)) Q:'TIUAS!(+TIUY) I USER=TIUAS!(USER=$$ACTVSURO^XQALSURO(TIUAS)) D
. N NODE0 S NODE0=$G(^TIU(8925.7,+$O(^TIU(8925.7,"AE",DA,TIUAS,0)),0))
. I +$L(NODE0),+$P(NODE0,U,4)'>0 S TIUY=1
I 'TIUY D TASKALRT(DA) ; resend alert(s) for a document
Q TIUY
TASKALRT(DA) ; resend alert(s) for a document via a delayed task *357
N TIUADDL,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK S TIUADDL=1,ZTDESC="SEND^TIUALRT("_DA_")",ZTDTH=+$H_","_($P($H,",",2)+10)
S ZTIO="",ZTSAVE("TIUADDL")="",ZTSAVE("DA")="",ZTRTN="SEND^TIUALRT(DA)" D ^%ZTLOAD
Q
SENDTRAN(DA) ; Generate "Send back to transcription" alert
N TIUEDT,TIU0,TIUPNM,TIUSSN,TIUTRAN,TIU,XQA,XQAMSG,TIUMSG
N TIUESNR,TIU12,TIU13,TIU14,TIU15,TIUTYP
N XQAID ;259
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
D ALERTDEL(DA)
; Don't send if notifications not enabled
I '+$P(TIUPRM1,U,7) Q
S TIU0=$G(^TIU(8925,+DA,0)),TIU12=$G(^(12)),TIU13=$G(^(13))
S TIU14=$G(^TIU(8925,+DA,14)),TIU15=$G(^(15))
S TIUPNM=$E($P($G(^DPT(+$P(TIU0,U,2),0)),U),1,9)
S TIUEDT=$$DATE^TIULS($P(TIU0,U,7))
S TIUTYP=$$PNAME^TIULC1(+$G(TIU0))
S TIUTRAN=$P(TIU13,U,2),TIUESNR=$P(TIU12,U,2) ; **175**
D PATVADPT^TIULV(.TIU,+$P(TIU0,U,2)) ;Used to get SSN. Date not important.
S TIUSSN=$E(TIUPNM,1)_$P($G(TIU("SSN")),"-",3)
;I $D(^VA(200,+TIUTRAN,0)) S XQA(TIUTRAN)=""
I $$PROVIDER^XUSER(TIUTRAN) S XQA(TIUTRAN)="" ;ICR #2343 In file 200 & not terminated
Q:$D(XQA)'>9
S TIUMSG=$S(TIUTRAN=TIUESNR:" needs editing",1:" needs retranscription.")
S XQAID="TIU"_+DA
S XQAMSG=TIUPNM_" ("_TIUSSN_"): "_TIUTYP_TIUMSG
D SETUP^XQALERT
Q
SENDADD(DA) ; Generates "Addendum added" alert
N TIU12,TIU13,TIU14,TIU15,TIU0,TIUPNM,TIUSSN,TIUTRAN,TIU,TIUTITLE,TIUDPRM
N XQA,XQAMSG,XQAFLG,XQADATA,XQAROU,TIUESNR,TIUDATE,TIUESNM,TIUO0,TIUO12,TIUO13
N XQAID,TIUECSNR ;P259
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
D ADDENDEL(DA)
; Don't send if notifications not enabled
I '+$P(TIUPRM1,U,7) Q
S TIU0=$G(^TIU(8925,+DA,0))
; Only send upon completion
Q:+$P(TIU0,U,5)'>6
D DOCPRM^TIULC1(+TIU0,.TIUDPRM,DA) Q:'+$P(TIUDPRM(0),U,17)
S TIU12=$G(^TIU(8925,+DA,12)),TIU13=$G(^(13)),TIU14=$G(^(14)),TIU15=$G(^(15))
S TIUO0=$G(^TIU(8925,$P(TIU0,U,6),0)),TIUO12=$G(^(12)),TIUO13=$G(^(13))
S TIUPNM=$E($$PTNAME^TIULC1(+$P(TIU0,U,2)),1,9)
S TIUESNM=$$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIU12,U,2)),"LAST,FI MI")
S TIUTITLE=$E($$PNAME^TIULC1(+TIUO0),1,20)
S TIUDATE=$S(+$P(TIUO13,U):$P(TIUO13,U),1:$G(DT))
S TIUDATE=$$DATE^TIULS(TIUDATE)
D PATVADPT^TIULV(.TIU,+$P(TIU0,U,2)) ;Used to get SSN. Date not important.
S TIUSSN=$E(TIUPNM,1)_$P($G(TIU("SSN")),"-",3)
S TIUTRAN=$P(TIU13,U,2)
;Expected Cosigner and Author of original document
S TIUECSNR=$P($G(^TIU(8925,$P(TIU0,U,6),12)),U,8),TIUESNR=$P($G(^(12)),U,4)
; Not entered by Expected Signer: SET Expected Signer as recipient
I TIUESNR'=TIUTRAN,$D(^VA(200,+TIUESNR,0)) S XQA(TIUESNR)=""
; Not entered by Expected Cosigner: SET Expected Cosigner as recipient
; VMP/RJT - *227 - If user is the expected cosigner, do not send alert
I +TIUECSNR>0,(TIUECSNR'=DUZ),(TIUECSNR'=TIUTRAN),$D(^VA(200,+TIUECSNR,0)) S XQA(TIUECSNR)=""
Q:$D(XQA)'>9
S XQAID="TIUADD"_+DA,XQADATA=+DA_U,XQAROU="ACTADD^TIUALRT"
S XQAMSG=TIUPNM_" ("_TIUSSN_"): ADDENDUM to "_TIUTITLE_" of "_TIUDATE_" by "_TIUESNM
D SETUP^XQALERT
Q
ACTADD ; Act on ADDENDUM alerts
N TIUQUIK,TIUDA,TIUPRM0,TIUPRM1,TIUPRM3 S TIUQUIK=1 K XQAKILL
S TIUDA=$P(XQADATA,U),XQAKILL=1
I '$D(^TIU(8925,+TIUDA,0)) D ADDENDEL(TIUDA) Q
W !!,"A NEW Addendum has been added to your document...",!
W:$L($P($G(XQX),U,3)) !,$P($G(XQX),U,3),!
I '+$$READ^TIUU("YAO","Do you wish to Browse the Addendum now? ","NO") Q
D:'$D(TIUPRM0)!'$D(TIUPRM1) SETPARM^TIULE
D EN^VALM("TIU BROWSE FOR CLINICIAN")
Q
ALERTDEL(DA) ; Delete alerts associated with a given document
N XQA,XQAID,XQAKILL S XQAID="TIU"_DA
D DELETEA^XQALERT
Q
ADDENDEL(DA) ; Delete alert associated with a Addendum added
N XQA,XQAID,XQAKILL S XQAID="TIUADD"_DA
D DELETEA^XQALERT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUALRT 10978 printed Dec 13, 2024@02:38:50 Page 2
TIUALRT ; SLC/JER,AJB - SEND ALERTS ;11/08/23 10:36
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**21,84,79,88,58,61,151,158,175,221,227,259,355,358,353,357**;Jun 20, 1997;Build 5
+2 ;
+3 ; Reference to ^DPT( supported by ICR #10035
+4 ; Reference to ^VA(200 supported by ICR #4329
+5 ; Reference to ONEHR^ORACCESS supported by ICR #7356
+6 ;
+7 QUIT
SEND(DA,OVERDUE,TIUXQA) ;
+1 ; DA document IEN
+2 ; [OVERDUE] send alert as overdue
+3 ; [TIUXQA] third party alerts, passed by reference, TIUXQA(<IEN>)="" recipients
+4 ; TIUXQA=0 delete current alerts, TIUXQA=1 keep current alerts
+5 NEW ADDENDUM,FDA,NODE,TIUAAALRT,TIUDPRM,TIUPRM0,TIUPRM1,XQA,XQAARCH,XQADATA,XQADFN,XQAID,XQAMSG,XQAROU
+6 SET NODE(0)=$GET(^TIU(8925,+DA,0))
if 'NODE(0)
QUIT
SET NODE(12)=$GET(^(12))
SET NODE(13)=$GET(^(13))
+7 SET NODE(14)=$GET(^TIU(8925,+DA,14))
SET NODE(15)=$GET(^(15))
SET OVERDUE=+$GET(OVERDUE,0)
SET ZTREQ="@"
+8 ; is document an addendum?
SET ADDENDUM=$SELECT($PIECE($GET(^TIU(8925.1,+NODE(0),0)),U)["ADDENDUM"&$PIECE(NODE(0),U,6):1,1:0)
+9 ; delete alerts for a document
IF '$GET(TIUXQA)
DO ALERTDEL(DA)
+10 ; get basic & document parameters
DO SETPARM^TIULE
SET (TIUDPRM(0),TIUDPRM(5))=""
DO DOCPRM^TIULC1(+NODE(0),.TIUDPRM,DA)
+11 ; from nightly task, if additional signer overdue, TIUADDL=1
SET TIUAAALRT=$GET(TIUADDL,0)
+12 ; quit if no document parameters (? - original code)
if '$DATA(TIUDPRM(0))
QUIT
+13 ; quit if notification enable date not set
if '+$PIECE(TIUPRM1,U,7)
QUIT
+14 ; quit if entry date/time earlier than notification date
if +$PIECE(TIUPRM1,U,7)>+$PIECE(NODE(12),U)
QUIT
+15 ; quit, document status is retracted
if $PIECE(NODE(0),U,5)=15
QUIT
+16 ; set field data
NEW TIU
SET TIU("Status")=$PIECE(NODE(0),U,5)
SET TIU("Author/Dictator")=$PIECE(NODE(12),U,2)
+17 SET TIU("Expected Signer")=$PIECE(NODE(12),U,4)
SET TIU("Signature Date/Time")=$PIECE(NODE(15),U)
+18 SET TIU("Expected Co-signer")=$PIECE(NODE(12),U,8)
SET TIU("Attending Physician")=$PIECE(NODE(12),U,9)
+19 SET TIU("Co-signature Date/Time")=$PIECE(NODE(15),U,7)
+20 ; send only third party or additional signer alerts
IF +$GET(TIUXQA)!(TIU("Status")>6)
GOTO TPA
+21 ; requires release, unreleased, no release date/time
IF +$PIECE(TIUDPRM(0),U,2)
IF TIU("Status")=3
IF '+$PIECE(NODE(13),U,4)
QUIT
+22 ; requires verification, unverified, no verification date/time
IF +$PIECE(TIUDPRM(0),U,3)
IF TIU("Status")=4
IF '+$PIECE(NODE(13),U,5)
QUIT
+23 ; no expected signer, set expected signer to author/dictator
IF 'TIU("Expected Signer")
IF TIU("Author/Dictator")
Begin DoDot:1
+24 SET TIU("Expected Signer")=TIU("Author/Dictator")
+25 SET FDA(8925,DA_",",1204)=TIU("Expected Signer")
DO FILE^DIE(,"FDA")
End DoDot:1
+26 ; no co-signer, set expected co-signer to attending physician
IF 'TIU("Expected Co-signer")
IF TIU("Attending Physician")
Begin DoDot:1
+27 SET TIU("Expected Co-signer")=TIU("Attending Physician")
+28 SET FDA(8925,DA_",",1208)=$PIECE(NODE(12),U,9)
DO FILE^DIE(,"FDA")
End DoDot:1
+29 ; signer as recipient
+30 ; require author to sign, no signature
IF $PIECE(TIUDPRM(0),U,4)
IF 'TIU("Signature Date/Time")
IF TIU("Expected Signer")
Begin DoDot:1
+31 ; verify status, add as recipient
if TIU("Status")>5
QUIT
SET XQA(TIU("Expected Signer"))=""
End DoDot:1
+32 ; co-signer as recipient
+33 IF TIU("Expected Co-signer")
IF 'TIU("Co-signature Date/Time")
IF TIU("Status")<7
Begin DoDot:1
+34 ; send co-signer alert, require author to sign, unsigned
IF '$PIECE(TIUDPRM(0),U,20)
IF $PIECE(TIUDPRM(0),U,4)
IF 'TIU("Signature Date/Time")
QUIT
+35 SET XQA(TIU("Expected Co-signer"))=""
End DoDot:1
TPA ; set third party alert recipients
SET TIUXQA=0
FOR
SET TIUXQA=$ORDER(TIUXQA(TIUXQA))
if 'TIUXQA
QUIT
SET XQA(TIUXQA)=""
+1 ; if from nightly task, do not send addendum added alert
IF ADDENDUM
IF 'TIUAAALRT
DO SENDADD(DA)
+2 ; quit, no recipients or additional signers
if '$DATA(XQA)&'$ORDER(^TIU(8925.7,"B",DA,0))
QUIT
+3 ; get patient demographics
NEW D0,PT,XQALERR
DO PATVADPT^TIULV(.PT,$PIECE(NODE(0),U,2))
+4 ; if recipients, setup alert data and send alert
+5 ; send , if third party alert quit
IF $DATA(XQA)
DO XQADATA(DA,.PT)
DO SETUP^XQALERT
if +$GET(TIUXQA)
QUIT
KILL XQA
+6 ; for a signed document, check for additional signers
IF $PIECE(NODE(0),U,5)>5
IF $ORDER(^TIU(8925.7,"B",DA,0))
Begin DoDot:1
+7 ; traverse "AC" for outstanding additional signers
NEW I
SET I=0
FOR
SET I=$ORDER(^TIU(8925.7,"AC",+NODE(12),DA,I))
if 'I
QUIT
Begin DoDot:2
+8 ; remove "AC" if no entry
IF '$DATA(^TIU(8925.7,I,0))
KILL ^TIU(8925.7,"AC",+NODE(12),DA,I)
QUIT
+9 ; remove "AC" if signed
IF +$PIECE($GET(^TIU(8925.7,I,0)),U,4)
KILL ^TIU(8925.7,"AC",+NODE(12),DA,I)
QUIT
+10 ; set additional signer
NEW USR
SET USR=$PIECE($GET(^TIU(8925.7,I,0)),U,3)
if +USR
SET XQA(USR)=""
End DoDot:2
End DoDot:1
+11 ; quit, no outstanding additional signers
if '$DATA(XQA)
QUIT
+12 ; send additional signer alert(s)
DO XQADATA(DA,.PT,1)
DO SETUP^XQALERT
+13 QUIT
XQADATA(DA,PT,AS) ; setup message text
+1 ; DA document IEN PT patient demographics [passed by reference]
+2 ; AS additional signer [default 0]
+3 SET XQAARCH=24000
SET XQADATA=+DA_U
SET XQADFN=$PIECE(NODE(0),U,2)
SET XQAID="TIU"_DA
SET XQAROU="ACT^TIUALRT"
+4 SET XQAMSG=PT("PNM")_" ("_$EXTRACT(PT("PNM"),1)_$PIECE(PT("SSN"),"-",3)_"): "
+5 SET XQAMSG=XQAMSG_$SELECT(TIU("Status")=5&TIU("Expected Co-signer")&$PIECE(TIUDPRM(0),U,20):"UNSIGNED/UNCOSIGNED",1:$$UP^XLFSTR($$GET1^DIQ(8925,DA,.05)))
+6 SET XQAMSG=XQAMSG_$SELECT($PIECE(NODE(0),U,9)="P":" STAT ",1:" ")_$$PNAME^TIULC1(+NODE(0))
+7 SET XQAMSG=XQAMSG_$SELECT(OVERDUE:" Dated "_$$DATE^TIULS(+NODE(13))_" OVERDUE for ",1:" available for ")
+8 SET XQAMSG=XQAMSG_$SELECT(TIU("Status")'>5:"SIGNATURE",TIU("Status")=6&('$GET(AS)):"COSIGNATURE",1:"ADDITIONAL SIGNATURE")
+9 QUIT
ACT ; Act on alerts
+1 NEW TIUQUIK,TIUDA,TIUPRM0,TIUPRM1,TIUPRM3,RSTOK
SET TIUQUIK=1
KILL XQAKILL
+2 ; *353 agp
IF $$ONEHR^ORACCESS
Begin DoDot:1
+3 WRITE !,"Site has migrated to Electronic Health Record."
+4 WRITE !,"TIU List Manager access not allowed."
+5 IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:1
QUIT
+6 SET TIUDA=$PIECE(XQADATA,U)
+7 IF '$DATA(^TIU(8925,+TIUDA,0))
DO ALERTDEL(TIUDA)
QUIT
+8 SET RSTOK=$$DOCCHK^TIULRR(TIUDA)
+9 IF RSTOK'>0
Begin DoDot:1
+10 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+11 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:1
QUIT
+12 ; *357
IF $PIECE(^TIU(8925,+TIUDA,0),U,5)>6
IF '+$$ISSIGNR(TIUDA,DUZ)
SET XQAKILL=1
+13 if '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+14 DO EN^VALM("TIU BROWSE FOR CLINICIAN")
+15 QUIT
ISSIGNR(DA,USER) ; *357, is user an additional signer (or surrogate for) and is signature outstanding?
+1 NEW TIUAS,TIUY
SET (TIUAS,TIUY)=0
+2 FOR
SET TIUAS=$ORDER(^TIU(8925.7,"AE",DA,TIUAS))
if 'TIUAS!(+TIUY)
QUIT
IF USER=TIUAS!(USER=$$ACTVSURO^XQALSURO(TIUAS))
Begin DoDot:1
+3 NEW NODE0
SET NODE0=$GET(^TIU(8925.7,+$ORDER(^TIU(8925.7,"AE",DA,TIUAS,0)),0))
+4 IF +$LENGTH(NODE0)
IF +$PIECE(NODE0,U,4)'>0
SET TIUY=1
End DoDot:1
+5 ; resend alert(s) for a document
IF 'TIUY
DO TASKALRT(DA)
+6 QUIT TIUY
TASKALRT(DA) ; resend alert(s) for a document via a delayed task *357
+1 NEW TIUADDL,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
SET TIUADDL=1
SET ZTDESC="SEND^TIUALRT("_DA_")"
SET ZTDTH=+$HOROLOG_","_($PIECE($HOROLOG,",",2)+10)
+2 SET ZTIO=""
SET ZTSAVE("TIUADDL")=""
SET ZTSAVE("DA")=""
SET ZTRTN="SEND^TIUALRT(DA)"
DO ^%ZTLOAD
+3 QUIT
SENDTRAN(DA) ; Generate "Send back to transcription" alert
+1 NEW TIUEDT,TIU0,TIUPNM,TIUSSN,TIUTRAN,TIU,XQA,XQAMSG,TIUMSG
+2 NEW TIUESNR,TIU12,TIU13,TIU14,TIU15,TIUTYP
+3 ;259
NEW XQAID
+4 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+5 DO ALERTDEL(DA)
+6 ; Don't send if notifications not enabled
+7 IF '+$PIECE(TIUPRM1,U,7)
QUIT
+8 SET TIU0=$GET(^TIU(8925,+DA,0))
SET TIU12=$GET(^(12))
SET TIU13=$GET(^(13))
+9 SET TIU14=$GET(^TIU(8925,+DA,14))
SET TIU15=$GET(^(15))
+10 SET TIUPNM=$EXTRACT($PIECE($GET(^DPT(+$PIECE(TIU0,U,2),0)),U),1,9)
+11 SET TIUEDT=$$DATE^TIULS($PIECE(TIU0,U,7))
+12 SET TIUTYP=$$PNAME^TIULC1(+$GET(TIU0))
+13 ; **175**
SET TIUTRAN=$PIECE(TIU13,U,2)
SET TIUESNR=$PIECE(TIU12,U,2)
+14 ;Used to get SSN. Date not important.
DO PATVADPT^TIULV(.TIU,+$PIECE(TIU0,U,2))
+15 SET TIUSSN=$EXTRACT(TIUPNM,1)_$PIECE($GET(TIU("SSN")),"-",3)
+16 ;I $D(^VA(200,+TIUTRAN,0)) S XQA(TIUTRAN)=""
+17 ;ICR #2343 In file 200 & not terminated
IF $$PROVIDER^XUSER(TIUTRAN)
SET XQA(TIUTRAN)=""
+18 if $DATA(XQA)'>9
QUIT
+19 SET TIUMSG=$SELECT(TIUTRAN=TIUESNR:" needs editing",1:" needs retranscription.")
+20 SET XQAID="TIU"_+DA
+21 SET XQAMSG=TIUPNM_" ("_TIUSSN_"): "_TIUTYP_TIUMSG
+22 DO SETUP^XQALERT
+23 QUIT
SENDADD(DA) ; Generates "Addendum added" alert
+1 NEW TIU12,TIU13,TIU14,TIU15,TIU0,TIUPNM,TIUSSN,TIUTRAN,TIU,TIUTITLE,TIUDPRM
+2 NEW XQA,XQAMSG,XQAFLG,XQADATA,XQAROU,TIUESNR,TIUDATE,TIUESNM,TIUO0,TIUO12,TIUO13
+3 ;P259
NEW XQAID,TIUECSNR
+4 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+5 DO ADDENDEL(DA)
+6 ; Don't send if notifications not enabled
+7 IF '+$PIECE(TIUPRM1,U,7)
QUIT
+8 SET TIU0=$GET(^TIU(8925,+DA,0))
+9 ; Only send upon completion
+10 if +$PIECE(TIU0,U,5)'>6
QUIT
+11 DO DOCPRM^TIULC1(+TIU0,.TIUDPRM,DA)
if '+$PIECE(TIUDPRM(0),U,17)
QUIT
+12 SET TIU12=$GET(^TIU(8925,+DA,12))
SET TIU13=$GET(^(13))
SET TIU14=$GET(^(14))
SET TIU15=$GET(^(15))
+13 SET TIUO0=$GET(^TIU(8925,$PIECE(TIU0,U,6),0))
SET TIUO12=$GET(^(12))
SET TIUO13=$GET(^(13))
+14 SET TIUPNM=$EXTRACT($$PTNAME^TIULC1(+$PIECE(TIU0,U,2)),1,9)
+15 SET TIUESNM=$$NAME^TIULS($$PERSNAME^TIULC1(+$PIECE(TIU12,U,2)),"LAST,FI MI")
+16 SET TIUTITLE=$EXTRACT($$PNAME^TIULC1(+TIUO0),1,20)
+17 SET TIUDATE=$SELECT(+$PIECE(TIUO13,U):$PIECE(TIUO13,U),1:$GET(DT))
+18 SET TIUDATE=$$DATE^TIULS(TIUDATE)
+19 ;Used to get SSN. Date not important.
DO PATVADPT^TIULV(.TIU,+$PIECE(TIU0,U,2))
+20 SET TIUSSN=$EXTRACT(TIUPNM,1)_$PIECE($GET(TIU("SSN")),"-",3)
+21 SET TIUTRAN=$PIECE(TIU13,U,2)
+22 ;Expected Cosigner and Author of original document
+23 SET TIUECSNR=$PIECE($GET(^TIU(8925,$PIECE(TIU0,U,6),12)),U,8)
SET TIUESNR=$PIECE($GET(^(12)),U,4)
+24 ; Not entered by Expected Signer: SET Expected Signer as recipient
+25 IF TIUESNR'=TIUTRAN
IF $DATA(^VA(200,+TIUESNR,0))
SET XQA(TIUESNR)=""
+26 ; Not entered by Expected Cosigner: SET Expected Cosigner as recipient
+27 ; VMP/RJT - *227 - If user is the expected cosigner, do not send alert
+28 IF +TIUECSNR>0
IF (TIUECSNR'=DUZ)
IF (TIUECSNR'=TIUTRAN)
IF $DATA(^VA(200,+TIUECSNR,0))
SET XQA(TIUECSNR)=""
+29 if $DATA(XQA)'>9
QUIT
+30 SET XQAID="TIUADD"_+DA
SET XQADATA=+DA_U
SET XQAROU="ACTADD^TIUALRT"
+31 SET XQAMSG=TIUPNM_" ("_TIUSSN_"): ADDENDUM to "_TIUTITLE_" of "_TIUDATE_" by "_TIUESNM
+32 DO SETUP^XQALERT
+33 QUIT
ACTADD ; Act on ADDENDUM alerts
+1 NEW TIUQUIK,TIUDA,TIUPRM0,TIUPRM1,TIUPRM3
SET TIUQUIK=1
KILL XQAKILL
+2 SET TIUDA=$PIECE(XQADATA,U)
SET XQAKILL=1
+3 IF '$DATA(^TIU(8925,+TIUDA,0))
DO ADDENDEL(TIUDA)
QUIT
+4 WRITE !!,"A NEW Addendum has been added to your document...",!
+5 if $LENGTH($PIECE($GET(XQX),U,3))
WRITE !,$PIECE($GET(XQX),U,3),!
+6 IF '+$$READ^TIUU("YAO","Do you wish to Browse the Addendum now? ","NO")
QUIT
+7 if '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+8 DO EN^VALM("TIU BROWSE FOR CLINICIAN")
+9 QUIT
ALERTDEL(DA) ; Delete alerts associated with a given document
+1 NEW XQA,XQAID,XQAKILL
SET XQAID="TIU"_DA
+2 DO DELETEA^XQALERT
+3 QUIT
ADDENDEL(DA) ; Delete alert associated with a Addendum added
+1 NEW XQA,XQAID,XQAKILL
SET XQAID="TIUADD"_DA
+2 DO DELETEA^XQALERT
+3 QUIT
