source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURM1.m@ 1763

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

initial load of WorldVistAEHR

File size: 6.5 KB
Line 
1TIURM1 ; SLC/JER - MIS Document Review ;9/24/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
3GATHER(TIUPREF,CLASS,STATIFNS,EARLY,LATE,DIVIFNS) ; Find/sort
4 ;records for the list
5 N TIUDA,TIUSFLD,TIUI,TIUQ
6 S TIUSFLD=$P(TIUPREF,U,3)
7 S TIUSFLD=$S(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
8 S TIUI=EARLY F S TIUI=$O(^TIU(8925,"F",TIUI)) Q:+TIUI'>0!(+TIUI>LATE) D
9 . S TIUDA=0
10 . F S TIUDA=$O(^TIU(8925,"F",TIUI,TIUDA)) Q:+TIUDA'>0 D
11 . . ; Consider adding view check here
12 . . I '$$INTYPES(TIUDA) Q
13 . . I '$$INSTATUS(TIUDA,STATIFNS) Q
14 . . I +$G(DIVIFNS("ENTRIES")),'$$ININST(TIUDA,.DIVIFNS) Q
15 . . S TIUQ=$$RESOLVE^TIUR1(TIUDA,TIUSFLD)
16 . . S ^TMP("TIUI",$J,TIUQ,(9999999-TIUI),TIUDA)=""
17 Q
18 ;
19INTYPES(TIUDA) ; Evaluates whether a record is among the selected types
20 N TIUI,TIUTYP,TIUY S (TIUI,TIUY)=0
21 S TIUTYP=+$G(^TIU(8925,+TIUDA,0))
22 I TIUTYP=81 S TIUY=+$$DADINTYP(TIUDA) G INTYPX
23 F S TIUI=$O(^TMP("TIUTYP",$J,TIUI)) Q:+TIUI'>0!+TIUY D
24 . I +$P(^TMP("TIUTYP",$J,TIUI),U,2)=TIUTYP S TIUY=1
25INTYPX Q TIUY
26 ;
27INSTATUS(TIUDA,STATIFNS) ; Evaluates whether a record
28 ;is among the selected statuses
29 N TIUS,TIUSTAT,TIUSTATE,TIUY S TIUY=0
30 S TIUSTATE=+$P($G(^TIU(8925,+TIUDA,0)),U,5)
31 S TIUS=1 F S TIUSTAT=$P(STATIFNS,";",TIUS) Q:'TIUSTAT!TIUY D
32 . S TIUS=TIUS+1
33 . I TIUSTAT=TIUSTATE S TIUY=1
34 Q TIUY
35ININST(TIUDA,TIUDI) ; Evaluates whether a TIU DOCUMENT record
36 ; is among the selected divisions
37 ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
38 ; -- TIUDI( i.e. TIUDI(file #40.8 IEN)=Institution file
39 ; pointer for file #40.8 entry
40 ; Output - TIUY 0= record not in selected division
41 ; 1= record in selected division
42 N TIUIFP,TIUI,TIUINST,TIUY S TIUY=0
43 S TIUINST=+$P($G(^TIU(8925,+TIUDA,12)),U,12)
44 S TIUI=0 F S TIUI=$O(TIUDI(TIUI)) Q:'TIUI!TIUY D
45 . S TIUIFP=$G(TIUDI(TIUI))
46 . I TIUIFP=TIUINST S TIUY=1
47 Q TIUY
48DADINTYP(TIUDA) ; Evaluates whether addendum's parent is among
49 ; the selected types
50 N TIUI,TIUDTYP,TIUY S (TIUI,TIUY)=0
51 S TIUDTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
52 F S TIUI=$O(^TMP("TIUTYP",$J,TIUI)) Q:+TIUI'>0!+TIUY D
53 . I +$P(^TMP("TIUTYP",$J,TIUI),U,2)=TIUDTYP S TIUY=1
54 Q TIUY
55 ;
56PUTLIST(TIUPREF,TIUCLASS,STATUS,DIVIFNS) ; Expands list elements for LM Template
57 N TIUJ,TIUQ,TIUDA,TIUPICK,TIUORDER,TIUEXPKD,TIUSFLD
58 S VALMCNT=0
59 S TIUSFLD=$P(TIUPREF,U,3)
60 S TIUSFLD=$S(TIUSFLD="P":".02",TIUSFLD="D":".01",TIUSFLD="S":".05",TIUSFLD="C":"1507",TIUSFLD="A":"1202",TIUSFLD="E":"1208",1:"1301")
61 S TIUORDER=$S($P(TIUPREF,U,4)="A":1,1:-1)
62 S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
63 S TIUQ="" F S TIUQ=$O(^TMP("TIUI",$J,TIUQ)) Q:TIUQ']"" D
64 . S TIUJ=0 F S TIUJ=$O(^TMP("TIUI",$J,TIUQ,TIUJ)) Q:+TIUJ'>0 D
65 . . S TIUDA=0
66 . . F S TIUDA=$O(^TMP("TIUI",$J,TIUQ,TIUJ,TIUDA)) Q:'TIUDA D
67 . . . D REPLACE^TIUR2(TIUDA,TIUQ,TIUSFLD,TIUJ,.TIUEXPKD)
68 D SETLIST(TIUORDER,.VALMCNT)
69 S ^TMP("TIUR",$J,0)=+$G(VALMCNT)_U_STATUS("WORDS")
70 S ^TMP("TIUR",$J,"CLASS")=TIUCLASS
71 S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+$G(VALMCNT)
72 M ^TMP("TIUR",$J,"DIV")=DIVIFNS
73 I $D(VALMHDR)>9 D HDR^TIURMH
74 I +$G(VALMCNT)'>0 D
75 . S ^TMP("TIUR",$J,1,0)="",VALMCNT=2
76 . S ^TMP("TIUR",$J,2,0)=" No records found to satisfy search criteria."
77 . S ^TMP("TIUR",$J,"IDX",1,0)="" ; User can't select lines 1 or 2
78 . S ^TMP("TIUR",$J,"IDX",2,0)=""
79 ; -- Expand to show kids that fit:
80 I '$G(TIURBLD),$D(TIUEXPKD) D EXPANDKD^TIUR2(.STATUS,.TIUEXPKD)
81 Q
82SETLIST(TIUORDER,VALMCNT) ; Set items from ^TMP("TIUI",$J) into
83 ;List Template list
84 N SORTVAL,TIUDTM,TIUDA
85 S SORTVAL=""
86 F S SORTVAL=$O(^TMP("TIUI",$J,SORTVAL),TIUORDER) Q:SORTVAL="" D
87 . S TIUDTM=0
88 . F S TIUDTM=$O(^TMP("TIUI",$J,SORTVAL,TIUDTM)) Q:'TIUDTM D
89 . . S TIUDA=0
90 . . F S TIUDA=$O(^TMP("TIUI",$J,SORTVAL,TIUDTM,TIUDA)) Q:'TIUDA D
91 . . . D ADDELMNT(TIUDA,.VALMCNT)
92 Q
93 ;
94ADDELMNT(DA,TIUCNT,APPEND) ; Add each element to the list
95 N PT,ADT,DDT,AUT,AMD,EDT,LCT,SDT,TIULST4,INSTA,TIUSTN
96 N TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,STATX,TIULI,DOC ;P74 newed DOC
97 N PREFIX,TIUGDATA
98 I '$D(^TIU(8925,TIUDA,0)) Q
99 I $G(^TMP("TIUR",$J,2,0))=" No records found to satisfy search criteria." D
100 . K ^TMP("TIUR",$J,2),^TMP("TIUR",$J,"IDX",2),^TMP("TIUR",$J,"IDX",1)
101 . S TIUCNT=0
102 S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^TIU(8925,+DA,12))
103 S TIUD13=$G(^TIU(8925,+DA,13)),TIUD15=$G(^TIU(8925,+DA,15))
104 S DOC=$$PNAME^TIULC1(+TIUD0)
105 I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
106 S PREFIX=$$PREFIX^TIULA2(TIUDA,0)
107 S PT=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
108 S TIULI=$E(PT)
109 S PT=PREFIX_PT
110 S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9)
111 S TIULST4="("_TIULI_TIULST4_")"
112 S ADT=$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/YY")
113 S DDT=$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/YY")
114 S AMD=$$PERSNAME^TIULC1($P(TIUD12,U,8)) S:AMD="UNKNOWN" AMD=""
115 S AUT=$$PERSNAME^TIULC1($P(TIUD12,U,2)) S:AUT="UNKNOWN" AUT=""
116 S AMD=$$NAME^TIULS(AMD,"LAST, FI MI")
117 S AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
118 S EDT=$$DATE^TIULS($P(TIUD13,U,7),"MM/DD/YY")
119 S SDT=$S(+$P(TIUD15,U,7):+$P(TIUD15,U,7),+$P(TIUD0,U,5)'<7:+$P(TIUD15,U),1:"")
120 S SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
121 S STATX=$P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U)
122 S LCT=$P(TIUD0,U,10)
123 S INSTA=""
124 I +$P(TIUD12,U,12)>0 D
125 . S TIUSTN=$$NS^XUAF4($P(TIUD12,U,12))
126 . I $P(TIUSTN,U,2)]"" S INSTA=$P(TIUSTN,U,2)
127 S INSTA=$E(INSTA,1,8)
128 S TIUCNT=+$G(TIUCNT)+1
129 S TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
130 S TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
131 S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
132 S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
133 S TIUREC=$$SETFLD^VALM1(ADT,TIUREC,"ADMISSION DATE")
134 S TIUREC=$$SETFLD^VALM1(DDT,TIUREC,"DISCH DATE")
135 S TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"DICT DATE")
136 S TIUREC=$$SETFLD^VALM1(LCT,TIUREC,"LINE COUNT")
137 S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
138 S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
139 S TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"ATTENDING")
140 S TIUREC=$$SETFLD^VALM1(INSTA,TIUREC,"DIVISION")
141 S ^TMP("TIUR",$J,TIUCNT,0)=TIUREC
142 S ^TMP("TIUR",$J,"IDX",TIUCNT,TIUCNT)="" W "."
143 S ^TMP("TIURIDX",$J,TIUCNT)=TIUCNT_U_DA_U_PREFIX
144 S ^TMP("TIUR",$J,"IEN",DA,TIUCNT)=""
145 S TIUGDATA=$$IDDATA^TIURECL1(DA,TIUD0)
146 I TIUGDATA S ^TMP("TIUR",$J,"IDDATA",DA)=TIUGDATA
147 I +$G(APPEND) D
148 . D RESTORE^VALM10(TIUCNT)
149 . D CNTRL^VALM10(TIUCNT,1,$G(VALM("RM")),IOINHI,IOINORM),HDR^TIURMH
150 . S VALMSG="** Item #"_TIUCNT_" Added **"
151 . S $P(^TMP("TIUR",$J,0),U)=TIUCNT
152 . S $P(^TMP("TIUR",$J,"#"),":",2)=TIUCNT
153 . S VALMCNT=TIUCNT
154 . I $D(VALMHDR)>9 D HDR^TIURMH
155 Q
Note: See TracBrowser for help on using the repository browser.