TIUGBR ; SLC/MAM - ID Browse Action Subroutines: HASIDKID, HASIDDAD, DADORKID, IDTOP, LOADID, GETKIDS ;8/16/06 13:32
;;1.0;TEXT INTEGRATION UTILITIES;**100,211**;Jun 20, 1997;Build 26
; Similar to TIUBR, but for ID notes
;
GETKIDS(TIUDA) ; Set ID kids of TIUDA into array
; ^TMP("TIUGKID",$J,REFERENCE DATE,TIUKID)="":
N TIUKID,REFDATE
S TIUKID=0
F S TIUKID=$O(^TIU(8925,"GDAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
. S REFDATE=+$G(^TIU(8925,TIUKID,13))
. S ^TMP("TIUGKID",$J,REFDATE,TIUKID)=""
Q
;
HASIDKID(DA) ; Function returns 1 if DA has ID kid, else 0.
N TIUY
S TIUY=0
I $O(^TIU(8925,"GDAD",+DA,0)) S TIUY=1
Q TIUY
;
HASIDDAD(DA) ; Function returns ID parent of DA if DA has parent; else 0.
Q +$G(^TIU(8925,DA,21),0)
;
DADORKID(DA) ; Function returns DA if DA has ID kid,
;or ID dad IFN if DA has ID dad, else 0.
N TIUY
S TIUY=0
I $O(^TIU(8925,"GDAD",+DA,0)) S TIUY=DA G ORKIDX
I +$G(^TIU(8925,DA,21)) S TIUY=^TIU(8925,DA,21)
ORKIDX Q TIUY
;
IDTOP(TIUDA,TIUL,SHORT,CURPRNT) ; Load entry-specific info:
;Title, [Location, Visit] for ID entry.
; Called by LOADTOP^TIUBR
N TIUY,TIU,DFN
I CURPRNT S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" << Interdisciplinary Note >>"
I SHORT S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" << Interdisciplinary Note - Cont. >>"
D GETTIU^TIULD(.TIU,+TIUDA)
I 'SHORT D
. S TIUL=$G(TIUL)+1,TIUY=""
. S TIUY=$$SETSTR^VALM1("LOCATION: "_$P($G(TIU("LOC")),U,2),$G(TIUY),1,31)
. I $L($G(TIU("WARD"))) S TIUY=$$SETSTR^VALM1("ADMISSION DATE: "_$P($G(TIU("EDT")),U,2),$G(TIUY),34,37) I 1
. E S TIUY=$$SETSTR^VALM1("VISIT DATE: "_$P($G(TIU("EDT")),U,2),$G(TIUY),38,33)
. S @VALMAR@(TIUL,0)=TIUY
S TIUL=+$G(TIUL)+1,TIUY=""
S TIUY=$$SETSTR^VALM1("LOCAL TITLE: "_$P($G(TIU("DOCTYP")),U,2),$G(TIUY),1,67)
S @VALMAR@(TIUL,0)=TIUY
Q
;
LOADID(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID entry TIUDA for browse
; Requires TIUDA, array TIUL, TIUGDATA;
; Optional TIUGWHOL (see rtn TIUBR).
N TIUREC,TIU,DFN
I '$D(^TIU(8925,+TIUDA,0)) S VALMQUIT=1 Q
; ---- If ID Kid has focus, don't show it again ----
; I +$G(^TMP("TIU FOCUS",$J))=TIUDA Q
S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
D GETTIU^TIULD(.TIU,+TIUDA)
D INQUIRE(TIUDA,.TIUREC)
; ---- Load info missing from header since this is ID note entry: ----
; ---- Load dictation, transcription data, etc.: ----
D LOADTOP^TIUBR(.TIUREC,TIUDA,.TIUL,TIUGDATA)
; ---- Load the remainder of the record: ----
D LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
Q
;
INQUIRE(TIUDA,TIUREC) ; Inquire to document TIUDA and set TIUREC
N DA,DIC,DIQ,DR
S DA=TIUDA,DIC=8925,DIQ="TIUREC("
S DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506;89261"
D EN^DIQ1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUGBR 2787 printed Oct 16, 2024@18:42:08 Page 2
TIUGBR ; SLC/MAM - ID Browse Action Subroutines: HASIDKID, HASIDDAD, DADORKID, IDTOP, LOADID, GETKIDS ;8/16/06 13:32
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,211**;Jun 20, 1997;Build 26
+2 ; Similar to TIUBR, but for ID notes
+3 ;
GETKIDS(TIUDA) ; Set ID kids of TIUDA into array
+1 ; ^TMP("TIUGKID",$J,REFERENCE DATE,TIUKID)="":
+2 NEW TIUKID,REFDATE
+3 SET TIUKID=0
+4 FOR
SET TIUKID=$ORDER(^TIU(8925,"GDAD",+TIUDA,TIUKID))
if +TIUKID'>0
QUIT
Begin DoDot:1
+5 SET REFDATE=+$GET(^TIU(8925,TIUKID,13))
+6 SET ^TMP("TIUGKID",$JOB,REFDATE,TIUKID)=""
End DoDot:1
+7 QUIT
+8 ;
HASIDKID(DA) ; Function returns 1 if DA has ID kid, else 0.
+1 NEW TIUY
+2 SET TIUY=0
+3 IF $ORDER(^TIU(8925,"GDAD",+DA,0))
SET TIUY=1
+4 QUIT TIUY
+5 ;
HASIDDAD(DA) ; Function returns ID parent of DA if DA has parent; else 0.
+1 QUIT +$GET(^TIU(8925,DA,21),0)
+2 ;
DADORKID(DA) ; Function returns DA if DA has ID kid,
+1 ;or ID dad IFN if DA has ID dad, else 0.
+2 NEW TIUY
+3 SET TIUY=0
+4 IF $ORDER(^TIU(8925,"GDAD",+DA,0))
SET TIUY=DA
GOTO ORKIDX
+5 IF +$GET(^TIU(8925,DA,21))
SET TIUY=^TIU(8925,DA,21)
ORKIDX QUIT TIUY
+1 ;
IDTOP(TIUDA,TIUL,SHORT,CURPRNT) ; Load entry-specific info:
+1 ;Title, [Location, Visit] for ID entry.
+2 ; Called by LOADTOP^TIUBR
+3 NEW TIUY,TIU,DFN
+4 IF CURPRNT
SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" << Interdisciplinary Note >>"
+5 IF SHORT
SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=" << Interdisciplinary Note - Cont. >>"
+6 DO GETTIU^TIULD(.TIU,+TIUDA)
+7 IF 'SHORT
Begin DoDot:1
+8 SET TIUL=$GET(TIUL)+1
SET TIUY=""
+9 SET TIUY=$$SETSTR^VALM1("LOCATION: "_$PIECE($GET(TIU("LOC")),U,2),$GET(TIUY),1,31)
+10 IF $LENGTH($GET(TIU("WARD")))
SET TIUY=$$SETSTR^VALM1("ADMISSION DATE: "_$PIECE($GET(TIU("EDT")),U,2),$GET(TIUY),34,37)
IF 1
+11 IF '$TEST
SET TIUY=$$SETSTR^VALM1("VISIT DATE: "_$PIECE($GET(TIU("EDT")),U,2),$GET(TIUY),38,33)
+12 SET @VALMAR@(TIUL,0)=TIUY
End DoDot:1
+13 SET TIUL=+$GET(TIUL)+1
SET TIUY=""
+14 SET TIUY=$$SETSTR^VALM1("LOCAL TITLE: "_$PIECE($GET(TIU("DOCTYP")),U,2),$GET(TIUY),1,67)
+15 SET @VALMAR@(TIUL,0)=TIUY
+16 QUIT
+17 ;
LOADID(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID entry TIUDA for browse
+1 ; Requires TIUDA, array TIUL, TIUGDATA;
+2 ; Optional TIUGWHOL (see rtn TIUBR).
+3 NEW TIUREC,TIU,DFN
+4 IF '$DATA(^TIU(8925,+TIUDA,0))
SET VALMQUIT=1
QUIT
+5 ; ---- If ID Kid has focus, don't show it again ----
+6 ; I +$G(^TMP("TIU FOCUS",$J))=TIUDA Q
+7 SET TIUL=+$GET(TIUL)+1
SET @VALMAR@(TIUL,0)=""
+8 DO GETTIU^TIULD(.TIU,+TIUDA)
+9 DO INQUIRE(TIUDA,.TIUREC)
+10 ; ---- Load info missing from header since this is ID note entry: ----
+11 ; ---- Load dictation, transcription data, etc.: ----
+12 DO LOADTOP^TIUBR(.TIUREC,TIUDA,.TIUL,TIUGDATA)
+13 ; ---- Load the remainder of the record: ----
+14 DO LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA,$GET(TIUGWHOL))
+15 QUIT
+16 ;
INQUIRE(TIUDA,TIUREC) ; Inquire to document TIUDA and set TIUREC
+1 NEW DA,DIC,DIQ,DR
+2 SET DA=TIUDA
SET DIC=8925
SET DIQ="TIUREC("
+3 SET DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506;89261"
+4 DO EN^DIQ1
+5 QUIT
