TIUBR ; SLC/JER - Browse Action Subroutines ;31-Dec-2012 14:33;DU
;;1.0;TEXT INTEGRATION UTILITIES;**32,87,93,58,100,162,112,173,1007,1009,208,1010,211,1011**;Jun 20, 1997;Build 13
; Move LOADSIG, XTRASIG, LOADFOR, LOADREC to TIUBR1.
;IHS/ITSC/LJF 05/01/2003 - calls to BTIUBR and BTIUPCC to display IHS data
;IHS/MSC/MGH 2/25/10 - updated after patches installed.
EN ; Entry code for LM templates TIU BROWSE
N TIUY
;Kill TIUGDATA in CLEAN; don't new it here
; -- Set TIUGDATA, which describes the note originally
; selected to be browsed. --
; TIUGDATA = 0 or
; = TIUDA^HASIDKID^TIUD21^PRMSORT, where
; PRMSORT = "TITLE" or "REFDT". See 8925.95, fld .18
S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
D BLDTMP(TIUDA)
Q
HDR ; Build Header
N TIUDTYP,DFN
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
D:$D(TIU)'>9 GETTIU^TIULD(.TIU,+TIUDA)
S VALMHDR(1)=$$CENTER^TIULS($P($G(TIU("DOCTYP")),U,2))
; Docmt header line Patname, SSN, [Location, Visit]:
S VALMHDR(2)=$$SETREC(TIUGDATA)
Q
BLDTMP(TIUDA) ; Build ^TMP("TIUVIEW",$J,
; Requires TIUDA = IFN of note selected to be browsed.
; Needs TIUGDATA, set in EN
N TIUI,TIUL,TIUREC,TIUDADD,ONBROWSE S (TIUDADD,TIUI)=0
N TIUNAME K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J)
I '$D(^TIU(8925,+TIUDA,0)) S VALMQUIT=1 Q
S ^TMP("TIU FOCUS",$J)=TIUDA
D INQUIRE^TIUGBR(TIUDA,.TIUREC)
I $D(TIUREC)>9 W !!,"Opening "_TIUREC(8925,+TIUDA,.01)_" record for review..."
; --- if the document has a browse action, execute it ---
S ONBROWSE=$$ONBROWSE^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
I $L(ONBROWSE) D LOADSUPP(ONBROWSE,TIUDA,.TIUL)
; ---- Load dictation, transcription data, etc.: ----
D LOADTOP(.TIUREC,TIUDA,.TIUL,TIUGDATA)
; ---- Load the remainder of the record: ----
D LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA)
K ^TMP("TIU FOCUS",$J)
S ^TMP("TIUVIEW",$J,0)=$G(^TIU(8925,+TIUDA,"TEXT",0))
S $P(^TMP("TIUVIEW",$J,0),U,3,4)=$G(TIUL)_U_$G(TIUL),VALMCNT=+$G(TIUL)
Q
LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
N TIUY,TIUI S TIUI=0
X METHOD I '$D(@TIUY) Q
F S TIUI=$O(@TIUY@(TIUI)) Q:+TIUI'>0 D
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(@TIUY@(TIUI))
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
K @TIUY
Q
LOADTOP(TIUREC,TIUDA,TIUL,TIUGDATA) ; Load dictation, transcription data, etc.
; Requires array TIUREC, TIUDA, array TIUL, TIUGDATA
N TIUY,SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT
; ---- For ID note, include Title, [Location, & Visit] with each
; entry, since they vary by entry.
; ---- Follow with Date, Author, etc.
; ---- For ID children in whole note display, shorten top info:
; Instead of Title, Location, Visit, Date, Author, etc.,
; use just Title, followed by just Date and Status:
S (SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT)=0
I $P(TIUGDATA,U,3) S SELCHLD=1 ; Selected record was IDchild
I $P(TIUGDATA,U,2) S SELPRNT=1
I SELCHLD,TIUDA'=$P(TIUGDATA,U,3) S CURCHLD=1 ; Current rec is IDchild
I SELCHLD,TIUDA=$P(TIUGDATA,U,3) S CURPRNT=1
I SELPRNT,TIUDA=+TIUGDATA S CURPRNT=1
I SELPRNT,TIUDA'=+TIUGDATA S CURCHLD=1
I SELPRNT,CURCHLD S SHORT=1 ;Child in whole note: shorten top info
I SELCHLD,CURCHLD,$G(TIUGWHOL) S SHORT=1
I SELCHLD!SELPRNT D
. D IDTOP^TIUGBR(TIUDA,.TIUL,SHORT,CURPRNT)
S TIUL=+$G(TIUL)+1,TIUY=""
I $L(TIUREC(8925,+TIUDA,89261)) D
. S TIUY=$$SETSTR^VALM1("STANDARD TITLE: "_TIUREC(8925,+TIUDA,89261),TIUY,1,64)
. S @VALMAR@(TIUL,0)=TIUY
. S TIUL=TIUL+1,TIUY=""
I SHORT D
. S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$G(TIUY),1,39)
. S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$G(TIUY),42,38)
. S @VALMAR@(TIUL,0)=TIUY
. D LT1^BTIUBR ;IHS/ITSC/LJF 05/01/2003 display if unsigned, authors class
I 'SHORT D
. I $L(TIUREC(8925,+TIUDA,1307)) D I 1
. . S TIUY=$$SETSTR^VALM1("DICT DATE: "_TIUREC(8925,+TIUDA,1307),$G(TIUY),4,39)
. E S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$G(TIUY),1,39)
. S TIUY=$$SETSTR^VALM1("ENTRY DATE: "_TIUREC(8925,+TIUDA,1201),$G(TIUY),38,39)
. S @VALMAR@(TIUL,0)=TIUY
. S TIUL=TIUL+1,TIUY=""
. I $L(TIUREC(8925,+TIUDA,1307)) D I 1
. . I +$G(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""") S TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),6,32) Q
. . S TIUY=$$SETSTR^VALM1("DICTATED BY: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),2,32)
. E D
. . S TIUY=$$SETSTR^VALM1("AUTHOR: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),7,27)
. . I +$G(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""") S TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),6,32)
. I $L(TIUREC(8925,+TIUDA,1209)) D I 1
. . S TIUY=$$SETSTR^VALM1("ATTENDING: "_TIUREC(8925,+TIUDA,1209),$G(TIUY),39,40)
. E S TIUY=$$SETSTR^VALM1("EXP COSIGNER: "_TIUREC(8925,+TIUDA,1208),$G(TIUY),36,40)
. S @VALMAR@(TIUL,0)=TIUY
. D LT2^BTIUBR ;IHS/ITSC/LJF 05/01/2003 display cosigner info
. S TIUL=TIUL+1,TIUY=""
. S TIUY=$$SETSTR^VALM1("URGENCY: "_TIUREC(8925,+TIUDA,.09),$G(TIUY),6,36)
. S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$G(TIUY),42,38)
. S @VALMAR@(TIUL,0)=TIUY
. D LT1^BTIUBR ;IHS/ITSC/LJF 05/01/2003 display if unsigned, author's class
S TIUL=TIUL+1,TIUY=""
I '$L($G(^TIU(8925,+TIUDA,17))) S @VALMAR@(TIUL,0)=TIUY
E D
. S TIUY=$$SETSTR^VALM1("SUBJECT: "_$G(^TIU(8925,+TIUDA,17)),$G(TIUY),6,74)
. S @VALMAR@(TIUL,0)=TIUY
. S TIUL=TIUL+1,TIUY="",@VALMAR@(TIUL,0)=TIUY
I +$$HASADDEN^TIULC1(TIUDA) D
. S TIUY=" *** "_$$PNAME^TIULC1(+$G(^TIU(8925,TIUDA,0)))_" Has ADDENDA ***"
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUY
. S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
D LT3^BTIUBR ;IHS/ITSC/LJF 05/01/2003 add visit data to display
Q
;
LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
; Requires TIUDA, array TIUL, TIUGDATA
N TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
I $G(^TMP("TIUR",$J,"IDDATA",TIUDA)) S PRMSORT=$P(^TMP("TIUR",$J,"IDDATA",TIUDA),U,4)
E S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD21=$G(^TIU(8925,TIUDA,21)),PRMSORT=$P($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
D GETIDKID^TIURECL2(TIUDA,PRMSORT) ; sets array ^TMP("TIUIDKID",$J,
S TIUK=0
F S TIUK=$O(^TMP("TIUIDKID",$J,TIUDA,TIUK)) Q:+TIUK'>0 D
. S KIDDA=^TMP("TIUIDKID",$J,TIUDA,TIUK)
. D LOADID^TIUGBR(KIDDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
K ^TMP("TIUIDKID",$J)
Q
;
ISCOMP(DA) ; Evaluate whether a given record is a component
N TIUY,TIUTYP
S TIUTYP=+$G(^TIU(8925,DA,0))
S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
Q TIUY
LOADADD(TIUDADD,TIUL) ; Load addenda
N TIUDADT,TIUJ,CANSEE
S CANSEE=$$CANDO^TIULP(+TIUDADD,"VIEW")
S TIUJ=0,TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
S TIUDADT=$$DATE^TIULS($P($G(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
S TIUL=TIUL+1,@VALMAR@(TIUL,0)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD) ;P162
I +CANSEE'>0 D Q
. S TIUL=+$G(TIUL)+1
. S @VALMAR@(TIUL,0)=$P(CANSEE,U,2)
F S TIUJ=$O(^TIU(8925,+TIUDADD,"TEXT",TIUJ)) Q:+TIUJ'>0 D
. S TIUL=+$G(TIUL)+1
. ;S @VALMAR@(TIUL,0)=$G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0)) ;IHS/ITSC/LJF 05/01/2003
. S @VALMAR@(TIUL,0)=$$BLANKS^BTIUBR($G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0))) ;IHS/ITSC/LJF 05/01/2003
D LOADSIG^TIUBR1(TIUDADD,.TIUL)
Q
;
SETREC(TIUGDATA) ; Sets docmt header line Patname, SSN, [Location, Visit]
; Requires TIUGDATA
N Y
S Y=$$SETSTR^VALM1($$NAME^TIULS($G(TIU("PNM")),"LAST,FI MI"),$G(Y),1,15)
;S Y=$$SETSTR^VALM1($G(TIU("SSN")),$G(Y),16,12) ;IHS/ITSC/LJF 05/01/2003
S Y=$$SETSTR^VALM1("#"_$G(TIU("HRCN")),$G(Y),16,12) ;IHS/ITSC/LJF 05/01/2003
; ---- If TIUDA is an ID entry, write ID, ADDENDED? in header
; and leave out entry-specific info (Location, Visit)
; since that goes with each individual entry: ----
I $P(TIUGDATA,U,2)!$P(TIUGDATA,U,3) D G SETRX
. S Y=$$SETSTR^VALM1("Interdisciplinary "_$S($P(TIUGDATA,U,2):"Note",1:"Entry"),$G(Y),29,23)
. I $P(TIUGDATA,U,2) S Y=$$SETSTR^VALM1("ADDENDED?"_$S($$HASADDEN^TIULC1(+TIUDA,1):" Yes",1:" No"),$G(Y),66,13)
;
S Y=$$SETSTR^VALM1($$DEMOG^BTIUPCC(+TIUDA),$G(Y),35,40) G SETRX ;IHS/ITSC/LJF 05/01/2003 add sex.dob and age
;
S Y=$$SETSTR^VALM1($P($G(TIU("LOC")),U,2),$G(Y),30,17)
I $L($G(TIU("WARD"))) D
. S Y=$$SETSTR^VALM1("Adm: "_$$DATE^TIULS(+TIU("EDT"),"MM/DD/CCYY"),$G(Y),48,15)
. S Y=$$SETSTR^VALM1("Dis: "_$$DATE^TIULS(+TIU("LDT"),"MM/DD/CCYY"),$G(Y),65,15)
I '$L($G(TIU("WARD"))) D
. S Y=$$SETSTR^VALM1("Visit Date: "_$$DATE^TIULS(+$G(TIU("EDT")),"MM/DD/CCYY HR:MIN"),$G(Y),51,28)
SETRX Q Y
;
CLEAN ; Die, filthy spawn!!!
D CLEAN^VALM10 K VALMHDR,TIU,TIUPRM0,TIUPRM1,TIUGDATA
Q
TIUBR ; SLC/JER - Browse Action Subroutines ;31-Dec-2012 14:33;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**32,87,93,58,100,162,112,173,1007,1009,208,1010,211,1011**;Jun 20, 1997;Build 13
+2 ; Move LOADSIG, XTRASIG, LOADFOR, LOADREC to TIUBR1.
+3 ;IHS/ITSC/LJF 05/01/2003 - calls to BTIUBR and BTIUPCC to display IHS data
+4 ;IHS/MSC/MGH 2/25/10 - updated after patches installed.
EN ; Entry code for LM templates TIU BROWSE
+1 NEW TIUY
+2 ;Kill TIUGDATA in CLEAN; don't new it here
+3 ; -- Set TIUGDATA, which describes the note originally
+4 ; selected to be browsed. --
+5 ; TIUGDATA = 0 or
+6 ; = TIUDA^HASIDKID^TIUD21^PRMSORT, where
+7 ; PRMSORT = "TITLE" or "REFDT". See 8925.95, fld .18
+8 SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
+9 DO BLDTMP(TIUDA)
+10 QUIT
HDR ; Build Header
+1 NEW TIUDTYP,DFN
+2 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+3 IF $DATA(TIU)'>9
DO GETTIU^TIULD(.TIU,+TIUDA)
+4 SET VALMHDR(1)=$$CENTER^TIULS($PIECE($GET(TIU("DOCTYP")),U,2))
+5 ; Docmt header line Patname, SSN, [Location, Visit]:
+6 SET VALMHDR(2)=$$SETREC(TIUGDATA)
+7 QUIT
BLDTMP(TIUDA) ; Build ^TMP("TIUVIEW",$J,
+1 ; Requires TIUDA = IFN of note selected to be browsed.
+2 ; Needs TIUGDATA, set in EN
+3 NEW TIUI,TIUL,TIUREC,TIUDADD,ONBROWSE
SET (TIUDADD,TIUI)=0
+4 NEW TIUNAME
KILL ^TMP("TIUVIEW",$JOB),^TMP("TIU FOCUS",$JOB)
+5 IF '$DATA(^TIU(8925,+TIUDA,0))
SET VALMQUIT=1
QUIT
+6 SET ^TMP("TIU FOCUS",$JOB)=TIUDA
+7 DO INQUIRE^TIUGBR(TIUDA,.TIUREC)
+8 IF $DATA(TIUREC)>9
WRITE !!,"Opening "_TIUREC(8925,+TIUDA,.01)_" record for review..."
+9 ; --- if the document has a browse action, execute it ---
+10 SET ONBROWSE=$$ONBROWSE^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+11 IF $LENGTH(ONBROWSE)
DO LOADSUPP(ONBROWSE,TIUDA,.TIUL)
+12 ; ---- Load dictation, transcription data, etc.: ----
+13 DO LOADTOP(.TIUREC,TIUDA,.TIUL,TIUGDATA)
+14 ; ---- Load the remainder of the record: ----
+15 DO LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA)
+16 KILL ^TMP("TIU FOCUS",$JOB)
+17 SET ^TMP("TIUVIEW",$JOB,0)=$GET(^TIU(8925,+TIUDA,"TEXT",0))
+18 SET $PIECE(^TMP("TIUVIEW",$JOB,0),U,3,4)=$GET(TIUL)_U_$GET(TIUL)
SET VALMCNT=+$GET(TIUL)
+19 QUIT
LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
+1 NEW TIUY,TIUI
SET TIUI=0
+2 XECUTE METHOD
IF '$DATA(@TIUY)
QUIT
+3 FOR
SET TIUI=$ORDER(@TIUY@(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+4 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=$GET(@TIUY@(TIUI))
End DoDot:1
+5 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" "
+6 KILL @TIUY
+7 QUIT
LOADTOP(TIUREC,TIUDA,TIUL,TIUGDATA) ; Load dictation, transcription data, etc.
+1 ; Requires array TIUREC, TIUDA, array TIUL, TIUGDATA
+2 NEW TIUY,SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT
+3 ; ---- For ID note, include Title, [Location, & Visit] with each
+4 ; entry, since they vary by entry.
+5 ; ---- Follow with Date, Author, etc.
+6 ; ---- For ID children in whole note display, shorten top info:
+7 ; Instead of Title, Location, Visit, Date, Author, etc.,
+8 ; use just Title, followed by just Date and Status:
+9 SET (SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT)=0
+10 ; Selected record was IDchild
IF $PIECE(TIUGDATA,U,3)
SET SELCHLD=1
+11 IF $PIECE(TIUGDATA,U,2)
SET SELPRNT=1
+12 ; Current rec is IDchild
IF SELCHLD
IF TIUDA'=$PIECE(TIUGDATA,U,3)
SET CURCHLD=1
+13 IF SELCHLD
IF TIUDA=$PIECE(TIUGDATA,U,3)
SET CURPRNT=1
+14 IF SELPRNT
IF TIUDA=+TIUGDATA
SET CURPRNT=1
+15 IF SELPRNT
IF TIUDA'=+TIUGDATA
SET CURCHLD=1
+16 ;Child in whole note: shorten top info
IF SELPRNT
IF CURCHLD
SET SHORT=1
+17 IF SELCHLD
IF CURCHLD
IF $GET(TIUGWHOL)
SET SHORT=1
+18 IF SELCHLD!SELPRNT
Begin DoDot:1
+19 DO IDTOP^TIUGBR(TIUDA,.TIUL,SHORT,CURPRNT)
End DoDot:1
+20 SET TIUL=+$GET(TIUL)+1
SET TIUY=""
+21 IF $LENGTH(TIUREC(8925,+TIUDA,89261))
Begin DoDot:1
+22 SET TIUY=$$SETSTR^VALM1("STANDARD TITLE: "_TIUREC(8925,+TIUDA,89261),TIUY,1,64)
+23 SET @VALMAR@(TIUL,0)=TIUY
+24 SET TIUL=TIUL+1
SET TIUY=""
End DoDot:1
+25 IF SHORT
Begin DoDot:1
+26 SET TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$GET(TIUY),1,39)
+27 SET TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$GET(TIUY),42,38)
+28 SET @VALMAR@(TIUL,0)=TIUY
+29 ;IHS/ITSC/LJF 05/01/2003 display if unsigned, authors class
DO LT1^BTIUBR
End DoDot:1
+30 IF 'SHORT
Begin DoDot:1
+31 IF $LENGTH(TIUREC(8925,+TIUDA,1307))
Begin DoDot:2
+32 SET TIUY=$$SETSTR^VALM1("DICT DATE: "_TIUREC(8925,+TIUDA,1307),$GET(TIUY),4,39)
End DoDot:2
IF 1
+33 IF '$TEST
SET TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$GET(TIUY),1,39)
+34 SET TIUY=$$SETSTR^VALM1("ENTRY DATE: "_TIUREC(8925,+TIUDA,1201),$GET(TIUY),38,39)
+35 SET @VALMAR@(TIUL,0)=TIUY
+36 SET TIUL=TIUL+1
SET TIUY=""
+37 IF $LENGTH(TIUREC(8925,+TIUDA,1307))
Begin DoDot:2
+38 IF +$GET(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""")
SET TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),6,32)
QUIT
+39 SET TIUY=$$SETSTR^VALM1("DICTATED BY: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),2,32)
End DoDot:2
IF 1
+40 IF '$TEST
Begin DoDot:2
+41 SET TIUY=$$SETSTR^VALM1("AUTHOR: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),7,27)
+42 IF +$GET(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""")
SET TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),6,32)
End DoDot:2
+43 IF $LENGTH(TIUREC(8925,+TIUDA,1209))
Begin DoDot:2
+44 SET TIUY=$$SETSTR^VALM1("ATTENDING: "_TIUREC(8925,+TIUDA,1209),$GET(TIUY),39,40)
End DoDot:2
IF 1
+45 IF '$TEST
SET TIUY=$$SETSTR^VALM1("EXP COSIGNER: "_TIUREC(8925,+TIUDA,1208),$GET(TIUY),36,40)
+46 SET @VALMAR@(TIUL,0)=TIUY
+47 ;IHS/ITSC/LJF 05/01/2003 display cosigner info
DO LT2^BTIUBR
+48 SET TIUL=TIUL+1
SET TIUY=""
+49 SET TIUY=$$SETSTR^VALM1("URGENCY: "_TIUREC(8925,+TIUDA,.09),$GET(TIUY),6,36)
+50 SET TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$GET(TIUY),42,38)
+51 SET @VALMAR@(TIUL,0)=TIUY
+52 ;IHS/ITSC/LJF 05/01/2003 display if unsigned, author's class
DO LT1^BTIUBR
End DoDot:1
+53 SET TIUL=TIUL+1
SET TIUY=""
+54 IF '$LENGTH($GET(^TIU(8925,+TIUDA,17)))
SET @VALMAR@(TIUL,0)=TIUY
+55 IF '$TEST
Begin DoDot:1
+56 SET TIUY=$$SETSTR^VALM1("SUBJECT: "_$GET(^TIU(8925,+TIUDA,17)),$GET(TIUY),6,74)
+57 SET @VALMAR@(TIUL,0)=TIUY
+58 SET TIUL=TIUL+1
SET TIUY=""
SET @VALMAR@(TIUL,0)=TIUY
End DoDot:1
+59 IF +$$HASADDEN^TIULC1(TIUDA)
Begin DoDot:1
+60 SET TIUY=" *** "_$$PNAME^TIULC1(+$GET(^TIU(8925,TIUDA,0)))_" Has ADDENDA ***"
+61 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=TIUY
+62 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
End DoDot:1
+63 ;IHS/ITSC/LJF 05/01/2003 add visit data to display
DO LT3^BTIUBR
+64 QUIT
+65 ;
LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
+1 ; Requires TIUDA, array TIUL, TIUGDATA
+2 NEW TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
+3 IF $GET(^TMP("TIUR",$JOB,"IDDATA",TIUDA))
SET PRMSORT=$PIECE(^TMP("TIUR",$JOB,"IDDATA",TIUDA),U,4)
+4 IF '$TEST
SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD21=$GET(^TIU(8925,TIUDA,21))
SET PRMSORT=$PIECE($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
+5 ; sets array ^TMP("TIUIDKID",$J,
DO GETIDKID^TIURECL2(TIUDA,PRMSORT)
+6 SET TIUK=0
+7 FOR
SET TIUK=$ORDER(^TMP("TIUIDKID",$JOB,TIUDA,TIUK))
IF +TIUK'>0
QUIT
Begin DoDot:1
+8 SET KIDDA=^TMP("TIUIDKID",$JOB,TIUDA,TIUK)
+9 DO LOADID^TIUGBR(KIDDA,.TIUL,TIUGDATA,$GET(TIUGWHOL))
End DoDot:1
+10 KILL ^TMP("TIUIDKID",$JOB)
+11 QUIT
+12 ;
ISCOMP(DA) ; Evaluate whether a given record is a component
+1 NEW TIUY,TIUTYP
+2 SET TIUTYP=+$GET(^TIU(8925,DA,0))
+3 SET TIUY=$SELECT($PIECE($GET(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
+4 QUIT TIUY
LOADADD(TIUDADD,TIUL) ; Load addenda
+1 NEW TIUDADT,TIUJ,CANSEE
+2 SET CANSEE=$$CANDO^TIULP(+TIUDADD,"VIEW")
+3 SET TIUJ=0
SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" "
+4 SET TIUDADT=$$DATE^TIULS($PIECE($GET(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
+5 ;P162
SET TIUL=TIUL+1
SET @VALMAR@(TIUL,0)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD)
+6 IF +CANSEE'>0
Begin DoDot:1
+7 SET TIUL=+$GET(TIUL)+1
+8 SET @VALMAR@(TIUL,0)=$PIECE(CANSEE,U,2)
End DoDot:1
QUIT
+9 FOR
SET TIUJ=$ORDER(^TIU(8925,+TIUDADD,"TEXT",TIUJ))
IF +TIUJ'>0
QUIT
Begin DoDot:1
+10 SET TIUL=+$GET(TIUL)+1
+11 ;S @VALMAR@(TIUL,0)=$G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0)) ;IHS/ITSC/LJF 05/01/2003
+12 ;IHS/ITSC/LJF 05/01/2003
SET @VALMAR@(TIUL,0)=$$BLANKS^BTIUBR($GET(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0)))
End DoDot:1
+13 DO LOADSIG^TIUBR1(TIUDADD,.TIUL)
+14 QUIT
+15 ;
SETREC(TIUGDATA) ; Sets docmt header line Patname, SSN, [Location, Visit]
+1 ; Requires TIUGDATA
+2 NEW Y
+3 SET Y=$$SETSTR^VALM1($$NAME^TIULS($GET(TIU("PNM")),"LAST,FI MI"),$GET(Y),1,15)
+4 ;S Y=$$SETSTR^VALM1($G(TIU("SSN")),$G(Y),16,12) ;IHS/ITSC/LJF 05/01/2003
+5 ;IHS/ITSC/LJF 05/01/2003
SET Y=$$SETSTR^VALM1("#"_$GET(TIU("HRCN")),$GET(Y),16,12)
+6 ; ---- If TIUDA is an ID entry, write ID, ADDENDED? in header
+7 ; and leave out entry-specific info (Location, Visit)
+8 ; since that goes with each individual entry: ----
+9 IF $PIECE(TIUGDATA,U,2)!$PIECE(TIUGDATA,U,3)
Begin DoDot:1
+10 SET Y=$$SETSTR^VALM1("Interdisciplinary "_$SELECT($PIECE(TIUGDATA,U,2):"Note",1:"Entry"),$GET(Y),29,23)
+11 IF $PIECE(TIUGDATA,U,2)
SET Y=$$SETSTR^VALM1("ADDENDED?"_$SELECT($$HASADDEN^TIULC1(+TIUDA,1):" Yes",1:" No"),$GET(Y),66,13)
End DoDot:1
GOTO SETRX
+12 ;
+13 ;IHS/ITSC/LJF 05/01/2003 add sex.dob and age
SET Y=$$SETSTR^VALM1($$DEMOG^BTIUPCC(+TIUDA),$GET(Y),35,40)
GOTO SETRX
+14 ;
+15 SET Y=$$SETSTR^VALM1($PIECE($GET(TIU("LOC")),U,2),$GET(Y),30,17)
+16 IF $LENGTH($GET(TIU("WARD")))
Begin DoDot:1
+17 SET Y=$$SETSTR^VALM1("Adm: "_$$DATE^TIULS(+TIU("EDT"),"MM/DD/CCYY"),$GET(Y),48,15)
+18 SET Y=$$SETSTR^VALM1("Dis: "_$$DATE^TIULS(+TIU("LDT"),"MM/DD/CCYY"),$GET(Y),65,15)
End DoDot:1
+19 IF '$LENGTH($GET(TIU("WARD")))
Begin DoDot:1
+20 SET Y=$$SETSTR^VALM1("Visit Date: "_$$DATE^TIULS(+$GET(TIU("EDT")),"MM/DD/CCYY HR:MIN"),$GET(Y),51,28)
End DoDot:1
SETRX QUIT Y
+1 ;
CLEAN ; Die, filthy spawn!!!
+1 DO CLEAN^VALM10
KILL VALMHDR,TIU,TIUPRM0,TIUPRM1,TIUGDATA
+2 QUIT
