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