TIUBR1 ;SLC/JER - Enter TIU Browse with DFN and TIUDA ;11-Nov-2013 14:56;DU
;;1.0;TEXT INTEGRATION UTILITIES;**31,100,123,176,1007,157,1010,241,1013**;Jun 20, 1997;Build 33
; Move LOADSIG, XTRASIG, LOADFOR, LOADREC from TIUBR. **100**
;IHS/ITSC/LJF 05/01/2003 convert blanks to reverse video ;
LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ^TMP
;Requires TIUDA, array TIUL, TIUGDATA
;Optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
; loading the whole note after the selected child,
; so DON'T load the whole note again.
N TIUKID,TIUI,CANSEE,TIUPARNT,TIUPNAME,TIUPDATE
N TIUGPRNT,TIUPDATA,TIUHASKD
S TIUI=0
; ---- If user cannot view TIUDA, say so,
; [load the rest of the ID note], & quit: ----
S CANSEE=$S(+$$ISCOMP^TIUBR(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,"VIEW"))
I +CANSEE'>0 D Q
. S TIUL=+$G(TIUL)+1
. S @VALMAR@(TIUL,0)=$P(CANSEE,U,2)
. I $P(TIUGDATA,U,2)!$P(TIUGDATA,U,3) D IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
; ---- Load text of TIUDA: ----
F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
. S TIUL=+$G(TIUL)+1
.;
. ; convert @@@ (blanks designation) to reverse video
. ;S @VALMAR@(TIUL,0)=$G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0)) ;IHS/ITSC/LJF 05/01/2003
. S @VALMAR@(TIUL,0)=$$BLANKS^BTIUBR($G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0))) ;IHS/ITSC/LJF 05/01/2003
; ---- If TIUDA is a COMPONENT, QUIT
Q:+$$ISCOMP^TIUBR(TIUDA)
; ---- If TIUDA **IS** an addendum, load addm signature,
; load original document, quit: ----
I +$$ISADDNDM^TIULC1(+TIUDA) D Q
. N TIULINE S $P(TIULINE,"=",79)=""
. D LOADSIG(TIUDA,.TIUL)
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIULINE
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. S TIUPARNT=+$P(^TIU(8925,+TIUDA,0),U,6)
. S TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
. S TIUPDATE=+$G(^TIU(8925,TIUPARNT,13))
. S TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
. S TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
. S TIUHASKD=$P(TIUPDATA,U,2),TIUGPRNT=+$P(TIUPDATA,U,3)
. S TIUL=+$G(TIUL)+1
. I 'TIUHASKD,'TIUGPRNT D
. . S @VALMAR@(TIUL,0)=" --- Original Document ---"
. . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. . S TIUL=+$G(TIUL)+1
. . S @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
. . D LOADREC(TIUPARNT,.TIUL,TIUGDATA)
. I TIUHASKD D
. . S @VALMAR@(TIUL,0)=" --- Addended Interdisciplinary Note ---"
. . D LOADID^TIUGBR(TIUPARNT,.TIUL,TIUPDATA,1)
. I TIUGPRNT D
. . S @VALMAR@(TIUL,0)=" --- Original Interdisciplinary Entry ---"
. . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. . S TIUL=+$G(TIUL)+1
. . S @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
. . D LOADREC(TIUPARNT,.TIUL,TIUGDATA)
. . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. . S TIUL=+$G(TIUL)+1
. . S @VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
. . D LOADID^TIUGBR(TIUGPRNT,.TIUL,TIUPDATA,1)
; ---- Load components of TIUDA: ----
S TIUKID=0
F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
. I +$$ISADDNDM^TIULC1(TIUKID)'>0 D LOADREC(TIUKID,.TIUL,TIUGDATA)
; ---- Load signature of TIUDA if TIUDA is not addm
; or comp: ----
I '$$ISCOMP^TIUBR(TIUDA) D LOADSIG(TIUDA,.TIUL)
; ---- Load addenda of TIUDA: ----
S TIUKID=0
F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
. ; If an addendum has focus, don't show it again unless
. ; loading whole ID note:
. I '$G(TIUGWHOL),+TIUKID=+$G(^TMP("TIU FOCUS",$J)) Q
. I +$$ISADDNDM^TIULC1(TIUKID) D LOADADD^TIUBR(TIUKID,.TIUL)
; ---- Load the rest of the ID note display: ----
I $P(TIUGDATA,U,2)!$P(TIUGDATA,U,3) D IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
Q
;
IDREST(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load rest of ID note display
N IDDAD
S IDDAD=+$P(TIUGDATA,U,3)
; ---- If Browsed Record is an ID child, & this cycle hasn't begun
; loading the whole note, then load the whole ID Note after
; the browsed child: ----
I IDDAD,'$G(TIUGWHOL) D Q
. S TIUGWHOL=1
. N TIULINE S $P(TIULINE,"=",79)=""
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIULINE
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
. D LOADID^TIUGBR(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
; ---- If Browsed Record is an ID parent, & this cycle has
; just loaded the parent entry, OR
; If Browsed Record is an ID child, & this cycle has begun
; loading the whole ID note, and is currently loading the first
; entry of the whole note,
; Then load kids: ----
I $P(TIUGDATA,U,2)&(TIUDA=+TIUGDATA)!(IDDAD&$G(TIUGWHOL)&(TIUDA=IDDAD)) D
. D LOADKIDS^TIUBR(TIUDA,.TIUL,TIUGDATA,$G(TIUGWHOL)) K TIUGWHOL
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" << Interdisciplinary Note - End >>"
Q
EXSTNOTE(DFN,TIUDA) ; Sample/display existing notes
N TIU,TIUPRM0,TIUPRM1,TIUSEE,TIUOUT,TIUY,TIUQUIT
D SETPARM^TIULE
Q:TIUDA'>0
D GETTIU^TIULD(.TIU,+TIUDA)
I $D(TIU) D
. S TIUSEE=$$CANDO^TIULP(TIUDA,"VIEW")
. I 'TIUSEE D Q
. . W !!,$C(7),$P(TIUSEE,U,2),!
. . W:$$READ^TIUU("FOA","Press RETURN to continue...") ""
. D EN^VALM("TIU BROWSE FOR CLINICIAN")
. K ^TMP("TIUVIEW",$J)
. S:$D(TIUQUIT) TIUOUT=1
Q
;
LOADSIG(DA,TIUL) ; Get signature and co-signature blocks
N DIC,DIQ,DR,TIUSIG,TIUESIG1,TIUESIG2,TIUSIG1,TIUSIG2,TIUS1,TIUS2
N TIUSNM,TIUSTTL,TIUS1DT,TIUS2DT,TIUSDT
;VMP/ELR CHANGED NEXT LINE FROM QUIT IF NOT DEFINED TO GO TO XTRA
I '$D(^TIU(8925,DA,15)) G XTRA
S DIC=8925,DIQ="TIUSIG(",DIQ(0)="IE",DR="1204;1208;1501:1505;1507:1513;1601:1605"
D EN^DIQ1 I '$D(TIUSIG) Q
S TIUS1=$S(TIUSIG(8925,DA,1505,"I")="E":"/es/ ",TIUSIG(8925,DA,1505,"I")="C":"/s/ ",1:"")_$G(TIUSIG(8925,DA,1503,"E"))
S TIUS2=$S(TIUSIG(8925,DA,1511,"I")="E":"/es/ ",TIUSIG(8925,DA,1511,"I")="C":"/s/ ",1:"")_$G(TIUSIG(8925,DA,1509,"E"))
S TIUESIG1=$G(TIUSIG(8925,DA,1204,"I"))
S TIUSIG1=$G(TIUSIG(8925,DA,1502,"I"))
S TIUS1DT=$S(+$G(TIUSIG(8925,DA,1501,"I")):"Signed: "_$$DATE^TIULS($G(TIUSIG(8925,DA,1501,"I")),"MM/DD/CCYY HR:MIN"),1:"")
S TIUESIG2=$G(TIUSIG(8925,DA,1208,"I"))
S TIUS2DT=$S(+$G(TIUSIG(8925,DA,1507,"I")):"Cosigned: "_$$DATE^TIULS($G(TIUSIG(8925,DA,1507,"I")),"MM/DD/CCYY HR:MIN"),1:"")
S TIUSIG2=$G(TIUSIG(8925,DA,1508,"I"))
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS1
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(TIUSIG(8925,DA,1504,"E"))
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS1DT
I $G(TIUSIG(8925,DA,1505,"I"))="C" D
. N TIUONCH
. S TIUONCH=$G(TIUSIG(8925,DA,1512,"E")) I '$L(TIUONCH) S TIUONCH=$G(TIUSIG(8925,DA,1513,"E"))
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="Marked signed on chart by: "_TIUONCH
I TIUSIG1]"",(TIUSIG1'=TIUESIG1) D LOADFOR(TIUSIG1,TIUESIG1,.TIUL)
I +$G(TIUSIG(8925,DA,1507,"I"))>0 D
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS2
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(TIUSIG(8925,DA,1510,"E"))
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS2DT
. I $G(TIUSIG(8925,DA,1511,"I"))="C" D
. . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="Marked cosigned on chart by: "_$G(TIUSIG(8925,DA,1513,"E"))
I TIUSIG2]"",(TIUSIG2'=TIUESIG2) D LOADFOR(TIUSIG2,TIUESIG2,.TIUL)
XTRA I +$O(^TIU(8925.7,"B",DA,0)) D XTRASIG(DA,.TIUL)
I +$G(TIUSIG(8925,DA,1601,"I")) D
. N TIUMODE
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
. S TIUL=+$G(TIUL)+1
. S @VALMAR@(TIUL,0)=$$DATE^TIULS(TIUSIG(8925,DA,1601,"I"),"MM/DD/CCYY HR:MIN")_" AMENDMENT FILED:"
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="",TIUL=+$G(TIUL)+1
. S TIUMODE=$S(+$G(TIUSIG(8925,DA,1603,"I")):"/es/ ",1:" /s/ ")
. S @VALMAR@(TIUL,0)=TIUMODE_$S($G(TIUSIG(8925,DA,1604,"E"))]"":$G(TIUSIG(8925,DA,1604,"E")),1:$G(TIUSIG(8925,DA,1602,"E")))
. I $L($G(TIUSIG(8925,DA,1605,"E"))) D
. . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(TIUSIG(8925,DA,1605,"E"))
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$P($G(TIUPRM1),U,5)
Q
XTRASIG(TIUDA,TIUL) ; Load additional signature blocks
N TIUI,DA,DR,DIC,DIQ,TIUXTRA S TIUI=0
S DIC="^TIU(8925.7,",DIQ="TIUXTRA"
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="Receipt Acknowledged By:"
F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
. N TIUX,TIUSGNR,TIUSDT
. S DA=TIUI,DR=".03:.08",DIQ(0)="IE" D EN^DIQ1 Q:+$D(TIUXTRA)'>9
. S TIUSGNR=$S($L($G(TIUXTRA(8925.7,DA,.06,"E"))):"/es/ "_$G(TIUXTRA(8925.7,DA,.06,"E")),1:" "_$G(TIUXTRA(8925.7,DA,.03,"E")))
. S TIUSDT=$S(+$G(TIUXTRA(8925.7,DA,.04,"I")):$$DATE^TIULS(TIUXTRA(8925.7,DA,.04,"I"),"MM/DD/CCYY HR:MIN"),1:"* AWAITING SIGNATURE *")
. S TIUX=$$SETSTR^VALM1(TIUSDT,$G(TIUX),1,38)
. S TIUX=$$SETSTR^VALM1(TIUSGNR,$G(TIUX),25,55)
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUX,TIUX=""
. S TIUX=$$SETSTR^VALM1($G(TIUXTRA(8925.7,DA,.07,"E")),$G(TIUX),30,50)
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUX
. I $G(TIUXTRA(8925.7,DA,.05,"I")),$G(TIUXTRA(8925.7,DA,.05,"I"))'=$G(TIUXTRA(8925.7,DA,.03,"I")) D
. . N TIUFOR
. . S TIUX=""
. . S TIUFOR="for "_$P($G(TIUXTRA(8925.7,DA,.03,"E")),",",2)_" "_$P($G(TIUXTRA(8925.7,DA,.03,"E")),",")
. . S TIUX=$$SETSTR^VALM1(TIUFOR,$G(TIUX),26,55)
. . S TIUL=TIUL+1,@VALMAR@(TIUL,0)=TIUX
Q
LOADFOR(TIUS1,TIUES1,TIUL) ; Apply "for" block
N TIUESN1,TIUEST1,TIUFORN,TIUFORT
S TIUESN1="for "_$$SIGNAME^TIULS(TIUES1),TIUEST1=$$SIGTITL^TIULS(TIUES1)
I +$G(TIUS1),($G(TIUS1)'=$G(TIUES1)) S TIUFORN=$$SETSTR^VALM1(TIUESN1,$G(TIUFORN),1,50),TIUFORT=$$SETSTR^VALM1(TIUEST1,$G(TIUFORT),1,50)
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUFORN
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUFORT
Q
TIUBR1 ;SLC/JER - Enter TIU Browse with DFN and TIUDA ;11-Nov-2013 14:56;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**31,100,123,176,1007,157,1010,241,1013**;Jun 20, 1997;Build 33
+2 ; Move LOADSIG, XTRASIG, LOADFOR, LOADREC from TIUBR. **100**
+3 ;IHS/ITSC/LJF 05/01/2003 convert blanks to reverse video ;
LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ^TMP
+1 ;Requires TIUDA, array TIUL, TIUGDATA
+2 ;Optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
+3 ; loading the whole note after the selected child,
+4 ; so DON'T load the whole note again.
+5 NEW TIUKID,TIUI,CANSEE,TIUPARNT,TIUPNAME,TIUPDATE
+6 NEW TIUGPRNT,TIUPDATA,TIUHASKD
+7 SET TIUI=0
+8 ; ---- If user cannot view TIUDA, say so,
+9 ; [load the rest of the ID note], & quit: ----
+10 SET CANSEE=$SELECT(+$$ISCOMP^TIUBR(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,"VIEW"))
+11 IF +CANSEE'>0
Begin DoDot:1
+12 SET TIUL=+$GET(TIUL)+1
+13 SET @VALMAR@(TIUL,0)=$PIECE(CANSEE,U,2)
+14 IF $PIECE(TIUGDATA,U,2)!$PIECE(TIUGDATA,U,3)
DO IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
End DoDot:1
QUIT
+15 ; ---- Load text of TIUDA: ----
+16 FOR
SET TIUI=$ORDER(^TIU(8925,+TIUDA,"TEXT",TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+17 SET TIUL=+$GET(TIUL)+1
+18 ;
+19 ; convert @@@ (blanks designation) to reverse video
+20 ;S @VALMAR@(TIUL,0)=$G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0)) ;IHS/ITSC/LJF 05/01/2003
+21 ;IHS/ITSC/LJF 05/01/2003
SET @VALMAR@(TIUL,0)=$$BLANKS^BTIUBR($GET(^TIU(8925,+TIUDA,"TEXT",+TIUI,0)))
End DoDot:1
+22 ; ---- If TIUDA is a COMPONENT, QUIT
+23 IF +$$ISCOMP^TIUBR(TIUDA)
QUIT
+24 ; ---- If TIUDA **IS** an addendum, load addm signature,
+25 ; load original document, quit: ----
+26 IF +$$ISADDNDM^TIULC1(+TIUDA)
Begin DoDot:1
+27 NEW TIULINE
SET $PIECE(TIULINE,"=",79)=""
+28 DO LOADSIG(TIUDA,.TIUL)
+29 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+30 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIULINE
+31 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+32 SET TIUPARNT=+$PIECE(^TIU(8925,+TIUDA,0),U,6)
+33 SET TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
+34 SET TIUPDATE=+$GET(^TIU(8925,TIUPARNT,13))
+35 SET TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
+36 SET TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
+37 SET TIUHASKD=$PIECE(TIUPDATA,U,2)
SET TIUGPRNT=+$PIECE(TIUPDATA,U,3)
+38 SET TIUL=+$GET(TIUL)+1
+39 IF 'TIUHASKD
IF 'TIUGPRNT
Begin DoDot:2
+40 SET @VALMAR@(TIUL,0)=" --- Original Document ---"
+41 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+42 SET TIUL=+$GET(TIUL)+1
+43 SET @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
+44 DO LOADREC(TIUPARNT,.TIUL,TIUGDATA)
End DoDot:2
+45 IF TIUHASKD
Begin DoDot:2
+46 SET @VALMAR@(TIUL,0)=" --- Addended Interdisciplinary Note ---"
+47 DO LOADID^TIUGBR(TIUPARNT,.TIUL,TIUPDATA,1)
End DoDot:2
+48 IF TIUGPRNT
Begin DoDot:2
+49 SET @VALMAR@(TIUL,0)=" --- Original Interdisciplinary Entry ---"
+50 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+51 SET TIUL=+$GET(TIUL)+1
+52 SET @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
+53 DO LOADREC(TIUPARNT,.TIUL,TIUGDATA)
+54 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+55 SET TIUL=+$GET(TIUL)+1
+56 SET @VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
+57 DO LOADID^TIUGBR(TIUGPRNT,.TIUL,TIUPDATA,1)
End DoDot:2
End DoDot:1
QUIT
+58 ; ---- Load components of TIUDA: ----
+59 SET TIUKID=0
+60 FOR
SET TIUKID=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUKID))
IF +TIUKID'>0
QUIT
Begin DoDot:1
+61 IF +$$ISADDNDM^TIULC1(TIUKID)'>0
DO LOADREC(TIUKID,.TIUL,TIUGDATA)
End DoDot:1
+62 ; ---- Load signature of TIUDA if TIUDA is not addm
+63 ; or comp: ----
+64 IF '$$ISCOMP^TIUBR(TIUDA)
DO LOADSIG(TIUDA,.TIUL)
+65 ; ---- Load addenda of TIUDA: ----
+66 SET TIUKID=0
+67 FOR
SET TIUKID=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUKID))
IF +TIUKID'>0
QUIT
Begin DoDot:1
+68 ; If an addendum has focus, don't show it again unless
+69 ; loading whole ID note:
+70 IF '$GET(TIUGWHOL)
IF +TIUKID=+$GET(^TMP("TIU FOCUS",$JOB))
QUIT
+71 IF +$$ISADDNDM^TIULC1(TIUKID)
DO LOADADD^TIUBR(TIUKID,.TIUL)
End DoDot:1
+72 ; ---- Load the rest of the ID note display: ----
+73 IF $PIECE(TIUGDATA,U,2)!$PIECE(TIUGDATA,U,3)
DO IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
+74 QUIT
+75 ;
IDREST(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load rest of ID note display
+1 NEW IDDAD
+2 SET IDDAD=+$PIECE(TIUGDATA,U,3)
+3 ; ---- If Browsed Record is an ID child, & this cycle hasn't begun
+4 ; loading the whole note, then load the whole ID Note after
+5 ; the browsed child: ----
+6 IF IDDAD
IF '$GET(TIUGWHOL)
Begin DoDot:1
+7 SET TIUGWHOL=1
+8 NEW TIULINE
SET $PIECE(TIULINE,"=",79)=""
+9 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+10 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIULINE
+11 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+12 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
+13 DO LOADID^TIUGBR(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
End DoDot:1
QUIT
+14 ; ---- If Browsed Record is an ID parent, & this cycle has
+15 ; just loaded the parent entry, OR
+16 ; If Browsed Record is an ID child, & this cycle has begun
+17 ; loading the whole ID note, and is currently loading the first
+18 ; entry of the whole note,
+19 ; Then load kids: ----
+20 IF $PIECE(TIUGDATA,U,2)&(TIUDA=+TIUGDATA)!(IDDAD&$GET(TIUGWHOL)&(TIUDA=IDDAD))
Begin DoDot:1
+21 DO LOADKIDS^TIUBR(TIUDA,.TIUL,TIUGDATA,$GET(TIUGWHOL))
KILL TIUGWHOL
+22 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+23 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" << Interdisciplinary Note - End >>"
End DoDot:1
+24 QUIT
EXSTNOTE(DFN,TIUDA) ; Sample/display existing notes
+1 NEW TIU,TIUPRM0,TIUPRM1,TIUSEE,TIUOUT,TIUY,TIUQUIT
+2 DO SETPARM^TIULE
+3 IF TIUDA'>0
QUIT
+4 DO GETTIU^TIULD(.TIU,+TIUDA)
+5 IF $DATA(TIU)
Begin DoDot:1
+6 SET TIUSEE=$$CANDO^TIULP(TIUDA,"VIEW")
+7 IF 'TIUSEE
Begin DoDot:2
+8 WRITE !!,$CHAR(7),$PIECE(TIUSEE,U,2),!
+9 IF $$READ^TIUU("FOA","Press RETURN to continue...")
WRITE ""
End DoDot:2
QUIT
+10 DO EN^VALM("TIU BROWSE FOR CLINICIAN")
+11 KILL ^TMP("TIUVIEW",$JOB)
+12 IF $DATA(TIUQUIT)
SET TIUOUT=1
End DoDot:1
+13 QUIT
+14 ;
LOADSIG(DA,TIUL) ; Get signature and co-signature blocks
+1 NEW DIC,DIQ,DR,TIUSIG,TIUESIG1,TIUESIG2,TIUSIG1,TIUSIG2,TIUS1,TIUS2
+2 NEW TIUSNM,TIUSTTL,TIUS1DT,TIUS2DT,TIUSDT
+3 ;VMP/ELR CHANGED NEXT LINE FROM QUIT IF NOT DEFINED TO GO TO XTRA
+4 IF '$DATA(^TIU(8925,DA,15))
GOTO XTRA
+5 SET DIC=8925
SET DIQ="TIUSIG("
SET DIQ(0)="IE"
SET DR="1204;1208;1501:1505;1507:1513;1601:1605"
+6 DO EN^DIQ1
IF '$DATA(TIUSIG)
QUIT
+7 SET TIUS1=$SELECT(TIUSIG(8925,DA,1505,"I")="E":"/es/ ",TIUSIG(8925,DA,1505,"I")="C":"/s/ ",1:"")_$GET(TIUSIG(8925,DA,1503,"E"))
+8 SET TIUS2=$SELECT(TIUSIG(8925,DA,1511,"I")="E":"/es/ ",TIUSIG(8925,DA,1511,"I")="C":"/s/ ",1:"")_$GET(TIUSIG(8925,DA,1509,"E"))
+9 SET TIUESIG1=$GET(TIUSIG(8925,DA,1204,"I"))
+10 SET TIUSIG1=$GET(TIUSIG(8925,DA,1502,"I"))
+11 SET TIUS1DT=$SELECT(+$GET(TIUSIG(8925,DA,1501,"I")):"Signed: "_$$DATE^TIULS($GET(TIUSIG(8925,DA,1501,"I")),"MM/DD/CCYY HR:MIN"),1:"")
+12 SET TIUESIG2=$GET(TIUSIG(8925,DA,1208,"I"))
+13 SET TIUS2DT=$SELECT(+$GET(TIUSIG(8925,DA,1507,"I")):"Cosigned: "_$$DATE^TIULS($GET(TIUSIG(8925,DA,1507,"I")),"MM/DD/CCYY HR:MIN"),1:"")
+14 SET TIUSIG2=$GET(TIUSIG(8925,DA,1508,"I"))
+15 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" "
+16 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUS1
+17 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=$GET(TIUSIG(8925,DA,1504,"E"))
+18 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUS1DT
+19 IF $GET(TIUSIG(8925,DA,1505,"I"))="C"
Begin DoDot:1
+20 NEW TIUONCH
+21 SET TIUONCH=$GET(TIUSIG(8925,DA,1512,"E"))
IF '$LENGTH(TIUONCH)
SET TIUONCH=$GET(TIUSIG(8925,DA,1513,"E"))
+22 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)="Marked signed on chart by: "_TIUONCH
End DoDot:1
+23 IF TIUSIG1]""
IF (TIUSIG1'=TIUESIG1)
DO LOADFOR(TIUSIG1,TIUESIG1,.TIUL)
+24 IF +$GET(TIUSIG(8925,DA,1507,"I"))>0
Begin DoDot:1
+25 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" "
+26 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUS2
+27 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=$GET(TIUSIG(8925,DA,1510,"E"))
+28 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUS2DT
+29 IF $GET(TIUSIG(8925,DA,1511,"I"))="C"
Begin DoDot:2
+30 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)="Marked cosigned on chart by: "_$GET(TIUSIG(8925,DA,1513,"E"))
End DoDot:2
End DoDot:1
+31 IF TIUSIG2]""
IF (TIUSIG2'=TIUESIG2)
DO LOADFOR(TIUSIG2,TIUESIG2,.TIUL)
XTRA IF +$ORDER(^TIU(8925.7,"B",DA,0))
DO XTRASIG(DA,.TIUL)
+1 IF +$GET(TIUSIG(8925,DA,1601,"I"))
Begin DoDot:1
+2 NEW TIUMODE
+3 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+4 SET TIUL=+$GET(TIUL)+1
+5 SET @VALMAR@(TIUL,0)=$$DATE^TIULS(TIUSIG(8925,DA,1601,"I"),"MM/DD/CCYY HR:MIN")_" AMENDMENT FILED:"
+6 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
SET TIUL=+$GET(TIUL)+1
+7 SET TIUMODE=$SELECT(+$GET(TIUSIG(8925,DA,1603,"I")):"/es/ ",1:" /s/ ")
+8 SET @VALMAR@(TIUL,0)=TIUMODE_$SELECT($GET(TIUSIG(8925,DA,1604,"E"))]"":$GET(TIUSIG(8925,DA,1604,"E")),1:$GET(TIUSIG(8925,DA,1602,"E")))
+9 IF $LENGTH($GET(TIUSIG(8925,DA,1605,"E")))
Begin DoDot:2
+10 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=$GET(TIUSIG(8925,DA,1605,"E"))
End DoDot:2
+11 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=$PIECE($GET(TIUPRM1),U,5)
End DoDot:1
+12 QUIT
XTRASIG(TIUDA,TIUL) ; Load additional signature blocks
+1 NEW TIUI,DA,DR,DIC,DIQ,TIUXTRA
SET TIUI=0
+2 SET DIC="^TIU(8925.7,"
SET DIQ="TIUXTRA"
+3 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" "
+4 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)="Receipt Acknowledged By:"
+5 FOR
SET TIUI=$ORDER(^TIU(8925.7,"B",TIUDA,TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW TIUX,TIUSGNR,TIUSDT
+7 SET DA=TIUI
SET DR=".03:.08"
SET DIQ(0)="IE"
DO EN^DIQ1
IF +$DATA(TIUXTRA)'>9
QUIT
+8 SET TIUSGNR=$SELECT($LENGTH($GET(TIUXTRA(8925.7,DA,.06,"E"))):"/es/ "_$GET(TIUXTRA(8925.7,DA,.06,"E")),1:" "_$GET(TIUXTRA(8925.7,DA,.03,"E")))
+9 SET TIUSDT=$SELECT(+$GET(TIUXTRA(8925.7,DA,.04,"I")):$$DATE^TIULS(TIUXTRA(8925.7,DA,.04,"I"),"MM/DD/CCYY HR:MIN"),1:"* AWAITING SIGNATURE *")
+10 SET TIUX=$$SETSTR^VALM1(TIUSDT,$GET(TIUX),1,38)
+11 SET TIUX=$$SETSTR^VALM1(TIUSGNR,$GET(TIUX),25,55)
+12 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUX
SET TIUX=""
+13 SET TIUX=$$SETSTR^VALM1($GET(TIUXTRA(8925.7,DA,.07,"E")),$GET(TIUX),30,50)
+14 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUX
+15 IF $GET(TIUXTRA(8925.7,DA,.05,"I"))
IF $GET(TIUXTRA(8925.7,DA,.05,"I"))'=$GET(TIUXTRA(8925.7,DA,.03,"I"))
Begin DoDot:2
+16 NEW TIUFOR
+17 SET TIUX=""
+18 SET TIUFOR="for "_$PIECE($GET(TIUXTRA(8925.7,DA,.03,"E")),",",2)_" "_$PIECE($GET(TIUXTRA(8925.7,DA,.03,"E")),",")
+19 SET TIUX=$$SETSTR^VALM1(TIUFOR,$GET(TIUX),26,55)
+20 SET TIUL=TIUL+1
SET @VALMAR@(TIUL,0)=TIUX
End DoDot:2
End DoDot:1
+21 QUIT
LOADFOR(TIUS1,TIUES1,TIUL) ; Apply "for" block
+1 NEW TIUESN1,TIUEST1,TIUFORN,TIUFORT
+2 SET TIUESN1="for "_$$SIGNAME^TIULS(TIUES1)
SET TIUEST1=$$SIGTITL^TIULS(TIUES1)
+3 IF +$GET(TIUS1)
IF ($GET(TIUS1)'=$GET(TIUES1))
SET TIUFORN=$$SETSTR^VALM1(TIUESN1,$GET(TIUFORN),1,50)
SET TIUFORT=$$SETSTR^VALM1(TIUEST1,$GET(TIUFORT),1,50)
+4 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUFORN
+5 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUFORT
+6 QUIT
