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