TIUAL1 ;SLC/AJB - TIU Alerts List Manager ;06-Jan-2012 16:50;MGH
;;1.0;TEXT INTEGRATION UTILITIES;**158,199,1010**;Jun 20, 1997;Build 24
;IHS/ITSC/LJF 08/20/2003 changed SSN to HRCN
; fixed code to prevent SUBSCRIPT error
;
Q
CHNGSRCH ; allows user to change search parameters
D FULL^VALM1
W @IOF
D SETUP^TIUALSET
I $D(TIU("QUIT")) K TIU("QUIT") S VALMBCK="R" Q
K ^TMP("TIUDA",$J),^TMP("TIUDOC",$J) D CLEAN^VALM10,INIT,HDR S VALMBG=1
Q
EDIT ;
N D,DIV,TIUDA,TIUCHNG,TIUDCSNR,TIUDIV1,TIUESNR,TIUNODE
N TIUFPRIV,TIUPREF,TIUPRM0,TIUPRM1,TIURQCS,TIUS,TIUSEL,X,Y
D FULL^VALM1
I TIU("CNT")=0 W !,"No documents to select." H 3 Q
S TIUSEL=$P(XQORNOD(0),"=",2)
I TIUSEL="" D Q:TIUSEL=U!($D(DIRUT))
. N DIR,X,Y
. S DIR("A")="Select Document: (1-"_VALMLST_") "
. S DIR(0)="NA^1:"_VALMLST
. D ^DIR S TIUSEL=Y
I $A($E(TIUSEL,$L(TIUSEL)))<48!($A($E(TIUSEL,$L(TIUSEL)))>57) S TIUSEL=$E(TIUSEL,1,$L(TIUSEL)-1)
F X=1:1 Q:$P(TIUSEL,",",X)="" S TIUC($P(TIUSEL,",",X))=$O(@VALMAR@("IDX",$P(TIUSEL,",",X),""))
S TIUDA=TIUC(TIUSEL)
D EDIT1^TIURA
D UPDATE^TIUALSET
Q
EN ; main entry point for TIU ALERTS
N %DT,D0,POP,TIU,TIUC,TIUTMP,X,Y
K ^TMP("TIUDA",$J),^TMP("TIUDOC",$J)
D SETUP^TIUALSET Q:$D(TIU("QUIT"))
D EN^VALM("TIU ALERTS")
K ^TMP("TIUDA",$J),^TMP("TIUDOC",$J)
Q
EVAL(TIUDA) ;
N TIUCHK,TIUCNT,TIUY
S TIUCHK="" F S TIUCHK=$O(TIU("S",TIUCHK)) Q:TIUCHK="" I $P(TIUD0,U,5)=+TIU("S",TIUCHK),$P(TIUD13,U)'<TIU("D",1),$P(TIUD13,U)'>TIU("D",2) S TIUY=1
I $G(TIUY),$P(TIUCAT,U)="CA",$P(TIUD12,U,2)=+TIU("P") Q 1
I $G(TIUY),$P(TIUCAT,U)="AE",$D(^TIU(8925.7,"AE",TIUDA,TIU("P"))) Q 1
I $G(TIUY),$P(TIUCAT,U)="CS",$P(TIUCAT,U,2)="Expected Cosigner",$P(TIUD12,U,8)=+TIU("P") Q 1
I $G(TIUY),$P(TIUCAT,U)="CS",$P(TIUCAT,U,2)="Attending Physician",$P(TIUD12,U,9)=+TIU("P") Q 1
I $G(TIUY),$P(TIUCAT,U)="CS",$P(TIUCAT,U,3)="Attending Physician",$P(TIUD12,U,9)=+TIU("P") Q 1
Q +$G(TIUY)
EXIT ; exit code
Q
EXPND ; expand code
Q
FMTDT(DATE) ; formats date
N TMPDATE
S TMPDATE=$$FDATE^VALM1(DATE)
I $P(TMPDATE,"/")="00",$P(TMPDATE,"/",2)="00" Q $$FMTE^XLFDT(DATE,"D")
I $P(TMPDATE,"/",2)="00" S TMPDATE=$E(TMPDATE,1,3)_$E(TMPDATE,7,8)
Q TMPDATE
HDR ; header code
N HDRTITLE,X,Y
S HDRTITLE(1)=$S(TIU("S")=1:$$UPPER^VALM1($P(TIU("S",1),U,3))_" Documents",1:"Clinical Documents")
S HDRTITLE(2)=TIU("CNT")_" "_$S(TIU("CNT")=1:"Document",1:"Documents")
S HDRTITLE(3)="for ("_$E($$GET1^DIQ(200,TIU("P")_",",.01),1,35)_")"_" from "_$$FMTDT(TIU("D",1))_" to "_$$FMTDT(TIU("D",2))
S (X,Y)=""
F S X=$O(TIU("C",X)) Q:X="" S Y=Y_TIU("C",X)
S Y="by "_"("_$$UP^XLFSTR($TR($E(Y,2,67),U,","))_")"
S $P(HDRTITLE(1)," ",IOM-($L(HDRTITLE(1))+$L(HDRTITLE(2))))="",HDRTITLE(1)=HDRTITLE(1)_HDRTITLE(2)
S VALMHDR(1)=HDRTITLE(1)
S VALMHDR(2)=$$SETSTR^VALM1(Y,"",(IOM-$L(Y))/2,$L(Y))
S VALMHDR(3)=$$SETSTR^VALM1(HDRTITLE(3),"",(IOM-$L(HDRTITLE(3)))/2,$L(HDRTITLE(3)))
D XQORM
Q
HELP ; help code
N DIR
I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
D FULL^VALM1
W !!,"The following actions are available:"
W !,"Browse a Document - View a selected document (if authorized)"
W !,"Change View - Modify search criteria"
W !,"Combination Alerts - Send alerts to expected signers and 3rd parties"
W !,"Delete Alerts - Delete a document's alerts"
W !,"Detailed Display - View detailed display of a document (if authorized)"
W !,"Edit a Document - Edit a selected document (if authorized)"
W !,"Identify Signers - Identify/Change Signers of a document (if authorized)"
W !,"Resend Alerts - Resend alerts to expected signers"
W !,"Third Party Alerts - Send alerts to one or more 3rd parties",!
I $D(DIR("A")) D ^DIR
S VALMBCK="R"
Q
INIT ; finds documents and prepares LM display
N CNT,TIUCNT,TIUDA,TIUDOC,TIUDT,TIUTMP
S CNT="",(TIUCNT,TIU("CNT"))=0
S TIU("IOCUOFF")=$C(27)_"[?25l",TIU("IOCUON")=$C(27)_"[?25h"
W TIU("IOCUOFF")
W !,"Searching for the documents."
F S CNT=$O(TIU("C",CNT)) Q:CNT="" D INIT2(CNT_TIU("C",CNT))
S TIUTMP=0,(CNT,TIUDA,TIUDT)=""
F S TIUDT=$O(^TMP("TIUDOC",$J,TIUDT)) Q:TIUDT="" F S CNT=$O(^TMP("TIUDOC",$J,TIUDT,CNT)) Q:CNT="" F S TIUDA=$O(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA)) Q:TIUDA="" D
. N TIUDISP,TIUNODE
. S TIUTMP=TIUTMP+1
. W:TIUTMP#3=0 "."
. S TIUDISP("PATIENT")=$P($P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,2),",")_","_$E($P($P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,2),",",2),1)
. ;S TIUDISP("L4")="("_$E(TIUDISP("PATIENT"))_$E($P($G(^DPT(+$P(^TIU(8925,TIUDA,0),U,2),0)),U,9),6,9)_")" ;IHS/ITSC/LJF 08/20/2003
. S TIUDISP("L4")=$$HRCN^BTIUPCC(+$$IPAT^BTIUU1(TIUDA),DUZ(2)) ;IHS/ITSC/LJF 08/20/2003 HRCN FOR SSN
. S TIUNODE=^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA)
. S TIUDISP("TITLE")=$E($S(+TIUNODE>0:"_ "_$P(TIUNODE,U,3),$P(TIUNODE,U)="A":" |_"_$P(TIUNODE,U,3),1:$P(TIUNODE,U,3)),1,36)
. S TIUDISP("REFDT")=$$FMTDT($P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,4))
. S TIUDISP("S")=$P(^TMP("TIUDOC",$J,TIUDT,CNT,TIUDA),U,5)
. S TIUDISP("A/D")=$$GET1^DIQ(8925,TIUDA,1202)
. S TIUDISP("EC")=$$GET1^DIQ(8925,TIUDA,1208)
. S TIUDISP("ATT")=$$GET1^DIQ(8925,TIUDA,1209)
. ;S TIUDISP("ADS")=$$GET1^DIQ(8925.7,$P(TIUNODE,U,6),.03) ;IHS/ITSC/LJF 08/20/2003
. S TIUDISP("ADS")=$$GET1^DIQ(8925.7,+$P(TIUNODE,U,6),.03) ;IHS/ITSC/LJF 08/20/2003 prevent subscript error
. S TIUDISP=$$SETSTR^VALM1(TIUTMP,"",1,5)
. S TIUDISP=$$SETSTR^VALM1(TIUDISP("PATIENT"),TIUDISP,6,26)
. S TIUDISP=$$SETSTR^VALM1(TIUDISP("L4"),TIUDISP,20,26)
. S TIUDISP=$$SETSTR^VALM1($E(TIUDISP("TITLE"),1,30),TIUDISP,28,58)
. S TIUDISP=$$SETSTR^VALM1(TIUDISP("REFDT"),TIUDISP,60,68)
. S TIUDISP=$$SETSTR^VALM1($$LOW^XLFSTR(TIUDISP("S")),TIUDISP,70,80)
. S TIUDISP=$$SETSTR^VALM1(TIUTMP,TIUDISP,81,86)
. S TIUDISP=$$SETSTR^VALM1($E(TIUDISP("A/D"),1,17),TIUDISP,88,105)
. S TIUDISP=$$SETSTR^VALM1($E($G(TIUDISP("EC")),1,17),TIUDISP,107,124)
. S TIUDISP=$$SETSTR^VALM1($E($G(TIUDISP("ATT")),1,17),TIUDISP,126,143)
. S TIUDISP=$$SETSTR^VALM1($E($G(TIUDISP("ADS")),1,15),TIUDISP,145,160)
. D SET^VALM10(TIUTMP,$E(TIUDISP,1,160),TIUDA)
S VALMCNT=TIUTMP
I VALMCNT=0 S VALMCNT=1 D
. D SET^VALM10(1," ",0)
. S TIUDOC="No records found to satisfy search criteria."
. S TIUDOC=$$SETSTR^VALM1(TIUDOC,"",(IOM-$L(TIUDOC))/2,$L(TIUDOC))
. D SET^VALM10(2,TIUDOC,0)
W TIU("IOCUON")
Q
INIT2(TIUCAT) ;
S TIUDA=""
I $P(TIUCAT,U)'="AE" F S TIUDA=$O(^TIU(8925,$P(TIUCAT,U),TIU("P"),TIUDA)) Q:TIUDA="" D
. N TIUD0,TIUD12,TIUD13
. S TIUD0=$G(^TIU(8925,TIUDA,0))
. S TIUD12=$G(^TIU(8925,TIUDA,12))
. S TIUD13=$G(^TIU(8925,TIUDA,13))
. I TIUD0=""!(TIUD12="")!(TIUD13="") Q
. I $$EVAL(TIUDA) S ^TMP("TIUDA",$J,TIUDA)="",TIU("CNT")=TIU("CNT")+1
I $P(TIUCAT,U)="AE" F S TIUDA=$O(^TIU(8925.7,"AE",TIUDA)) Q:TIUDA="" I $D(^TIU(8925.7,"AE",TIUDA,TIU("P"))) D
. S TIU("AS")="",TIU("AS")=$O(^TIU(8925.7,"AE",TIUDA,TIU("P"),TIU("AS")))
. I $P($G(^TIU(8925.7,TIU("AS"),0)),U,4),$P($G(^TIU(8925.7,TIU("AS"),0)),U,5)=TIU("P") Q
. I TIU("AS")'="",$P($G(^TIU(8925.7,TIU("AS"),0)),"^",9)=1 Q
. N TIUD0,TIUD12,TIUD13
. S TIUD0=$G(^TIU(8925,TIUDA,0))
. S TIUD12=$G(^TIU(8925,TIUDA,12))
. S TIUD13=$G(^TIU(8925,TIUDA,13))
. I TIUD0=""!(TIUD12="")!(TIUD13="") Q
. I $$EVAL(TIUDA) S ^TMP("TIUDA",$J,TIUDA)=""_U_"AE"_U_$G(TIU("AS")),TIU("CNT")=TIU("CNT")+1
. K TIU("AS")
F S TIUDA=$O(^TMP("TIUDA",$J,TIUDA)) Q:TIUDA="" D
. I +^TMP("TIUDA",$J,TIUDA)=1 Q
. N TIUD0,TIUD12,TIUD13
. S TIUD0=$G(^TIU(8925,TIUDA,0))
. S TIUD12=$G(^TIU(8925,TIUDA,12))
. S TIUD13=$G(^TIU(8925,TIUDA,13))
. I TIUD0=""!(TIUD12="")!(TIUD13="") Q
. W:TIUCNT#3=0 "."
. I +$$HASKIDS^TIUSRVLI(TIUDA),$P(^TMP("TIUDA",$J,TIUDA),U,2)'="AE" D Q
. . N TMPCNT
. . S TIUCNT=TIUCNT+1,TMPCNT=TIUCNT
. . S ^TMP("TIUDA",$J,TIUDA)=1
. . N CHILD,I,SEQUENCE,TIUI
. . S CHILD="CHILD",(SEQUENCE,TIUI)=""
. . D SETKIDS^TIUSRVLI(.CHILD,TIUDA,.TIUI) I $G(TIUI)="" Q
. . F I=1:1:TIUI I $D(^TMP("TIUDA",$J,+CHILD(I))),'+$G(^TMP("TIUDA",$J,+CHILD(I))) D
. . . N TIUREFDT
. . . S TIUCNT=TIUCNT+1
. . . S ^TMP("TIUDA",$J,+CHILD(I))=1
. . . S TIUREFDT=+^TIU(8925,+CHILD(I),13)
. . . I $$GET1^DIQ(8925,+CHILD(I),.01)'["Addendum" S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,+CHILD(I))="A"_U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,+CHILD(I),.01)_U_TIUREFDT_U_$$GET1^DIQ(8925,+CHILD(I),.05)
. . . E S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,+CHILD(I))="A"_U_$$GET1^DIQ(8925,TIUDA,.02)_U_"Addendum to "_$$GET1^DIQ(8925,TIUDA,.01)_U_TIUREFDT_U_$$GET1^DIQ(8925,+CHILD(I),.05)
. . S ^TMP("TIUDOC",$J,+TIUD13,TMPCNT,TIUDA)=(TIUCNT-TMPCNT)_U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_+TIUD13_U_$$GET1^DIQ(8925,TIUDA,.05)
. I $P(^TMP("TIUDA",$J,TIUDA),U,2)="AE"!(+$$HASDAD^TIUSRVLI(TIUDA)) D Q
. . N TIUAS
. . S TIUCNT=TIUCNT+1
. . S $P(^TMP("TIUDA",$J,TIUDA),U)=1
. . S TIUAS=$P(^TMP("TIUDA",$J,TIUDA),U,3)
. . I $$GET1^DIQ(8925,TIUDA,.01)'["Addendum" S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_+TIUD13_U_$$GET1^DIQ(8925,TIUDA,.05)_U_TIUAS
. . E D
. . . N PARENT,SEQUENCE,TIUI
. . . S PARENT="PARENT",(SEQUENCE,TIUI)=""
. . . D SETDAD^TIUSRVLI(.PARENT,TIUDA,.TIUI) I $G(TIUI)="" Q
. . . S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_"Addendum to "_$$GET1^DIQ(8925,+PARENT(TIUI),.01)_U_$P(TIUD13,U)_U_$$GET1^DIQ(8925,TIUDA,.05)_U_TIUAS
. I '+$$HASKIDS^TIUSRVLI(TIUDA),'+$$HASDAD^TIUSRVLI(TIUDA) D Q
. . S TIUCNT=TIUCNT+1
. . S ^TMP("TIUDA",$J,TIUDA)=1
. . S ^TMP("TIUDOC",$J,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_$P(TIUD13,U)_U_$$GET1^DIQ(8925,TIUDA,.05)
Q
LSEXIT ; exit code
D XQORM
Q
SELSTAT(Y,PARM,DEF,MENU) ; Select Signature status
N I,XQORM,X,TIUY
S XQORM=+$O(^ORD(101,"B",MENU,0))_";ORD(101,"
I +XQORM'>0 W !,"Status selection unavailable." S TIUY=-1 G STATX
S XQORM(0)=$G(PARM),XQORM("A")=$S(MENU="TIU STATUS MENU":"Select DOCUMENT STATUS: ",1:"Select SEARCH CATEGORY: ")
I $S(PARM="F":1,PARM="R":1,1:0) S X=DEF
S XQORM("B")=DEF D EN^XQORM
S TIUY=$G(Y)
I MENU="TIU STATUS MENU",+$G(Y)=1,(+$G(Y(1))=7) S Y=2,Y(2)="8^4843^amended^8"
STATX Q TIUY
XQORM ;
S XQORM("#")=$O(^ORD(101,"B","TIU ALERTS SELECT",0))_U_"1:"_VALMCNT
Q
TIUAL1 ;SLC/AJB - TIU Alerts List Manager ;06-Jan-2012 16:50;MGH
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**158,199,1010**;Jun 20, 1997;Build 24
+2 ;IHS/ITSC/LJF 08/20/2003 changed SSN to HRCN
+3 ; fixed code to prevent SUBSCRIPT error
+4 ;
+5 QUIT
CHNGSRCH ; allows user to change search parameters
+1 DO FULL^VALM1
+2 WRITE @IOF
+3 DO SETUP^TIUALSET
+4 IF $DATA(TIU("QUIT"))
KILL TIU("QUIT")
SET VALMBCK="R"
QUIT
+5 KILL ^TMP("TIUDA",$JOB),^TMP("TIUDOC",$JOB)
DO CLEAN^VALM10
DO INIT
DO HDR
SET VALMBG=1
+6 QUIT
EDIT ;
+1 NEW D,DIV,TIUDA,TIUCHNG,TIUDCSNR,TIUDIV1,TIUESNR,TIUNODE
+2 NEW TIUFPRIV,TIUPREF,TIUPRM0,TIUPRM1,TIURQCS,TIUS,TIUSEL,X,Y
+3 DO FULL^VALM1
+4 IF TIU("CNT")=0
WRITE !,"No documents to select."
HANG 3
QUIT
+5 SET TIUSEL=$PIECE(XQORNOD(0),"=",2)
+6 IF TIUSEL=""
Begin DoDot:1
+7 NEW DIR,X,Y
+8 SET DIR("A")="Select Document: (1-"_VALMLST_") "
+9 SET DIR(0)="NA^1:"_VALMLST
+10 DO ^DIR
SET TIUSEL=Y
End DoDot:1
IF TIUSEL=U!($DATA(DIRUT))
QUIT
+11 IF $ASCII($EXTRACT(TIUSEL,$LENGTH(TIUSEL)))<48!($ASCII($EXTRACT(TIUSEL,$LENGTH(TIUSEL)))>57)
SET TIUSEL=$EXTRACT(TIUSEL,1,$LENGTH(TIUSEL)-1)
+12 FOR X=1:1
IF $PIECE(TIUSEL,",",X)=""
QUIT
SET TIUC($PIECE(TIUSEL,",",X))=$ORDER(@VALMAR@("IDX",$PIECE(TIUSEL,",",X),""))
+13 SET TIUDA=TIUC(TIUSEL)
+14 DO EDIT1^TIURA
+15 DO UPDATE^TIUALSET
+16 QUIT
EN ; main entry point for TIU ALERTS
+1 NEW %DT,D0,POP,TIU,TIUC,TIUTMP,X,Y
+2 KILL ^TMP("TIUDA",$JOB),^TMP("TIUDOC",$JOB)
+3 DO SETUP^TIUALSET
IF $DATA(TIU("QUIT"))
QUIT
+4 DO EN^VALM("TIU ALERTS")
+5 KILL ^TMP("TIUDA",$JOB),^TMP("TIUDOC",$JOB)
+6 QUIT
EVAL(TIUDA) ;
+1 NEW TIUCHK,TIUCNT,TIUY
+2 SET TIUCHK=""
FOR
SET TIUCHK=$ORDER(TIU("S",TIUCHK))
IF TIUCHK=""
QUIT
IF $PIECE(TIUD0,U,5)=+TIU("S",TIUCHK)
IF $PIECE(TIUD13,U)'<TIU("D",1)
IF $PIECE(TIUD13,U)'>TIU("D",2)
SET TIUY=1
+3 IF $GET(TIUY)
IF $PIECE(TIUCAT,U)="CA"
IF $PIECE(TIUD12,U,2)=+TIU("P")
QUIT 1
+4 IF $GET(TIUY)
IF $PIECE(TIUCAT,U)="AE"
IF $DATA(^TIU(8925.7,"AE",TIUDA,TIU("P")))
QUIT 1
+5 IF $GET(TIUY)
IF $PIECE(TIUCAT,U)="CS"
IF $PIECE(TIUCAT,U,2)="Expected Cosigner"
IF $PIECE(TIUD12,U,8)=+TIU("P")
QUIT 1
+6 IF $GET(TIUY)
IF $PIECE(TIUCAT,U)="CS"
IF $PIECE(TIUCAT,U,2)="Attending Physician"
IF $PIECE(TIUD12,U,9)=+TIU("P")
QUIT 1
+7 IF $GET(TIUY)
IF $PIECE(TIUCAT,U)="CS"
IF $PIECE(TIUCAT,U,3)="Attending Physician"
IF $PIECE(TIUD12,U,9)=+TIU("P")
QUIT 1
+8 QUIT +$GET(TIUY)
EXIT ; exit code
+1 QUIT
EXPND ; expand code
+1 QUIT
FMTDT(DATE) ; formats date
+1 NEW TMPDATE
+2 SET TMPDATE=$$FDATE^VALM1(DATE)
+3 IF $PIECE(TMPDATE,"/")="00"
IF $PIECE(TMPDATE,"/",2)="00"
QUIT $$FMTE^XLFDT(DATE,"D")
+4 IF $PIECE(TMPDATE,"/",2)="00"
SET TMPDATE=$EXTRACT(TMPDATE,1,3)_$EXTRACT(TMPDATE,7,8)
+5 QUIT TMPDATE
HDR ; header code
+1 NEW HDRTITLE,X,Y
+2 SET HDRTITLE(1)=$SELECT(TIU("S")=1:$$UPPER^VALM1($PIECE(TIU("S",1),U,3))_" Documents",1:"Clinical Documents")
+3 SET HDRTITLE(2)=TIU("CNT")_" "_$SELECT(TIU("CNT")=1:"Document",1:"Documents")
+4 SET HDRTITLE(3)="for ("_$EXTRACT($$GET1^DIQ(200,TIU("P")_",",.01),1,35)_")"_" from "_$$FMTDT(TIU("D",1))_" to "_$$FMTDT(TIU("D",2))
+5 SET (X,Y)=""
+6 FOR
SET X=$ORDER(TIU("C",X))
IF X=""
QUIT
SET Y=Y_TIU("C",X)
+7 SET Y="by "_"("_$$UP^XLFSTR($TRANSLATE($EXTRACT(Y,2,67),U,","))_")"
+8 SET $PIECE(HDRTITLE(1)," ",IOM-($LENGTH(HDRTITLE(1))+$LENGTH(HDRTITLE(2))))=""
SET HDRTITLE(1)=HDRTITLE(1)_HDRTITLE(2)
+9 SET VALMHDR(1)=HDRTITLE(1)
+10 SET VALMHDR(2)=$$SETSTR^VALM1(Y,"",(IOM-$LENGTH(Y))/2,$LENGTH(Y))
+11 SET VALMHDR(3)=$$SETSTR^VALM1(HDRTITLE(3),"",(IOM-$LENGTH(HDRTITLE(3)))/2,$LENGTH(HDRTITLE(3)))
+12 DO XQORM
+13 QUIT
HELP ; help code
+1 NEW DIR
+2 IF X="?"
SET DIR("A")="Enter RETURN to continue or '^' to exit"
SET DIR(0)="E"
+3 DO FULL^VALM1
+4 WRITE !!,"The following actions are available:"
+5 WRITE !,"Browse a Document - View a selected document (if authorized)"
+6 WRITE !,"Change View - Modify search criteria"
+7 WRITE !,"Combination Alerts - Send alerts to expected signers and 3rd parties"
+8 WRITE !,"Delete Alerts - Delete a document's alerts"
+9 WRITE !,"Detailed Display - View detailed display of a document (if authorized)"
+10 WRITE !,"Edit a Document - Edit a selected document (if authorized)"
+11 WRITE !,"Identify Signers - Identify/Change Signers of a document (if authorized)"
+12 WRITE !,"Resend Alerts - Resend alerts to expected signers"
+13 WRITE !,"Third Party Alerts - Send alerts to one or more 3rd parties",!
+14 IF $DATA(DIR("A"))
DO ^DIR
+15 SET VALMBCK="R"
+16 QUIT
INIT ; finds documents and prepares LM display
+1 NEW CNT,TIUCNT,TIUDA,TIUDOC,TIUDT,TIUTMP
+2 SET CNT=""
SET (TIUCNT,TIU("CNT"))=0
+3 SET TIU("IOCUOFF")=$CHAR(27)_"[?25l"
SET TIU("IOCUON")=$CHAR(27)_"[?25h"
+4 WRITE TIU("IOCUOFF")
+5 WRITE !,"Searching for the documents."
+6 FOR
SET CNT=$ORDER(TIU("C",CNT))
IF CNT=""
QUIT
DO INIT2(CNT_TIU("C",CNT))
+7 SET TIUTMP=0
SET (CNT,TIUDA,TIUDT)=""
+8 FOR
SET TIUDT=$ORDER(^TMP("TIUDOC",$JOB,TIUDT))
IF TIUDT=""
QUIT
FOR
SET CNT=$ORDER(^TMP("TIUDOC",$JOB,TIUDT,CNT))
IF CNT=""
QUIT
FOR
SET TIUDA=$ORDER(^TMP("TIUDOC",$JOB,TIUDT,CNT,TIUDA))
IF TIUDA=""
QUIT
Begin DoDot:1
+9 NEW TIUDISP,TIUNODE
+10 SET TIUTMP=TIUTMP+1
+11 IF TIUTMP#3=0
WRITE "."
+12 SET TIUDISP("PATIENT")=$PIECE($PIECE(^TMP("TIUDOC",$JOB,TIUDT,CNT,TIUDA),U,2),",")_","_$EXTRACT($PIECE($PIECE(^TMP("TIUDOC",$JOB,TIUDT,CNT,TIUDA),U,2),",",2),1)
+13 ;S TIUDISP("L4")="("_$E(TIUDISP("PATIENT"))_$E($P($G(^DPT(+$P(^TIU(8925,TIUDA,0),U,2),0)),U,9),6,9)_")" ;IHS/ITSC/LJF 08/20/2003
+14 ;IHS/ITSC/LJF 08/20/2003 HRCN FOR SSN
SET TIUDISP("L4")=$$HRCN^BTIUPCC(+$$IPAT^BTIUU1(TIUDA),DUZ(2))
+15 SET TIUNODE=^TMP("TIUDOC",$JOB,TIUDT,CNT,TIUDA)
+16 SET TIUDISP("TITLE")=$EXTRACT($SELECT(+TIUNODE>0:"_ "_$PIECE(TIUNODE,U,3),$PIECE(TIUNODE,U)="A":" |_"_$PIECE(TIUNODE,U,3),1:$PIECE(TIUNODE,U,3)),1,36)
+17 SET TIUDISP("REFDT")=$$FMTDT($PIECE(^TMP("TIUDOC",$JOB,TIUDT,CNT,TIUDA),U,4))
+18 SET TIUDISP("S")=$PIECE(^TMP("TIUDOC",$JOB,TIUDT,CNT,TIUDA),U,5)
+19 SET TIUDISP("A/D")=$$GET1^DIQ(8925,TIUDA,1202)
+20 SET TIUDISP("EC")=$$GET1^DIQ(8925,TIUDA,1208)
+21 SET TIUDISP("ATT")=$$GET1^DIQ(8925,TIUDA,1209)
+22 ;S TIUDISP("ADS")=$$GET1^DIQ(8925.7,$P(TIUNODE,U,6),.03) ;IHS/ITSC/LJF 08/20/2003
+23 ;IHS/ITSC/LJF 08/20/2003 prevent subscript error
SET TIUDISP("ADS")=$$GET1^DIQ(8925.7,+$PIECE(TIUNODE,U,6),.03)
+24 SET TIUDISP=$$SETSTR^VALM1(TIUTMP,"",1,5)
+25 SET TIUDISP=$$SETSTR^VALM1(TIUDISP("PATIENT"),TIUDISP,6,26)
+26 SET TIUDISP=$$SETSTR^VALM1(TIUDISP("L4"),TIUDISP,20,26)
+27 SET TIUDISP=$$SETSTR^VALM1($EXTRACT(TIUDISP("TITLE"),1,30),TIUDISP,28,58)
+28 SET TIUDISP=$$SETSTR^VALM1(TIUDISP("REFDT"),TIUDISP,60,68)
+29 SET TIUDISP=$$SETSTR^VALM1($$LOW^XLFSTR(TIUDISP("S")),TIUDISP,70,80)
+30 SET TIUDISP=$$SETSTR^VALM1(TIUTMP,TIUDISP,81,86)
+31 SET TIUDISP=$$SETSTR^VALM1($EXTRACT(TIUDISP("A/D"),1,17),TIUDISP,88,105)
+32 SET TIUDISP=$$SETSTR^VALM1($EXTRACT($GET(TIUDISP("EC")),1,17),TIUDISP,107,124)
+33 SET TIUDISP=$$SETSTR^VALM1($EXTRACT($GET(TIUDISP("ATT")),1,17),TIUDISP,126,143)
+34 SET TIUDISP=$$SETSTR^VALM1($EXTRACT($GET(TIUDISP("ADS")),1,15),TIUDISP,145,160)
+35 DO SET^VALM10(TIUTMP,$EXTRACT(TIUDISP,1,160),TIUDA)
End DoDot:1
+36 SET VALMCNT=TIUTMP
+37 IF VALMCNT=0
SET VALMCNT=1
Begin DoDot:1
+38 DO SET^VALM10(1," ",0)
+39 SET TIUDOC="No records found to satisfy search criteria."
+40 SET TIUDOC=$$SETSTR^VALM1(TIUDOC,"",(IOM-$LENGTH(TIUDOC))/2,$LENGTH(TIUDOC))
+41 DO SET^VALM10(2,TIUDOC,0)
End DoDot:1
+42 WRITE TIU("IOCUON")
+43 QUIT
INIT2(TIUCAT) ;
+1 SET TIUDA=""
+2 IF $PIECE(TIUCAT,U)'="AE"
FOR
SET TIUDA=$ORDER(^TIU(8925,$PIECE(TIUCAT,U),TIU("P"),TIUDA))
IF TIUDA=""
QUIT
Begin DoDot:1
+3 NEW TIUD0,TIUD12,TIUD13
+4 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
+5 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
+6 SET TIUD13=$GET(^TIU(8925,TIUDA,13))
+7 IF TIUD0=""!(TIUD12="")!(TIUD13="")
QUIT
+8 IF $$EVAL(TIUDA)
SET ^TMP("TIUDA",$JOB,TIUDA)=""
SET TIU("CNT")=TIU("CNT")+1
End DoDot:1
+9 IF $PIECE(TIUCAT,U)="AE"
FOR
SET TIUDA=$ORDER(^TIU(8925.7,"AE",TIUDA))
IF TIUDA=""
QUIT
IF $DATA(^TIU(8925.7,"AE",TIUDA,TIU("P")))
Begin DoDot:1
+10 SET TIU("AS")=""
SET TIU("AS")=$ORDER(^TIU(8925.7,"AE",TIUDA,TIU("P"),TIU("AS")))
+11 IF $PIECE($GET(^TIU(8925.7,TIU("AS"),0)),U,4)
IF $PIECE($GET(^TIU(8925.7,TIU("AS"),0)),U,5)=TIU("P")
QUIT
+12 IF TIU("AS")'=""
IF $PIECE($GET(^TIU(8925.7,TIU("AS"),0)),"^",9)=1
QUIT
+13 NEW TIUD0,TIUD12,TIUD13
+14 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
+15 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
+16 SET TIUD13=$GET(^TIU(8925,TIUDA,13))
+17 IF TIUD0=""!(TIUD12="")!(TIUD13="")
QUIT
+18 IF $$EVAL(TIUDA)
SET ^TMP("TIUDA",$JOB,TIUDA)=""_U_"AE"_U_$GET(TIU("AS"))
SET TIU("CNT")=TIU("CNT")+1
+19 KILL TIU("AS")
End DoDot:1
+20 FOR
SET TIUDA=$ORDER(^TMP("TIUDA",$JOB,TIUDA))
IF TIUDA=""
QUIT
Begin DoDot:1
+21 IF +^TMP("TIUDA",$JOB,TIUDA)=1
QUIT
+22 NEW TIUD0,TIUD12,TIUD13
+23 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
+24 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
+25 SET TIUD13=$GET(^TIU(8925,TIUDA,13))
+26 IF TIUD0=""!(TIUD12="")!(TIUD13="")
QUIT
+27 IF TIUCNT#3=0
WRITE "."
+28 IF +$$HASKIDS^TIUSRVLI(TIUDA)
IF $PIECE(^TMP("TIUDA",$JOB,TIUDA),U,2)'="AE"
Begin DoDot:2
+29 NEW TMPCNT
+30 SET TIUCNT=TIUCNT+1
SET TMPCNT=TIUCNT
+31 SET ^TMP("TIUDA",$JOB,TIUDA)=1
+32 NEW CHILD,I,SEQUENCE,TIUI
+33 SET CHILD="CHILD"
SET (SEQUENCE,TIUI)=""
+34 DO SETKIDS^TIUSRVLI(.CHILD,TIUDA,.TIUI)
IF $GET(TIUI)=""
QUIT
+35 FOR I=1:1:TIUI
IF $DATA(^TMP("TIUDA",$JOB,+CHILD(I)))
IF '+$GET(^TMP("TIUDA",$JOB,+CHILD(I)))
Begin DoDot:3
+36 NEW TIUREFDT
+37 SET TIUCNT=TIUCNT+1
+38 SET ^TMP("TIUDA",$JOB,+CHILD(I))=1
+39 SET TIUREFDT=+^TIU(8925,+CHILD(I),13)
+40 IF $$GET1^DIQ(8925,+CHILD(I),.01)'["Addendum"
SET ^TMP("TIUDOC",$JOB,+TIUD13,TIUCNT,+CHILD(I))="A"_U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,+CHILD(I),.01)_U_TIUREFDT_U_$$GET1^DIQ(8925,+CHILD(I),.05)
+41 IF '$TEST
SET ^TMP("TIUDOC",$JOB,+TIUD13,TIUCNT,+CHILD(I))="A"_U_$$GET1^DIQ(8925,TIUDA,.02)_U_"Addendum to "_$$GET1^DIQ(8925,TIUDA,.01)_U_TIUREFDT_U_$$GET1^DIQ(8925,+CHILD(I),.05)
End DoDot:3
+42 SET ^TMP("TIUDOC",$JOB,+TIUD13,TMPCNT,TIUDA)=(TIUCNT-TMPCNT)_U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_+TIUD13_U_$$GET1^DIQ(8925,TIUDA,.05)
End DoDot:2
QUIT
+43 IF $PIECE(^TMP("TIUDA",$JOB,TIUDA),U,2)="AE"!(+$$HASDAD^TIUSRVLI(TIUDA))
Begin DoDot:2
+44 NEW TIUAS
+45 SET TIUCNT=TIUCNT+1
+46 SET $PIECE(^TMP("TIUDA",$JOB,TIUDA),U)=1
+47 SET TIUAS=$PIECE(^TMP("TIUDA",$JOB,TIUDA),U,3)
+48 IF $$GET1^DIQ(8925,TIUDA,.01)'["Addendum"
SET ^TMP("TIUDOC",$JOB,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_+TIUD13_U_$$GET1^DIQ(8925,TIUDA,.05)_U_TIUAS
+49 IF '$TEST
Begin DoDot:3
+50 NEW PARENT,SEQUENCE,TIUI
+51 SET PARENT="PARENT"
SET (SEQUENCE,TIUI)=""
+52 DO SETDAD^TIUSRVLI(.PARENT,TIUDA,.TIUI)
IF $GET(TIUI)=""
QUIT
+53 SET ^TMP("TIUDOC",$JOB,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_"Addendum to "_$$GET1^DIQ(8925,+PARENT(TIUI),.01)_U_$PIECE(TIUD13,U)_U_$$GET1^DIQ(8925,TIUDA,.05)_U_TIUAS
End DoDot:3
End DoDot:2
QUIT
+54 IF '+$$HASKIDS^TIUSRVLI(TIUDA)
IF '+$$HASDAD^TIUSRVLI(TIUDA)
Begin DoDot:2
+55 SET TIUCNT=TIUCNT+1
+56 SET ^TMP("TIUDA",$JOB,TIUDA)=1
+57 SET ^TMP("TIUDOC",$JOB,+TIUD13,TIUCNT,TIUDA)=U_$$GET1^DIQ(8925,TIUDA,.02)_U_$$GET1^DIQ(8925,TIUDA,.01)_U_$PIECE(TIUD13,U)_U_$$GET1^DIQ(8925,TIUDA,.05)
End DoDot:2
QUIT
End DoDot:1
+58 QUIT
LSEXIT ; exit code
+1 DO XQORM
+2 QUIT
SELSTAT(Y,PARM,DEF,MENU) ; Select Signature status
+1 NEW I,XQORM,X,TIUY
+2 SET XQORM=+$ORDER(^ORD(101,"B",MENU,0))_";ORD(101,"
+3 IF +XQORM'>0
WRITE !,"Status selection unavailable."
SET TIUY=-1
GOTO STATX
+4 SET XQORM(0)=$GET(PARM)
SET XQORM("A")=$SELECT(MENU="TIU STATUS MENU":"Select DOCUMENT STATUS: ",1:"Select SEARCH CATEGORY: ")
+5 IF $SELECT(PARM="F":1,PARM="R":1,1:0)
SET X=DEF
+6 SET XQORM("B")=DEF
DO EN^XQORM
+7 SET TIUY=$GET(Y)
+8 IF MENU="TIU STATUS MENU"
IF +$GET(Y)=1
IF (+$GET(Y(1))=7)
SET Y=2
SET Y(2)="8^4843^amended^8"
STATX QUIT TIUY
XQORM ;
+1 SET XQORM("#")=$ORDER(^ORD(101,"B","TIU ALERTS SELECT",0))_U_"1:"_VALMCNT
+2 QUIT
