TIUPSCA ;BPOIFO/EL/CR - TIU DOCUMENT POST SIGNATURE ALERTS ;12/18/17 3:59pm
;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
;
; External Reference DBIA#:
; -------------------------
; #1252 - Reference to OUTPTPR^SDUTL3 (Supported)
; #2056 - Reference to GET1^DIQ (supported)
; #2263 - Reference to GET^XPAR (Supported)
; #6811 - Reference to file #100.21 (Private)
; #10035 - Reference to file #2 (Supported)
; #10061 - Reference to KVA^VADPT (Supported)
; #10103 - Reference to FMTE^XLFDT (Supported)
; #10103 - Reference to NOW^XLFDT (Supported)
; #10081 - Reference to SETUP1^XQALERT (Supported)
;
; This routine expects the following variables to be defined in the
; local symbol table:
; TIUTTL - IEN of the just-signed TIU DOCUMENT DEFINITION
; as found in file #8925.1
; DA - IEN of the just-signed TIU DOCUMENT as found in file #8925
; DFN - IEN of the PATIENT associated with the just-signed
; TIU DOCUMENT as found in file #2
; TIUXQA - TIUXQA in TIUPSCS (mail group recipient)
; TIUSPEC - TIUSPEC in TIUPSCS (API for alert)
; TIUDEV - TIUDEV in TIUPSCS (DEVICE to send alert to)
;
;
AUTOPRT ; generate note to location based chart copy printer
N TIUTIU,TIUTOFP
S (TIUTIU,TIUTOFP)=""
S TIUTIU=$S($G(TIU12)]"":TIU12,$G(TIUD12)]"":TIUD12,1:"")
Q:'+TIUTIU
; get external name of printer below
S TIUTOFP=$$GET^XPAR($P(TIUTIU,U,5)_";SC(","ORPF CHART COPY PRINT DEVICE",,"E")
;I +TIUTOFP S TIUTOFP=$P(^%ZIS(1,TIUTOFP,0),U)
Q:TIUTOFP']""
D RPC^TIUPD(.TIU,DA,TIUTOFP,2)
Q
;
CLEAN ;
K XQA
Q
;
DEVP ;
W !,TIUMSG
Q
;
EN(TIUXQA,TIUSPEC,TIUDEV) ;
N TIU,TIUDEVG,TIUDFN,TIUFOUR,TIUGO,TIUGRP,TIULOC,TIUMSG
N TIUPTNM,TIUTDEV,TIUTEAM,TIUTIEN,TIUTITL,TIUUSER,VAIN
N TIUPCP,TIUATT,TIUEND,TIULINE,TIULNUM,TIUPLUS
N X,XQADATA,XQAID,XQAMSG,XQAROU
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
S (TIU,TIUDEVG,TIUDFN,TIUEND,TIUFOUR,TIUGO,TIUGRP,TIULOC,TIUMSG)=""
S (TIUPTNM,TIUTDEV,TIUTEAM,TIUTIEN,TIUTITL,TIUUSER,VAIN)=""
S (X,XQADATA,XQAID,XQAMSG,XQAROU)=""
S (ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE)=""
;
S (DFN,TIUDFN)=$$GET1^DIQ(8925,DA,.02,"I") ; don't count on existing DFN
D RECIP
;
S TIUTITL=$$GET1^DIQ(8925.1,TIUTTL,.01)
;
S TIUPTNM=$$GET1^DIQ(2,TIUDFN,.01)
S TIUFOUR=" ("_$E(TIUPTNM)_$E($$GET1^DIQ(2,TIUDFN,.09),6,9)_") "
S TIULOC=$$LOC D KVA^VADPT
S XQAID="TIUADD"_+DA,XQADATA=DA_U
S XQAROU="ACT^TIUALRT"
S TIUGO=1
I $G(TIUSPEC)]"" I $L($T(@TIUSPEC)) D @TIUSPEC
; get the primary care provider for the patient, if assigned
I $G(TIUSPEC)="PCP" D
. S TIUPCP=$P($$OUTPTPR^SDUTL3(DFN,DT,1),U,1) ; get PCP's DUZ
. I TIUPCP S XQA(TIUPCP)=""
;
I '$D(XQA) S XQA(DUZ)="" ; default so that the alert can still be sent
S XQAMSG=TIUPTNM_TIUFOUR_TIULOC_" ("_$$FMTE^XLFDT($$NOW^XLFDT,"2D")
S XQAMSG=XQAMSG_"): "_TIUTITL_$S($G(TIUEND)]"":" "_TIUEND_".",1:" signed.")
I $G(TIUDEV)]"" D
. S TIU=""
. D RPC^TIUPD(.TIU,DA,TIUDEV,2)
S TIUMSG=XQAMSG
I $G(TIUGO)=1 S X=$$SETUP1^XQALERT ; I 'XQALERR W !,"Alert Error: ",XQALERR
I $G(TIUDEVG)=1 S ZTSAVE("TIUMSG")="" D ^%ZTLOAD
D CLEAN
Q
;
GETRTN(TIUARY) ; compile array of SUBROUTINE for TIU Document Definition Code
N I,X
S (I,X)="",(I,TIUARY)=0
F I=1:1 D Q:$G(I)="STOP"
. S X=$P($T(RTNLST+I),";;",2)
. I $G(X)="" S I="STOP" Q
. S TIUARY=I,TIUARY(I)=$E(X,1,70)
Q TIUARY
;
LOC() ; WARD Location: Int^Ext (nn^LOC)
D INP^VADPT
Q $S(VAIN(4)]"":"["_$P(VAIN(4),U,2)_"]",1:"")
;
RECIP ; determine alert recipients
; the patient IEN is kept by TIUDFN, title ien is TIUTTL
I TIUXQA=+TIUXQA S XQA(TIUXQA)="" ; individual user
I TIUXQA["G." S XQA(TIUXQA)="" ; mail group
;
I TIUXQA["T." D ; TEAM LIST
. S TIUTEAM=$P(TIUXQA,".",2),TIUTIEN=$O(^OR(100.21,"B",TIUTEAM,0)) Q:'+TIUTIEN
. ; ** EL **
. S TIUUSER=0
. F S TIUUSER=$O(^OR(100.21,TIUTIEN,1,TIUUSER)) Q:'+TIUUSER D ;OE/RR team members
.. S XQA(TIUUSER)=""
. ; ** EL **
. S TIUTDEV=$$GET1^DIQ(100.21,TIUTIEN,1.5,"I") I +TIUTDEV D ; OE/RR team device
.. S ZTIO="`"_TIUTDEV,ZTDTH=$$NOW^XLFDT
.. S ZTDESC="TIU Document Post-Signature Alert",ZTRTN="DEVP^TIUPSCA"
.. S TIUDEVG=1
Q
;
RTNLST ; SUBROUTINE listing as ";;API-Description (upto 70 chars)"
;;N/A-No Conditional Alert is needed
;;PCP-Include patient's Primary Care Provider from PCMM as a recipient
;;AUTOPRT-Generate message to chart copy printer at encounter location
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPSCA 4476 printed Nov 22, 2024@17:54:26 Page 2
TIUPSCA ;BPOIFO/EL/CR - TIU DOCUMENT POST SIGNATURE ALERTS ;12/18/17 3:59pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
+2 ;
+3 ; External Reference DBIA#:
+4 ; -------------------------
+5 ; #1252 - Reference to OUTPTPR^SDUTL3 (Supported)
+6 ; #2056 - Reference to GET1^DIQ (supported)
+7 ; #2263 - Reference to GET^XPAR (Supported)
+8 ; #6811 - Reference to file #100.21 (Private)
+9 ; #10035 - Reference to file #2 (Supported)
+10 ; #10061 - Reference to KVA^VADPT (Supported)
+11 ; #10103 - Reference to FMTE^XLFDT (Supported)
+12 ; #10103 - Reference to NOW^XLFDT (Supported)
+13 ; #10081 - Reference to SETUP1^XQALERT (Supported)
+14 ;
+15 ; This routine expects the following variables to be defined in the
+16 ; local symbol table:
+17 ; TIUTTL - IEN of the just-signed TIU DOCUMENT DEFINITION
+18 ; as found in file #8925.1
+19 ; DA - IEN of the just-signed TIU DOCUMENT as found in file #8925
+20 ; DFN - IEN of the PATIENT associated with the just-signed
+21 ; TIU DOCUMENT as found in file #2
+22 ; TIUXQA - TIUXQA in TIUPSCS (mail group recipient)
+23 ; TIUSPEC - TIUSPEC in TIUPSCS (API for alert)
+24 ; TIUDEV - TIUDEV in TIUPSCS (DEVICE to send alert to)
+25 ;
+26 ;
AUTOPRT ; generate note to location based chart copy printer
+1 NEW TIUTIU,TIUTOFP
+2 SET (TIUTIU,TIUTOFP)=""
+3 SET TIUTIU=$SELECT($GET(TIU12)]"":TIU12,$GET(TIUD12)]"":TIUD12,1:"")
+4 if '+TIUTIU
QUIT
+5 ; get external name of printer below
+6 SET TIUTOFP=$$GET^XPAR($PIECE(TIUTIU,U,5)_";SC(","ORPF CHART COPY PRINT DEVICE",,"E")
+7 ;I +TIUTOFP S TIUTOFP=$P(^%ZIS(1,TIUTOFP,0),U)
+8 if TIUTOFP']""
QUIT
+9 DO RPC^TIUPD(.TIU,DA,TIUTOFP,2)
+10 QUIT
+11 ;
CLEAN ;
+1 KILL XQA
+2 QUIT
+3 ;
DEVP ;
+1 WRITE !,TIUMSG
+2 QUIT
+3 ;
EN(TIUXQA,TIUSPEC,TIUDEV) ;
+1 NEW TIU,TIUDEVG,TIUDFN,TIUFOUR,TIUGO,TIUGRP,TIULOC,TIUMSG
+2 NEW TIUPTNM,TIUTDEV,TIUTEAM,TIUTIEN,TIUTITL,TIUUSER,VAIN
+3 NEW TIUPCP,TIUATT,TIUEND,TIULINE,TIULNUM,TIUPLUS
+4 NEW X,XQADATA,XQAID,XQAMSG,XQAROU
+5 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+6 SET (TIU,TIUDEVG,TIUDFN,TIUEND,TIUFOUR,TIUGO,TIUGRP,TIULOC,TIUMSG)=""
+7 SET (TIUPTNM,TIUTDEV,TIUTEAM,TIUTIEN,TIUTITL,TIUUSER,VAIN)=""
+8 SET (X,XQADATA,XQAID,XQAMSG,XQAROU)=""
+9 SET (ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE)=""
+10 ;
+11 ; don't count on existing DFN
SET (DFN,TIUDFN)=$$GET1^DIQ(8925,DA,.02,"I")
+12 DO RECIP
+13 ;
+14 SET TIUTITL=$$GET1^DIQ(8925.1,TIUTTL,.01)
+15 ;
+16 SET TIUPTNM=$$GET1^DIQ(2,TIUDFN,.01)
+17 SET TIUFOUR=" ("_$EXTRACT(TIUPTNM)_$EXTRACT($$GET1^DIQ(2,TIUDFN,.09),6,9)_") "
+18 SET TIULOC=$$LOC
DO KVA^VADPT
+19 SET XQAID="TIUADD"_+DA
SET XQADATA=DA_U
+20 SET XQAROU="ACT^TIUALRT"
+21 SET TIUGO=1
+22 IF $GET(TIUSPEC)]""
IF $LENGTH($TEXT(@TIUSPEC))
DO @TIUSPEC
+23 ; get the primary care provider for the patient, if assigned
+24 IF $GET(TIUSPEC)="PCP"
Begin DoDot:1
+25 ; get PCP's DUZ
SET TIUPCP=$PIECE($$OUTPTPR^SDUTL3(DFN,DT,1),U,1)
+26 IF TIUPCP
SET XQA(TIUPCP)=""
End DoDot:1
+27 ;
+28 ; default so that the alert can still be sent
IF '$DATA(XQA)
SET XQA(DUZ)=""
+29 SET XQAMSG=TIUPTNM_TIUFOUR_TIULOC_" ("_$$FMTE^XLFDT($$NOW^XLFDT,"2D")
+30 SET XQAMSG=XQAMSG_"): "_TIUTITL_$SELECT($GET(TIUEND)]"":" "_TIUEND_".",1:" signed.")
+31 IF $GET(TIUDEV)]""
Begin DoDot:1
+32 SET TIU=""
+33 DO RPC^TIUPD(.TIU,DA,TIUDEV,2)
End DoDot:1
+34 SET TIUMSG=XQAMSG
+35 ; I 'XQALERR W !,"Alert Error: ",XQALERR
IF $GET(TIUGO)=1
SET X=$$SETUP1^XQALERT
+36 IF $GET(TIUDEVG)=1
SET ZTSAVE("TIUMSG")=""
DO ^%ZTLOAD
+37 DO CLEAN
+38 QUIT
+39 ;
GETRTN(TIUARY) ; compile array of SUBROUTINE for TIU Document Definition Code
+1 NEW I,X
+2 SET (I,X)=""
SET (I,TIUARY)=0
+3 FOR I=1:1
Begin DoDot:1
+4 SET X=$PIECE($TEXT(RTNLST+I),";;",2)
+5 IF $GET(X)=""
SET I="STOP"
QUIT
+6 SET TIUARY=I
SET TIUARY(I)=$EXTRACT(X,1,70)
End DoDot:1
if $GET(I)="STOP"
QUIT
+7 QUIT TIUARY
+8 ;
LOC() ; WARD Location: Int^Ext (nn^LOC)
+1 DO INP^VADPT
+2 QUIT $SELECT(VAIN(4)]"":"["_$PIECE(VAIN(4),U,2)_"]",1:"")
+3 ;
RECIP ; determine alert recipients
+1 ; the patient IEN is kept by TIUDFN, title ien is TIUTTL
+2 ; individual user
IF TIUXQA=+TIUXQA
SET XQA(TIUXQA)=""
+3 ; mail group
IF TIUXQA["G."
SET XQA(TIUXQA)=""
+4 ;
+5 ; TEAM LIST
IF TIUXQA["T."
Begin DoDot:1
+6 SET TIUTEAM=$PIECE(TIUXQA,".",2)
SET TIUTIEN=$ORDER(^OR(100.21,"B",TIUTEAM,0))
if '+TIUTIEN
QUIT
+7 ; ** EL **
+8 SET TIUUSER=0
+9 ;OE/RR team members
FOR
SET TIUUSER=$ORDER(^OR(100.21,TIUTIEN,1,TIUUSER))
if '+TIUUSER
QUIT
Begin DoDot:2
+10 SET XQA(TIUUSER)=""
End DoDot:2
+11 ; ** EL **
+12 ; OE/RR team device
SET TIUTDEV=$$GET1^DIQ(100.21,TIUTIEN,1.5,"I")
IF +TIUTDEV
Begin DoDot:2
+13 SET ZTIO="`"_TIUTDEV
SET ZTDTH=$$NOW^XLFDT
+14 SET ZTDESC="TIU Document Post-Signature Alert"
SET ZTRTN="DEVP^TIUPSCA"
+15 SET TIUDEVG=1
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
RTNLST ; SUBROUTINE listing as ";;API-Description (upto 70 chars)"
+1 ;;N/A-No Conditional Alert is needed
+2 ;;PCP-Include patient's Primary Care Provider from PCMM as a recipient
+3 ;;AUTOPRT-Generate message to chart copy printer at encounter location
+4 ;
+5 QUIT
