- 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 Feb 19, 2025@00:07:59 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