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

TIUSRVR.m

Go to the documentation of this file.
  1. TIUSRVR ; SLC/JER - Server fns for record manipulation ; 01/22/2002 16:18
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**19,28,69,89,122,109,112,186,290**;Jun 20, 1997;Build 548
  1. SGET(TIUY,DA) ; Get fixed fields for record TIUDA
  1. N DOC,LOC,PT,AUT,EDT,DTFMT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13
  1. N SUBJ,TIUCNT
  1. S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
  1. S TIUR13=$G(^TIU(8925,+DA,13)),TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))
  1. S SUBJ=$G(^TIU(8925,+DA,17))
  1. S DOC=$$PNAME^TIULC1(+TIUR0)
  1. S LOC=$P($G(^SC(+$P(TIUR12,U,5),0)),U)
  1. S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")
  1. S TIULST4=$E($P(TIUPT,U,9),6,9)
  1. S TIULST4="("_$E(PT)_TIULST4_")"
  1. S AUT=$$SIGNAME^TIULS(+$P(TIUR12,U,2))
  1. S DTFMT=$S($L(+TIUR13,".")=2:"MM/DD/YY HR:MIN",1:"MM/DD/YY")
  1. S EDT=$$DATE^TIULS(+TIUR13,DTFMT)
  1. S TIUCNT=+$G(TIUCNT)+1
  1. S TIUY=DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_SUBJ
  1. Q
  1. TGET(TIUY,TIUDA,TIUJ,TIUDAD) ; Get each component
  1. N TIUKID,TIUDADT,TIUI,TIUSEE S TIUI=0
  1. S TIUSEE=$$CANDO^TIULP(TIUDA,"VIEW")
  1. I '+TIUSEE D Q
  1. . S TIUY(1)=" "
  1. . S TIUY(2)=$P(TIUSEE,"^ ",2),(TIUI,TIUJ)=2
  1. F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
  1. . S TIUJ=+$G(TIUJ)+1
  1. . S TIUY(TIUJ)=$G(^TIU(8925,+TIUDA,"TEXT",TIUI,0))
  1. . ;S ^TMP("TIUTEXT",$J,TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEXT",TIUI,0))
  1. ; Iterate through children, and get their text fields
  1. S TIUKID=0
  1. F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
  1. . D TGET(.TIUY,TIUKID,.TIUJ,$G(TIUDAD,TIUDA))
  1. ;I $D(^TMP("TIUTEXT",$J)) S TIUY="^TMP(""TIUTEXT"",$J)"
  1. Q
  1. GET4EDIT(TIUY,TIUDA,DR) ; Get data in preparation for editing a record
  1. N CANEDIT,ERR,D0,DIQ2,TIUARR,TIUF,TIUI
  1. I +$D(^TIU(8925,TIUDA,"TEMP")),'+$$IFTEXT() D MERGTEXT(TIUDA)
  1. K ^TMP("TIUEDIT",$J),^TMP("TIULQ",$J)
  1. S TIUY=$NA(^TMP("TIUEDIT",$J)),TIUARR=$NA(^TMP("TIULQ",$J))
  1. S CANEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
  1. I +CANEDIT'>0 S ^TMP("TIUEDIT",$J,0)="~"_$P(CANEDIT,U,2) Q
  1. D EXTRACT^TIULQ(TIUDA,TIUARR,.ERR,$G(DR),"",1,"IE",1)
  1. I $D(ERR) M TIUY=ERR Q
  1. S TIUF=0
  1. F S TIUF=$O(@TIUARR@(TIUDA,TIUF)) Q:+TIUF'>0 D
  1. . S ^TMP("TIUEDIT",$J,TIUF)=TIUF_U_@TIUARR@(TIUDA,TIUF,"I")_U_@TIUARR@(TIUDA,TIUF,"E")
  1. S TIUI=0
  1. F S TIUI=$O(@TIUARR@(TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
  1. . S ^TMP("TIUEDIT",$J,"TEXT",TIUI)=$G(@TIUARR@(TIUDA,"TEXT",TIUI,0))
  1. S ^TMP("TIUEDIT",$J,"TEXT",0)="$TXT",^TIU(8925,"ASAVE",DUZ,TIUDA)=""
  1. K @TIUARR
  1. Q
  1. CPGT4EDT(TIUY,TIUDA) ; Get data in preparation for editing a record
  1. ;Copy/Paste needs to retrieve text in edit mode to manipulate, but
  1. ;we don't want the system to think it is being edited.
  1. N CANEDIT,TIUERR,D0,DIQ2,TIUROOT,TIUF,TIUI
  1. S DR=""
  1. I +$D(^TIU(8925,TIUDA,"TEMP")),'+$$IFTEXT() D MERGTEXT(TIUDA)
  1. K ^TMP("TIUEDIT",$J),^TMP("TIULQ",$J)
  1. S TIUY=$NA(^TMP("TIUEDIT",$J)),TIUROOT=$NA(^TMP("TIULQ",$J))
  1. S CANEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
  1. I +CANEDIT'>0 S ^TMP("TIUEDIT",$J,0)="~"_$P(CANEDIT,U,2) Q
  1. ;D EXTRACT^TIULQ(TIUDA,TIUROOT,.ERR,$G(DR),"",1,"IE",1)
  1. I +$D(^TIU(8925,TIUDA,"TEMP")) D TEMP^TIULQ(TIUDA,0,TIUDA,1)
  1. I '+$D(^TIU(8925,TIUDA,"TEMP")) D TEXT^TIULQ(TIUDA,0,TIUDA,1,0)
  1. I $D(TIUERR) M TIUY=TIUERR Q
  1. ;S TIUF=0
  1. ;F S TIUF=$O(@TIUROOT@(TIUDA,TIUF)) Q:+TIUF'>0 D
  1. ;. S ^TMP("TIUEDIT",$J,TIUF)=TIUF_U_@TIUROOT@(TIUDA,TIUF,"I")_U_@TIUROOT@(TIUDA,TIUF,"E")
  1. S TIUI=0
  1. F S TIUI=$O(@TIUROOT@(TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
  1. . S ^TMP("TIUEDIT",$J,"TEXT",TIUI)=$G(@TIUROOT@(TIUDA,"TEXT",TIUI,0))
  1. S ^TMP("TIUEDIT",$J,"TEXT",0)="$TXT"
  1. K @TIUROOT
  1. Q
  1. IFTEXT() ;
  1. N TIUCHK
  1. S TIUCHK=0 F S TIUCHK=$O(^TIU(8925,TIUDA,"TEXT",TIUCHK)) Q:TIUCHK=""!TIUCHK>0
  1. Q TIUCHK
  1. GETPREF(TIUY,USER) ; Get user's personal preferences
  1. ; Call with TIUY (by ref)
  1. ; USER is pointer to file 200
  1. ; Returns TIUY = USER ^ DEFAULT LOCATION ^ REVIEW SCREEN SORT FIELD ^
  1. ; ==>REVIEW SCREEN SORT ORDER ^ DISPLAY MENUS ^ PATIENT
  1. ; ==>SELECTION PREFERENCE ^ ASK 'Save changes?' AFTER
  1. ; ==>EDIT ^ ASK SUBJECT FOR PROGRESS NOTES ^
  1. S TIUY=$$PERSPRF^TIULE(USER)
  1. Q
  1. GETALRT(TIUY,XQAID) ; Retrieve DFN and document type for a TIU alert
  1. N X,TIUDA,TIUDFN,ORTAB,TIUDAD,GMRCO
  1. S TIUDA=$TR($P(XQAID,";",1),"ABCDEFGHIJKLMNOPQRSTUVWXYZ") ; Strip Text
  1. I '+TIUDA!('$D(^TIU(8925,+TIUDA,0))) S TIUY="-1" Q
  1. S X=$P($G(^TIU(8925,TIUDA,0)),U)
  1. S TIUDFN=$P(^TIU(8925,TIUDA,0),U,2)
  1. I $P(^TIU(8925,TIUDA,0),U,6)'="" D
  1. . S TIUDAD=$P(^TIU(8925,TIUDA,0),U,6)
  1. . S X=$P($G(^TIU(8925,TIUDAD,0)),U)
  1. I ('+X)!('+TIUDFN) S TIUY="-1" Q
  1. S ORTAB=903 ;DEFAULT TO PN
  1. I +$$ISDS^TIULX(X) S ORTAB=901
  1. I +$$ISA^TIULX(X,$$CLASS^TIUSROI("SURGICAL REPORTS")) S ORTAB=904
  1. I +$$ISA^TIULX(X,$$CLASS^TIUCNSLT)!(+$$ISA^TIULX(X,+$$CLASS^TIUCP)) D
  1. . S GMRCO=$P(^TIU(8925,$S(+$G(TIUDAD):TIUDAD,1:TIUDA),14),U,5)
  1. . S ORTAB=902_";"_GMRCO
  1. S TIUY=TIUDA_U_TIUDFN_U_ORTAB
  1. Q
  1. GET1405(TIUY,TIUDA) ; Get the Request (field #1405) for a document
  1. N TIUDAD,TIUTYP,TIU1405
  1. I '+TIUDA!('$D(^TIU(8925,+TIUDA,0))) S TIUY="-1^TIU Document does not exist" Q
  1. S TIUTYP=$P($G(^TIU(8925,TIUDA,0)),U)
  1. I $P(^TIU(8925,TIUDA,0),U,6)'="" D
  1. . S TIUDAD=$P(^TIU(8925,TIUDA,0),U,6)
  1. . S TIUTYP=$P($G(^TIU(8925,TIUDAD,0)),U)
  1. I '+TIUTYP S TIUY="-1^TIU parent document does not exist" Q
  1. S TIU1405=$P($G(^TIU(8925,$S(+$G(TIUDAD):TIUDAD,1:TIUDA),14)),U,5)
  1. I '+TIU1405 S TIUY="-1^No Request found for this document" Q
  1. S TIUY=TIU1405
  1. Q
  1. MERGTEXT(TIUDA) ; Merge text from "TEMP"-node to "TEXT"-node
  1. N TIU
  1. D CLEANTXT(TIUDA)
  1. D GETTIU^TIULD(.TIU,TIUDA)
  1. D MERGTEXT^TIUEDI1(TIUDA,.TIU)
  1. K ^TIU(8925,TIUDA,"TEMP")
  1. Q
  1. CLEANTXT(TIUDA) ; Remove "TEXT"-nodes of document and components
  1. N TIUI S TIUI=0
  1. K ^TIU(8925,TIUDA,"TEXT")
  1. F S TIUI=$O(^TIU(8925,"DAD",TIUDA,TIUI)) Q:+TIUI'>0 D
  1. . I +$$ISADDNDM^TIULC1(TIUI) Q
  1. . K ^TIU(8925,TIUI,"TEXT")
  1. Q