TIUSRVR1 ; SLC/JER - RPC for record-wise GET ;8/16/06 11:48
;;1.0;TEXT INTEGRATION UTILITIES;**19,32,87,89,100,109,112,173,186,208,211,222,295,304**;Jun 20, 1997;Build 1
;Per VHA Directive 2004-038, this routine should not be modified
TGET(TIUY,TIUDA,ACTION) ; Build ^TMP("TIUVIEW",$J,
N TIUL,TIUREC,TIUARR,TIUGDATA,TIUNAME,TIUPRM0,TIUPRM1,X,Y,TIUCPF,ONBROWSE
K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J)
S ACTION=$G(ACTION,"VIEW"),TIUL=0
D SETPARM^TIULE
; *304 init TIUY before checking if 8925 exists
S TIUY=$NA(^TMP("TIUVIEW",$J))
; *295 next line moved up 3 lines to avoid error when TIUDA is null
I '$D(^TIU(8925,+$G(TIUDA),0)) S VALMQUIT=1 Q
S TIUGDATA=$$SETGDATA(TIUDA)
; *304 MOVE THIS LINE UP 2 LINES
;S TIUY=$NA(^TMP("TIUVIEW",$J))
S TIUARR="^TMP(""TIUVIEW"",$J)"
; Initialize ^TMP("TIU FOCUS",$J) to the entry that has focus
S ^TMP("TIU FOCUS",$J)=TIUDA
; 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)
; Call INQUIRE to get record
;Set a flag to indicate whether or not a Title is a memer of the
;Clinical Procedures Class (1=Yes and 0=No)
S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
; Call INQUIRE to get record
D INQUIRE^TIUSRVR2(TIUDA,.TIUREC,TIUCPF)
; First, load dictation, transcription data, etc.
D LOADTOP(.TIUREC,TIUDA,.TIUL,TIUGDATA,TIUCPF)
; Next, load the remainder of the record
D LOADREC^TIUSRVR2(TIUDA,.TIUL,TIUGDATA,0,ACTION)
;
; *222 display closing & footer data for FORM LETTERS only
I +$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D
. S TIUL=TIUL+1,@TIUARR@(TIUL)="" D GUIVIEW^TIUFLP1(TIUDA,"CLS",.TIUL,.TIUARR)
. S TIUL=TIUL+1,@TIUARR@(TIUL)="" D GUIVIEW^TIUFLP1(TIUDA,"FTR",.TIUL,.TIUARR)
;
K ^TMP("TIU FOCUS",$J)
S VALMCNT=+$G(TIUL)
Q
SETGDATA(TIUDA) ; Set TIUGDATA
N TIUDPRM,TIUY,SORT S TIUY=""
D DOCPRM^TIULC1(+$G(^TIU(8925,TIUDA,0)),.TIUDPRM,TIUDA)
S SORT=$S(+$P(TIUDPRM(0),U,18):"TITLE",1:"REFDT")
I +$G(^TIU(8925,TIUDA,21)) S TIUY=TIUDA_U_0_U_+$G(^(21))_U_SORT G SETGX
I +$O(^TIU(8925,"GDAD",TIUDA,0)) S TIUY=TIUDA_U_1_U_0_U_SORT
SETGX Q TIUY
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,@TIUARR@(TIUL,0)=$G(@TIUY@(TIUI))
S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL,0)=" "
K @TIUY
Q
LOADTOP(TIUREC,TIUDA,TIUL,TIUGDATA,TIUCPF) ; Load top information
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 IDTOP(TIUDA,.TIUL,SHORT,CURPRNT) I 1
S TIUY=""
E I $L(TIUREC(8925,+TIUDA,.01)) D
. S TIUY=$$SETSTR^VALM1("LOCAL TITLE: "_TIUREC(8925,+TIUDA,.01),TIUY,2,64)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
S TIUY=""
I $L($G(TIUREC(8925,+TIUDA,89261))) D
. S TIUY=$$SETSTR^VALM1("STANDARD TITLE: "_TIUREC(8925,+TIUDA,89261),TIUY,1,64)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
S TIUY=""
I SHORT D
. S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),TIUY,1,39)
. S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),TIUY,42,38)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
S TIUY=""
I 'SHORT D
. I $L(TIUREC(8925,+TIUDA,1307)) D I 1
. . S TIUY=$$SETSTR^VALM1("DICT DATE: "_TIUREC(8925,+TIUDA,1307),TIUY,4,39)
. E S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),TIUY,1,39)
. S TIUY=$$SETSTR^VALM1("ENTRY DATE: "_TIUREC(8925,+TIUDA,1201),$G(TIUY),38,39)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
. S TIUY=""
. I $L(TIUREC(8925,+TIUDA,1307)) D I 1
. . S TIUY=$$SETSTR^VALM1("DICTATED BY: "_TIUREC(8925,+TIUDA,1202),TIUY,2,32)
. E S TIUY=$$SETSTR^VALM1("AUTHOR: "_TIUREC(8925,+TIUDA,1202),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),TIUY,2,32)
. I $L(TIUREC(8925,+TIUDA,1209)) D I 1
. . S TIUY=$$SETSTR^VALM1("ATTENDING: "_TIUREC(8925,+TIUDA,1209),TIUY,39,40)
. E S TIUY=$$SETSTR^VALM1("EXP COSIGNER: "_TIUREC(8925,+TIUDA,1208),TIUY,36,40)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
. S TIUY=""
. S TIUY=$$SETSTR^VALM1("URGENCY: "_TIUREC(8925,+TIUDA,.09),TIUY,6,36)
. S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),TIUY,42,38)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
; * 173
I TIUREC(8925,+TIUDA,.05)="UNCOSIGNED" D
. S TIUY="",TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
. S TIUY="",TIUL=TIUL+1,TIUY=$$SETSTR^VALM1("*** NOT YET COSIGNED ***",TIUY,20,51),@TIUARR@(TIUL)=TIUY
S TIUY=""
I '$L($G(^TIU(8925,+TIUDA,17))) D I 1
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
E D
. S TIUY=$$SETSTR^VALM1("SUBJECT: "_$G(^TIU(8925,+TIUDA,17)),TIUY,6,74)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
;If the document is a member of the Clinical Procedures Class, include the
; Procedure Summary Code field and the Date/Time Performed field
I $G(TIUCPF) D
. S TIUL=TIUL+1,TIUY=""
. S TIUY=$$SETSTR^VALM1("PROCEDURE SUMMARY CODE: "_TIUREC(8925,+TIUDA,70201),$G(TIUY),1,54)
. S @TIUARR@(TIUL)=TIUY
. S TIUL=TIUL+1,TIUY=""
. S TIUY=$$SETSTR^VALM1("DATE/TIME PERFORMED: "_TIUREC(8925,+TIUDA,70202),$G(TIUY),1,41)
. S @TIUARR@(TIUL)=TIUY
. S TIUL=TIUL+1,TIUY="",@TIUARR@(TIUL)=TIUY
I +$$HASADDEN^TIULC1(TIUDA) D
. S TIUY=" *** "_$$PNAME^TIULC1(+$G(^TIU(8925,TIUDA,0)))
. S TIUY=TIUY_" Has ADDENDA ***"
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
; *222 display header data for FORM LETTERS only
I +$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D
. D GUIVIEW^TIUFLP1(TIUDA,"HDR",.TIUL,.TIUARR)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
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
IDTOP(TIUDA,TIUL,SHORT,CURPRNT) ; Load entry-specific info:
;Title, [Location, Visit] for ID entry.
; Called by LOADTOP
N TIUY,TIUX,TIU
I CURPRNT S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=" << Interdisciplinary Note >>"
I SHORT S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=" << Interdisciplinary Note - Cont. >>"
D GETTIU^TIULD(.TIU,+TIUDA)
I 'SHORT D
. S TIUY="",TIUX="LOCATION: "_$P($G(TIU("LOC")),U,2)
. S TIUY=$$SETSTR^VALM1(TIUX,TIUY,1,31)
. I $L($G(TIU("WARD"))) D I 1
. . S TIUX="ADMISSION DATE: "_$P($G(TIU("EDT")),U,2)
. . S TIUY=$$SETSTR^VALM1(TIUX,TIUY,34,37)
. E D
. . S TIUX="VISIT DATE: "_$P($G(TIU("EDT")),U,2)
. . S TIUY=$$SETSTR^VALM1(TIUX,TIUY,38,33)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
S TIUY="",TIUX="LOCAL TITLE: "_$P($G(TIU("DOCTYP")),U,2)
S TIUY=$$SETSTR^VALM1(TIUX,TIUY,1,67)
S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVR1 7620 printed Apr 09, 2024@21:43:31 Page 2
TIUSRVR1 ; SLC/JER - RPC for record-wise GET ;8/16/06 11:48
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**19,32,87,89,100,109,112,173,186,208,211,222,295,304**;Jun 20, 1997;Build 1
+2 ;Per VHA Directive 2004-038, this routine should not be modified
TGET(TIUY,TIUDA,ACTION) ; Build ^TMP("TIUVIEW",$J,
+1 NEW TIUL,TIUREC,TIUARR,TIUGDATA,TIUNAME,TIUPRM0,TIUPRM1,X,Y,TIUCPF,ONBROWSE
+2 KILL ^TMP("TIUVIEW",$JOB),^TMP("TIU FOCUS",$JOB)
+3 SET ACTION=$GET(ACTION,"VIEW")
SET TIUL=0
+4 DO SETPARM^TIULE
+5 ; *304 init TIUY before checking if 8925 exists
+6 SET TIUY=$NAME(^TMP("TIUVIEW",$JOB))
+7 ; *295 next line moved up 3 lines to avoid error when TIUDA is null
+8 IF '$DATA(^TIU(8925,+$GET(TIUDA),0))
SET VALMQUIT=1
QUIT
+9 SET TIUGDATA=$$SETGDATA(TIUDA)
+10 ; *304 MOVE THIS LINE UP 2 LINES
+11 ;S TIUY=$NA(^TMP("TIUVIEW",$J))
+12 SET TIUARR="^TMP(""TIUVIEW"",$J)"
+13 ; Initialize ^TMP("TIU FOCUS",$J) to the entry that has focus
+14 SET ^TMP("TIU FOCUS",$JOB)=TIUDA
+15 ; if the document has a browse action, execute it
+16 SET ONBROWSE=$$ONBROWSE^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+17 IF $LENGTH(ONBROWSE)
DO LOADSUPP(ONBROWSE,TIUDA,.TIUL)
+18 ; Call INQUIRE to get record
+19 ;Set a flag to indicate whether or not a Title is a memer of the
+20 ;Clinical Procedures Class (1=Yes and 0=No)
+21 SET TIUCPF=+$$ISA^TIULX(+$GET(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
+22 ; Call INQUIRE to get record
+23 DO INQUIRE^TIUSRVR2(TIUDA,.TIUREC,TIUCPF)
+24 ; First, load dictation, transcription data, etc.
+25 DO LOADTOP(.TIUREC,TIUDA,.TIUL,TIUGDATA,TIUCPF)
+26 ; Next, load the remainder of the record
+27 DO LOADREC^TIUSRVR2(TIUDA,.TIUL,TIUGDATA,0,ACTION)
+28 ;
+29 ; *222 display closing & footer data for FORM LETTERS only
+30 IF +$$MEMBEROF^TIUPR222(+$GET(^TIU(8925,+TIUDA,0)),"FORM LETTERS")
Begin DoDot:1
+31 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
DO GUIVIEW^TIUFLP1(TIUDA,"CLS",.TIUL,.TIUARR)
+32 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
DO GUIVIEW^TIUFLP1(TIUDA,"FTR",.TIUL,.TIUARR)
End DoDot:1
+33 ;
+34 KILL ^TMP("TIU FOCUS",$JOB)
+35 SET VALMCNT=+$GET(TIUL)
+36 QUIT
SETGDATA(TIUDA) ; Set TIUGDATA
+1 NEW TIUDPRM,TIUY,SORT
SET TIUY=""
+2 DO DOCPRM^TIULC1(+$GET(^TIU(8925,TIUDA,0)),.TIUDPRM,TIUDA)
+3 SET SORT=$SELECT(+$PIECE(TIUDPRM(0),U,18):"TITLE",1:"REFDT")
+4 IF +$GET(^TIU(8925,TIUDA,21))
SET TIUY=TIUDA_U_0_U_+$GET(^(21))_U_SORT
GOTO SETGX
+5 IF +$ORDER(^TIU(8925,"GDAD",TIUDA,0))
SET TIUY=TIUDA_U_1_U_0_U_SORT
SETGX QUIT TIUY
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 @TIUARR@(TIUL,0)=$GET(@TIUY@(TIUI))
End DoDot:1
+5 SET TIUL=+$GET(TIUL)+1
SET @TIUARR@(TIUL,0)=" "
+6 KILL @TIUY
+7 QUIT
LOADTOP(TIUREC,TIUDA,TIUL,TIUGDATA,TIUCPF) ; Load top information
+1 NEW TIUY,SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT
+2 ; ---- For ID note, include Title, [Location, & Visit] with each
+3 ; entry, since they vary by entry.
+4 ; ---- Follow with Date, Author, etc.
+5 ; ---- For ID children in whole note display, shorten top info:
+6 ; Instead of Title, Location, Visit, Date, Author, etc.,
+7 ; use just Title, followed by just Date and Status:
+8 SET (SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT)=0
+9 ; Selected record was IDchild
IF $PIECE(TIUGDATA,U,3)
SET SELCHLD=1
+10 IF $PIECE(TIUGDATA,U,2)
SET SELPRNT=1
+11 ; Current rec is IDchild
IF SELCHLD
IF TIUDA'=$PIECE(TIUGDATA,U,3)
SET CURCHLD=1
+12 IF SELCHLD
IF TIUDA=$PIECE(TIUGDATA,U,3)
SET CURPRNT=1
+13 IF SELPRNT
IF TIUDA=+TIUGDATA
SET CURPRNT=1
+14 IF SELPRNT
IF TIUDA'=+TIUGDATA
SET CURCHLD=1
+15 ;Child in whole note: shorten top info
IF SELPRNT
IF CURCHLD
SET SHORT=1
+16 IF SELCHLD
IF CURCHLD
IF $GET(TIUGWHOL)
SET SHORT=1
+17 IF SELCHLD!SELPRNT
DO IDTOP(TIUDA,.TIUL,SHORT,CURPRNT)
IF 1
+18 SET TIUY=""
+19 IF '$TEST
IF $LENGTH(TIUREC(8925,+TIUDA,.01))
Begin DoDot:1
+20 SET TIUY=$$SETSTR^VALM1("LOCAL TITLE: "_TIUREC(8925,+TIUDA,.01),TIUY,2,64)
+21 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
+22 SET TIUY=""
+23 IF $LENGTH($GET(TIUREC(8925,+TIUDA,89261)))
Begin DoDot:1
+24 SET TIUY=$$SETSTR^VALM1("STANDARD TITLE: "_TIUREC(8925,+TIUDA,89261),TIUY,1,64)
+25 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
+26 SET TIUY=""
+27 IF SHORT
Begin DoDot:1
+28 SET TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),TIUY,1,39)
+29 SET TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),TIUY,42,38)
+30 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
+31 SET TIUY=""
+32 IF 'SHORT
Begin DoDot:1
+33 IF $LENGTH(TIUREC(8925,+TIUDA,1307))
Begin DoDot:2
+34 SET TIUY=$$SETSTR^VALM1("DICT DATE: "_TIUREC(8925,+TIUDA,1307),TIUY,4,39)
End DoDot:2
IF 1
+35 IF '$TEST
SET TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),TIUY,1,39)
+36 SET TIUY=$$SETSTR^VALM1("ENTRY DATE: "_TIUREC(8925,+TIUDA,1201),$GET(TIUY),38,39)
+37 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
+38 SET TIUY=""
+39 IF $LENGTH(TIUREC(8925,+TIUDA,1307))
Begin DoDot:2
+40 SET TIUY=$$SETSTR^VALM1("DICTATED BY: "_TIUREC(8925,+TIUDA,1202),TIUY,2,32)
End DoDot:2
IF 1
+41 IF '$TEST
SET TIUY=$$SETSTR^VALM1("AUTHOR: "_TIUREC(8925,+TIUDA,1202),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),TIUY,2,32)
+43 IF $LENGTH(TIUREC(8925,+TIUDA,1209))
Begin DoDot:2
+44 SET TIUY=$$SETSTR^VALM1("ATTENDING: "_TIUREC(8925,+TIUDA,1209),TIUY,39,40)
End DoDot:2
IF 1
+45 IF '$TEST
SET TIUY=$$SETSTR^VALM1("EXP COSIGNER: "_TIUREC(8925,+TIUDA,1208),TIUY,36,40)
+46 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
+47 SET TIUY=""
+48 SET TIUY=$$SETSTR^VALM1("URGENCY: "_TIUREC(8925,+TIUDA,.09),TIUY,6,36)
+49 SET TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),TIUY,42,38)
+50 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
+51 ; * 173
+52 IF TIUREC(8925,+TIUDA,.05)="UNCOSIGNED"
Begin DoDot:1
+53 SET TIUY=""
SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
+54 SET TIUY=""
SET TIUL=TIUL+1
SET TIUY=$$SETSTR^VALM1("*** NOT YET COSIGNED ***",TIUY,20,51)
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
+55 SET TIUY=""
+56 IF '$LENGTH($GET(^TIU(8925,+TIUDA,17)))
Begin DoDot:1
+57 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
IF 1
+58 IF '$TEST
Begin DoDot:1
+59 SET TIUY=$$SETSTR^VALM1("SUBJECT: "_$GET(^TIU(8925,+TIUDA,17)),TIUY,6,74)
+60 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
+61 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
End DoDot:1
+62 ;If the document is a member of the Clinical Procedures Class, include the
+63 ; Procedure Summary Code field and the Date/Time Performed field
+64 IF $GET(TIUCPF)
Begin DoDot:1
+65 SET TIUL=TIUL+1
SET TIUY=""
+66 SET TIUY=$$SETSTR^VALM1("PROCEDURE SUMMARY CODE: "_TIUREC(8925,+TIUDA,70201),$GET(TIUY),1,54)
+67 SET @TIUARR@(TIUL)=TIUY
+68 SET TIUL=TIUL+1
SET TIUY=""
+69 SET TIUY=$$SETSTR^VALM1("DATE/TIME PERFORMED: "_TIUREC(8925,+TIUDA,70202),$GET(TIUY),1,41)
+70 SET @TIUARR@(TIUL)=TIUY
+71 SET TIUL=TIUL+1
SET TIUY=""
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
+72 IF +$$HASADDEN^TIULC1(TIUDA)
Begin DoDot:1
+73 SET TIUY=" *** "_$$PNAME^TIULC1(+$GET(^TIU(8925,TIUDA,0)))
+74 SET TIUY=TIUY_" Has ADDENDA ***"
+75 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
+76 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
End DoDot:1
+77 ; *222 display header data for FORM LETTERS only
+78 IF +$$MEMBEROF^TIUPR222(+$GET(^TIU(8925,+TIUDA,0)),"FORM LETTERS")
Begin DoDot:1
+79 DO GUIVIEW^TIUFLP1(TIUDA,"HDR",.TIUL,.TIUARR)
+80 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
End DoDot:1
+81 QUIT
+82 ;
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
IDTOP(TIUDA,TIUL,SHORT,CURPRNT) ; Load entry-specific info:
+1 ;Title, [Location, Visit] for ID entry.
+2 ; Called by LOADTOP
+3 NEW TIUY,TIUX,TIU
+4 IF CURPRNT
SET TIUL=+$GET(TIUL)+1
SET @TIUARR@(TIUL)=" << Interdisciplinary Note >>"
+5 IF SHORT
SET TIUL=+$GET(TIUL)+1
SET @TIUARR@(TIUL)=" << Interdisciplinary Note - Cont. >>"
+6 DO GETTIU^TIULD(.TIU,+TIUDA)
+7 IF 'SHORT
Begin DoDot:1
+8 SET TIUY=""
SET TIUX="LOCATION: "_$PIECE($GET(TIU("LOC")),U,2)
+9 SET TIUY=$$SETSTR^VALM1(TIUX,TIUY,1,31)
+10 IF $LENGTH($GET(TIU("WARD")))
Begin DoDot:2
+11 SET TIUX="ADMISSION DATE: "_$PIECE($GET(TIU("EDT")),U,2)
+12 SET TIUY=$$SETSTR^VALM1(TIUX,TIUY,34,37)
End DoDot:2
IF 1
+13 IF '$TEST
Begin DoDot:2
+14 SET TIUX="VISIT DATE: "_$PIECE($GET(TIU("EDT")),U,2)
+15 SET TIUY=$$SETSTR^VALM1(TIUX,TIUY,38,33)
End DoDot:2
+16 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
End DoDot:1
+17 SET TIUY=""
SET TIUX="LOCAL TITLE: "_$PIECE($GET(TIU("DOCTYP")),U,2)
+18 SET TIUY=$$SETSTR^VALM1(TIUX,TIUY,1,67)
+19 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUY
+20 QUIT
