VistA-FOIAVistA/r/TEXT_INTEGRATION_UTILITIES-.../TIUAL1.m

203 lines
9.5 KiB
Mathematica

TIUAL1 ;SLC/AJB - TIU Alerts List Manager ; 7/6/05 4:06pm
;;1.0;TEXT INTEGRATION UTILITIES;**158,199**;Jun 20, 1997
;
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)_")"
. 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)
. 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