| [613] | 1 | TIUGBR ; SLC/MAM - ID Browse Action Subroutines: HASIDKID, HASIDDAD, DADORKID, IDTOP, LOADID, GETKIDS ;8/16/06 13:32
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**100,211**;Jun 20, 1997;Build 26
|
|---|
| 3 | ; Similar to TIUBR, but for ID notes
|
|---|
| 4 | ;
|
|---|
| 5 | GETKIDS(TIUDA) ; Set ID kids of TIUDA into array
|
|---|
| 6 | ; ^TMP("TIUGKID",$J,REFERENCE DATE,TIUKID)="":
|
|---|
| 7 | N TIUKID,REFDATE
|
|---|
| 8 | S TIUKID=0
|
|---|
| 9 | F S TIUKID=$O(^TIU(8925,"GDAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
|
|---|
| 10 | . S REFDATE=+$G(^TIU(8925,TIUKID,13))
|
|---|
| 11 | . S ^TMP("TIUGKID",$J,REFDATE,TIUKID)=""
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | HASIDKID(DA) ; Function returns 1 if DA has ID kid, else 0.
|
|---|
| 15 | N TIUY
|
|---|
| 16 | S TIUY=0
|
|---|
| 17 | I $O(^TIU(8925,"GDAD",+DA,0)) S TIUY=1
|
|---|
| 18 | Q TIUY
|
|---|
| 19 | ;
|
|---|
| 20 | HASIDDAD(DA) ; Function returns ID parent of DA if DA has parent; else 0.
|
|---|
| 21 | Q +$G(^TIU(8925,DA,21),0)
|
|---|
| 22 | ;
|
|---|
| 23 | DADORKID(DA) ; Function returns DA if DA has ID kid,
|
|---|
| 24 | ;or ID dad IFN if DA has ID dad, else 0.
|
|---|
| 25 | N TIUY
|
|---|
| 26 | S TIUY=0
|
|---|
| 27 | I $O(^TIU(8925,"GDAD",+DA,0)) S TIUY=DA G ORKIDX
|
|---|
| 28 | I +$G(^TIU(8925,DA,21)) S TIUY=^TIU(8925,DA,21)
|
|---|
| 29 | ORKIDX Q TIUY
|
|---|
| 30 | ;
|
|---|
| 31 | IDTOP(TIUDA,TIUL,SHORT,CURPRNT) ; Load entry-specific info:
|
|---|
| 32 | ;Title, [Location, Visit] for ID entry.
|
|---|
| 33 | ; Called by LOADTOP^TIUBR
|
|---|
| 34 | N TIUY,TIU,DFN
|
|---|
| 35 | I CURPRNT S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" << Interdisciplinary Note >>"
|
|---|
| 36 | I SHORT S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" << Interdisciplinary Note - Cont. >>"
|
|---|
| 37 | D GETTIU^TIULD(.TIU,+TIUDA)
|
|---|
| 38 | I 'SHORT D
|
|---|
| 39 | . S TIUL=$G(TIUL)+1,TIUY=""
|
|---|
| 40 | . S TIUY=$$SETSTR^VALM1("LOCATION: "_$P($G(TIU("LOC")),U,2),$G(TIUY),1,31)
|
|---|
| 41 | . I $L($G(TIU("WARD"))) S TIUY=$$SETSTR^VALM1("ADMISSION DATE: "_$P($G(TIU("EDT")),U,2),$G(TIUY),34,37) I 1
|
|---|
| 42 | . E S TIUY=$$SETSTR^VALM1("VISIT DATE: "_$P($G(TIU("EDT")),U,2),$G(TIUY),38,33)
|
|---|
| 43 | . S @VALMAR@(TIUL,0)=TIUY
|
|---|
| 44 | S TIUL=+$G(TIUL)+1,TIUY=""
|
|---|
| 45 | S TIUY=$$SETSTR^VALM1("LOCAL TITLE: "_$P($G(TIU("DOCTYP")),U,2),$G(TIUY),1,67)
|
|---|
| 46 | S @VALMAR@(TIUL,0)=TIUY
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | LOADID(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID entry TIUDA for browse
|
|---|
| 50 | ; Requires TIUDA, array TIUL, TIUGDATA;
|
|---|
| 51 | ; Optional TIUGWHOL (see rtn TIUBR).
|
|---|
| 52 | N TIUREC,TIU,DFN
|
|---|
| 53 | I '$D(^TIU(8925,+TIUDA,0)) S VALMQUIT=1 Q
|
|---|
| 54 | ; ---- If ID Kid has focus, don't show it again ----
|
|---|
| 55 | ; I +$G(^TMP("TIU FOCUS",$J))=TIUDA Q
|
|---|
| 56 | S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
|
|---|
| 57 | D GETTIU^TIULD(.TIU,+TIUDA)
|
|---|
| 58 | D INQUIRE(TIUDA,.TIUREC)
|
|---|
| 59 | ; ---- Load info missing from header since this is ID note entry: ----
|
|---|
| 60 | ; ---- Load dictation, transcription data, etc.: ----
|
|---|
| 61 | D LOADTOP^TIUBR(.TIUREC,TIUDA,.TIUL,TIUGDATA)
|
|---|
| 62 | ; ---- Load the remainder of the record: ----
|
|---|
| 63 | D LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | INQUIRE(TIUDA,TIUREC) ; Inquire to document TIUDA and set TIUREC
|
|---|
| 67 | N DA,DIC,DIQ,DR
|
|---|
| 68 | S DA=TIUDA,DIC=8925,DIQ="TIUREC("
|
|---|
| 69 | S DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506;89261"
|
|---|
| 70 | D EN^DIQ1
|
|---|
| 71 | Q
|
|---|
