source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVL1.m@ 1071

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1TIUSRVL1 ; SLC/JER - Server functions for lists ;7/9/96 12:47
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3NOTES(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Notes
4 I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
5 D LIST(.TIUY,DFN,3,$G(EARLY),$G(LATE),$G(ROOTFLAG))
6 Q
7SUMMARY(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Summaries
8 I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
9 D LIST(.TIUY,DFN,244,$G(EARLY),$G(LATE),$G(ROOTFLAG))
10 Q
11CONSULT(TIUY,DFN,EARLY,LATE,ROOTFLAG) ; Gets list of Consults
12 I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
13 D LIST(.TIUY,DFN,243,$G(EARLY),$G(LATE),$G(ROOTFLAG))
14 Q
15LIST(TIUY,DFN,TYPE,EARLY,LATE,ROOTFLAG) ; Build List
16 N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUIFN,TIUREC,TIUPRM0,TIUPRM1
17 N TIUPRM3,TIUT,TIUTP,TIUS,TIUCONT
18 K ^TMP("TIULIST",$J),^TMP("TIUI",$J)
19 I '$D(TIUPRM0) D SETPARM^TIULE
20 I +$D(TYPE)'>0 S TIUY=0 Q
21 S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
22 S TIUI=0
23 F S TIUI=$O(^TIU(8925,"APTCL",DFN,TYPE,TIUI)) Q:TIUI'>0!(TIUI>EARLY) D
24 . D GATHER(TYPE,TIUI)
25 S TIUY=$NA(^TMP("TIULIST",$J))
26 I +$O(^TMP("TIULIST",$J,0)) S (TIUI,TIUK)=0
27 F S TIUI=$O(^TMP("TIULIST",$J,TIUI)) Q:+TIUI'>0 D
28 . S TIUJ=0 F S TIUJ=$O(^TMP("TIULIST",$J,TIUI,TIUJ)) Q:+TIUJ'>0 D
29 . . S TIUK=TIUK+1
30 . . S ^TMP("TIULIST",$J,TIUK)=$G(^TMP("TIULIST",$J,TIUI,TIUJ))
31 . . S ^TMP("TIULIDX",$J,TIUI,TIUJ)=TIUK K ^TMP("TIULIST",$J,TIUI,TIUJ)
32 . . S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U)=TIUK
33 . . S:TIUK=1&+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,3)=(9999999-TIUI)
34 . . S:+$G(ROOTFLAG) $P(^TMP("TIULIST",$J),U,2)=(9999999-TIUI)
35 Q
36GATHER(TYPE,TIUI) ; Find/sort records for the list
37 N TIUDA
38 S TIUDA=0
39 F S TIUDA=$O(^TIU(8925,"APTCL",DFN,TYPE,TIUI,TIUDA)) Q:+TIUDA'>0 D
40 . I +$$CANDO^TIULP(TIUDA,"VIEW")'>0 Q
41 . D ADDELMNT(TIUDA,.TIUCNT)
42 Q
43ADDELMNT(DA,TIUCNT) ; Add each element to the list
44 N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13
45 N STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT
46 S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
47 S TIUR13=$G(^TIU(8925,+DA,13)),TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))
48 S DOC=$$PNAME^TIULC1(+TIUR0)
49 I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
50 S STATUS=$$LOWER^TIULS($P(^TIU(8925.6,+$P(TIUR0,U,5),0),U))
51 S LOC=$G(^SC(+$P(TIUR12,U,5),0)),LOCTYP=$P(LOC,U,3),LOC=$P(LOC,U)
52 S TIUADT=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($P(TIUR0,U,7),"MM/DD/YY")
53 S TIUDDT=$S(+$P(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($P(TIUR0,U,8),"MM/DD/YY")
54 S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")
55 S TIULST4=$E($P(TIUPT,U,9),6,9)
56 S TIULST4="("_$E(PT)_TIULST4_")"
57 S AUT=$$SIGNAME^TIULS(+$P(TIUR12,U,2))
58 S EDT=+TIUR13,EDTCNT=+$G(EDTCNT)+1
59 F Q:+$D(^TMP("TIULIST",$J,9999999-EDT,EDTCNT))'>0 S EDTCNT=EDTCNT+1
60 S TIUCNT=+$G(TIUCNT)+1
61 S TIUREC=DA_U_DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT
62 S ^TMP("TIULIST",$J,9999999-EDT,EDTCNT)=TIUREC
63 ;S TIUY(TIUCNT)=TIUREC
64 Q
65DOCTYPE(TIUY,DA,TYPE,TIUK) ; Get all descendent's of a given type
66 N I,J,X,CURTYP,Y
67 ; TIUK is STATIC
68 S TIUK=+$G(TIUK)
69 I $G(TYPE)']"" S TYPE="DOC"
70 S CURTYP=$P(^TIU(8925.1,+DA,0),U,4)
71 S TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP)
72 I +TYPMATCH S TIUK=+$G(TIUK)+1,TIUY(TIUK)=+DA_U_$$PNAME^TIULC1(+DA)
73 S I=0 F S I=$O(^TIU(8925.1,+DA,10,I)) Q:+I'>0 D
74 . N J
75 . S J=+$G(^TIU(8925.1,+DA,10,+I,0)) Q:+J'>0
76 . D DOCTYPE(.TIUY,+J,TYPE,.TIUK)
77 Q
78STATUS(TIUY,STATUS,INCLDESC) ; Get statuses
79 N TIUI,TIUS,TIUSTAT S STATUS=$G(STATUS,"ALL")
80 I STATUS'="ALL" D Q
81 . S TIUS=$O(^TIU(8925.6,"B",STATUS,0)) Q:+TIUS'>0
82 . S TIUSTAT=$P($G(^TIU(8925.6,+TIUS,0)),U)
83 . I $P(^TIU(8925.6,+TIUS,0),U,4)'="DEF" S TIUY(1)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
84 S STATUS=""
85 F S STATUS=$O(^TIU(8925.6,"B",STATUS)) Q:STATUS']"" D
86 . S TIUS=0
87 . F S TIUS=$O(^TIU(8925.6,"B",STATUS,TIUS)) Q:+TIUS'>0 D
88 . . S TIUI=+$G(TIUI)+1,TIUSTAT=$P($G(^TIU(8925.6,+TIUS,0)),U)
89 . . I $P(^TIU(8925.6,+TIUS,0),U,4)'="DEF" D
90 . . . S TIUY(TIUI)=TIUS_U_$$LOWER^TIULS(TIUSTAT)
91 . . . I +$G(INCLDESC) D
92 . . . . N TIUJ S TIUJ=0
93 . . . . F S TIUJ=$O(^TIU(8925.6,+TIUS,1,TIUJ)) Q:+TIUJ'>0 D
94 . . . . . S TIUY(TIUI,1,TIUJ)=$G(^TIU(8925.6,+TIUS,1,+TIUJ,0))
95 Q
Note: See TracBrowser for help on using the repository browser.