TIUAL1.m

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))