- 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 Jan 18, 2025@03:47:11 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