Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUSRVR1

TIUSRVR1.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified
  1. TGET(TIUY,TIUDA,ACTION) ; Build ^TMP("TIUVIEW",$J,
  1. N TIUL,TIUREC,TIUARR,TIUGDATA,TIUNAME,TIUPRM0,TIUPRM1,X,Y,TIUCPF,ONBROWSE
  1. K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J)
  1. S ACTION=$G(ACTION,"VIEW"),TIUL=0
  1. D SETPARM^TIULE
  1. ; *304 init TIUY before checking if 8925 exists
  1. S TIUY=$NA(^TMP("TIUVIEW",$J))
  1. ; *295 next line moved up 3 lines to avoid error when TIUDA is null
  1. I '$D(^TIU(8925,+$G(TIUDA),0)) S VALMQUIT=1 Q
  1. S TIUGDATA=$$SETGDATA(TIUDA)
  1. ; *304 MOVE THIS LINE UP 2 LINES
  1. ;S TIUY=$NA(^TMP("TIUVIEW",$J))
  1. S TIUARR="^TMP(""TIUVIEW"",$J)"
  1. ; Initialize ^TMP("TIU FOCUS",$J) to the entry that has focus
  1. S ^TMP("TIU FOCUS",$J)=TIUDA
  1. ; if the document has a browse action, execute it
  1. S ONBROWSE=$$ONBROWSE^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
  1. I $L(ONBROWSE) D LOADSUPP(ONBROWSE,TIUDA,.TIUL)
  1. ; Call INQUIRE to get record
  1. ;Set a flag to indicate whether or not a Title is a memer of the
  1. ;Clinical Procedures Class (1=Yes and 0=No)
  1. S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
  1. ; Call INQUIRE to get record
  1. D INQUIRE^TIUSRVR2(TIUDA,.TIUREC,TIUCPF)
  1. ; First, load dictation, transcription data, etc.
  1. D LOADTOP(.TIUREC,TIUDA,.TIUL,TIUGDATA,TIUCPF)
  1. ; Next, load the remainder of the record
  1. D LOADREC^TIUSRVR2(TIUDA,.TIUL,TIUGDATA,0,ACTION)
  1. ;
  1. ; *222 display closing & footer data for FORM LETTERS only
  1. I +$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)="" D GUIVIEW^TIUFLP1(TIUDA,"CLS",.TIUL,.TIUARR)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)="" D GUIVIEW^TIUFLP1(TIUDA,"FTR",.TIUL,.TIUARR)
  1. ;
  1. K ^TMP("TIU FOCUS",$J)
  1. S VALMCNT=+$G(TIUL)
  1. Q
  1. SETGDATA(TIUDA) ; Set TIUGDATA
  1. N TIUDPRM,TIUY,SORT S TIUY=""
  1. D DOCPRM^TIULC1(+$G(^TIU(8925,TIUDA,0)),.TIUDPRM,TIUDA)
  1. S SORT=$S(+$P(TIUDPRM(0),U,18):"TITLE",1:"REFDT")
  1. I +$G(^TIU(8925,TIUDA,21)) S TIUY=TIUDA_U_0_U_+$G(^(21))_U_SORT G SETGX
  1. I +$O(^TIU(8925,"GDAD",TIUDA,0)) S TIUY=TIUDA_U_1_U_0_U_SORT
  1. SETGX Q TIUY
  1. LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
  1. N TIUY,TIUI S TIUI=0
  1. X METHOD I '$D(@TIUY) Q
  1. F S TIUI=$O(@TIUY@(TIUI)) Q:+TIUI'>0 D
  1. . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL,0)=$G(@TIUY@(TIUI))
  1. S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL,0)=" "
  1. K @TIUY
  1. Q
  1. LOADTOP(TIUREC,TIUDA,TIUL,TIUGDATA,TIUCPF) ; Load top information
  1. N TIUY,SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT
  1. ; ---- For ID note, include Title, [Location, & Visit] with each
  1. ; entry, since they vary by entry.
  1. ; ---- Follow with Date, Author, etc.
  1. ; ---- For ID children in whole note display, shorten top info:
  1. ; Instead of Title, Location, Visit, Date, Author, etc.,
  1. ; use just Title, followed by just Date and Status:
  1. S (SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT)=0
  1. I $P(TIUGDATA,U,3) S SELCHLD=1 ; Selected record was IDchild
  1. I $P(TIUGDATA,U,2) S SELPRNT=1
  1. I SELCHLD,TIUDA'=$P(TIUGDATA,U,3) S CURCHLD=1 ; Current rec is IDchild
  1. I SELCHLD,TIUDA=$P(TIUGDATA,U,3) S CURPRNT=1
  1. I SELPRNT,TIUDA=+TIUGDATA S CURPRNT=1
  1. I SELPRNT,TIUDA'=+TIUGDATA S CURCHLD=1
  1. I SELPRNT,CURCHLD S SHORT=1 ;Child in whole note: shorten top info
  1. I SELCHLD,CURCHLD,$G(TIUGWHOL) S SHORT=1
  1. I SELCHLD!SELPRNT D IDTOP(TIUDA,.TIUL,SHORT,CURPRNT) I 1
  1. S TIUY=""
  1. E I $L(TIUREC(8925,+TIUDA,.01)) D
  1. . S TIUY=$$SETSTR^VALM1("LOCAL TITLE: "_TIUREC(8925,+TIUDA,.01),TIUY,2,64)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. S TIUY=""
  1. I $L($G(TIUREC(8925,+TIUDA,89261))) D
  1. . S TIUY=$$SETSTR^VALM1("STANDARD TITLE: "_TIUREC(8925,+TIUDA,89261),TIUY,1,64)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. S TIUY=""
  1. I SHORT D
  1. . S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),TIUY,1,39)
  1. . S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),TIUY,42,38)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. S TIUY=""
  1. I 'SHORT D
  1. . I $L(TIUREC(8925,+TIUDA,1307)) D I 1
  1. . . S TIUY=$$SETSTR^VALM1("DICT DATE: "_TIUREC(8925,+TIUDA,1307),TIUY,4,39)
  1. . E S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),TIUY,1,39)
  1. . S TIUY=$$SETSTR^VALM1("ENTRY DATE: "_TIUREC(8925,+TIUDA,1201),$G(TIUY),38,39)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. . S TIUY=""
  1. . I $L(TIUREC(8925,+TIUDA,1307)) D I 1
  1. . . S TIUY=$$SETSTR^VALM1("DICTATED BY: "_TIUREC(8925,+TIUDA,1202),TIUY,2,32)
  1. . E S TIUY=$$SETSTR^VALM1("AUTHOR: "_TIUREC(8925,+TIUDA,1202),TIUY,7,27)
  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),TIUY,2,32)
  1. . I $L(TIUREC(8925,+TIUDA,1209)) D I 1
  1. . . S TIUY=$$SETSTR^VALM1("ATTENDING: "_TIUREC(8925,+TIUDA,1209),TIUY,39,40)
  1. . E S TIUY=$$SETSTR^VALM1("EXP COSIGNER: "_TIUREC(8925,+TIUDA,1208),TIUY,36,40)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. . S TIUY=""
  1. . S TIUY=$$SETSTR^VALM1("URGENCY: "_TIUREC(8925,+TIUDA,.09),TIUY,6,36)
  1. . S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),TIUY,42,38)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. ; * 173
  1. I TIUREC(8925,+TIUDA,.05)="UNCOSIGNED" D
  1. . S TIUY="",TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. . S TIUY="",TIUL=TIUL+1,TIUY=$$SETSTR^VALM1("*** NOT YET COSIGNED ***",TIUY,20,51),@TIUARR@(TIUL)=TIUY
  1. S TIUY=""
  1. I '$L($G(^TIU(8925,+TIUDA,17))) D I 1
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. E D
  1. . S TIUY=$$SETSTR^VALM1("SUBJECT: "_$G(^TIU(8925,+TIUDA,17)),TIUY,6,74)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1. ;If the document is a member of the Clinical Procedures Class, include the
  1. ; Procedure Summary Code field and the Date/Time Performed field
  1. I $G(TIUCPF) D
  1. . S TIUL=TIUL+1,TIUY=""
  1. . S TIUY=$$SETSTR^VALM1("PROCEDURE SUMMARY CODE: "_TIUREC(8925,+TIUDA,70201),$G(TIUY),1,54)
  1. . S @TIUARR@(TIUL)=TIUY
  1. . S TIUL=TIUL+1,TIUY=""
  1. . S TIUY=$$SETSTR^VALM1("DATE/TIME PERFORMED: "_TIUREC(8925,+TIUDA,70202),$G(TIUY),1,41)
  1. . S @TIUARR@(TIUL)=TIUY
  1. . S TIUL=TIUL+1,TIUY="",@TIUARR@(TIUL)=TIUY
  1. I +$$HASADDEN^TIULC1(TIUDA) D
  1. . S TIUY=" *** "_$$PNAME^TIULC1(+$G(^TIU(8925,TIUDA,0)))
  1. . S TIUY=TIUY_" Has ADDENDA ***"
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1. ; *222 display header data for FORM LETTERS only
  1. I +$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D
  1. . D GUIVIEW^TIUFLP1(TIUDA,"HDR",.TIUL,.TIUARR)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1. Q
  1. ;
  1. ISCOMP(DA) ; Evaluate whether a given record is a component
  1. N TIUY,TIUTYP
  1. S TIUTYP=+$G(^TIU(8925,DA,0))
  1. S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
  1. Q TIUY
  1. IDTOP(TIUDA,TIUL,SHORT,CURPRNT) ; Load entry-specific info:
  1. ;Title, [Location, Visit] for ID entry.
  1. ; Called by LOADTOP
  1. N TIUY,TIUX,TIU
  1. I CURPRNT S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=" << Interdisciplinary Note >>"
  1. I SHORT S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=" << Interdisciplinary Note - Cont. >>"
  1. D GETTIU^TIULD(.TIU,+TIUDA)
  1. I 'SHORT D
  1. . S TIUY="",TIUX="LOCATION: "_$P($G(TIU("LOC")),U,2)
  1. . S TIUY=$$SETSTR^VALM1(TIUX,TIUY,1,31)
  1. . I $L($G(TIU("WARD"))) D I 1
  1. . . S TIUX="ADMISSION DATE: "_$P($G(TIU("EDT")),U,2)
  1. . . S TIUY=$$SETSTR^VALM1(TIUX,TIUY,34,37)
  1. . E D
  1. . . S TIUX="VISIT DATE: "_$P($G(TIU("EDT")),U,2)
  1. . . S TIUY=$$SETSTR^VALM1(TIUX,TIUY,38,33)
  1. . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. S TIUY="",TIUX="LOCAL TITLE: "_$P($G(TIU("DOCTYP")),U,2)
  1. S TIUY=$$SETSTR^VALM1(TIUX,TIUY,1,67)
  1. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUY
  1. Q