source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUGBR.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1TIUGBR ; 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 ;
5GETKIDS(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 ;
14HASIDKID(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 ;
20HASIDDAD(DA) ; Function returns ID parent of DA if DA has parent; else 0.
21 Q +$G(^TIU(8925,DA,21),0)
22 ;
23DADORKID(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)
29ORKIDX Q TIUY
30 ;
31IDTOP(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 ;
49LOADID(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 ;
66INQUIRE(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
Note: See TracBrowser for help on using the repository browser.