source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVR2.m@ 691

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

revised back to 6/30/08 version
File size: 6.5 KB
RevLine 
[623]1TIUSRVR2 ; SLC/JER - RPC for record-wise GET ; 4/14/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,162,222**;Jun 20, 1997
3 ; 4/12/01 Moved signature modules to new rtn TIUSRVR3
4LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL,ACTION) ; Load ^TMP
5 ;Requires TIUDA, array TIUL, TIUGDATA
6 ;optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
7 ; loading the whole note after the original entry,
8 ; so DON'T load the whole note again.
9 N TIUKID,TIUDADT,TIUI,CANSEE
10 N TIUPARNT,TIUPNAME,TIUPDATE
11 N TIUGPRNT,TIUGPNM,TIUGPDT,TIUPDATA,TIUHASKD
12 S ACTION=$G(ACTION,"VIEW")
13 ; ---- If user cannot view, say so and quit: ----
14 ; TIU*1*100
15 S CANSEE=$S(+$$ISCOMP^TIUSRVR1(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,ACTION))
16 I +CANSEE'>0 D Q
17 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(CANSEE,U,2)
18 ; ---- Load text of TIUDA: ----
19 S TIUI=0
20 F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
21 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0))
22 ; ---- if TIUDA is a COMPONENT, QUIT
23 Q:+$$ISCOMP^TIUSRVR1(TIUDA)
24 ; ---- If TIUDA **IS** an addendum, load addm signature,
25 ; load original document, quit: ----
26 I +$$ISADDNDM^TIULC1(+TIUDA) D Q
27 . N TIULINE,TIUPARNT S $P(TIULINE,"=",79)=""
28 . D LOADSIG^TIUSRVR3(TIUDA,.TIUL)
29 . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
30 . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE
31 . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
32 . S TIUPARNT=+$P(^TIU(8925,+TIUDA,0),U,6)
33 . S TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
34 . S TIUPDATE=+$G(^TIU(8925,TIUPARNT,13))
35 . S TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
36 . S TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
37 . S TIUHASKD=$P(TIUPDATA,U,2),TIUGPRNT=+$P(TIUPDATA,U,3)
38 . S TIUL=+$G(TIUL)+1
39 . I TIUHASKD D
40 . . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
41 . I TIUGPRNT D
42 . . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
43 . . S TIUGPNM=$$PNAME^TIULC1(+^TIU(8925,TIUGPRNT,0))
44 . . S TIUGPDT=+$G(^TIU(8925,TIUGPRNT,13))
45 . . S TIUGPDT=$$DATE^TIULS(TIUGPDT,"MM/DD/YY")
46 . I 'TIUHASKD,'TIUGPRNT S @TIUARR@(TIUL)=" --- Original Document ---"
47 . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=""
48 . S TIUL=+$G(TIUL)+1
49 . I TIUHASKD D
50 . . S @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>"
51 . . S TIUL=+$G(TIUL)+1
52 . . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
53 . I TIUGPRNT D
54 . . S @TIUARR@(TIUL)=" << Interdisciplinary Note >>"
55 . . S TIUL=+$G(TIUL)+1
56 . . S @TIUARR@(TIUL)=TIUGPDT_" "_TIUGPNM
57 . . S TIUL=+$G(TIUL)+1
58 . . S @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>"
59 . . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
60 . I 'TIUHASKD,'TIUGPRNT D
61 . . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
62 . D LOADREC(TIUPARNT,.TIUL,TIUGDATA)
63 ; ---- Load components of TIUDA: ----
64 S TIUKID=0
65 F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
66 . I +$$ISADDNDM^TIULC1(TIUKID)'>0 D LOADREC(TIUKID,.TIUL,$G(TIUGDATA))
67 ; ---- Load signature of TIUDA if TIUDA is not addm
68 ; or comp: ----
69 ; *222 don't display sig info. for FORM LETTERS
70 I '+$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D
71 . I '$$ISCOMP^TIUSRVR1(TIUDA) D LOADSIG^TIUSRVR3(TIUDA,.TIUL)
72 ; ---- Load addenda of TIUDA: ----
73 S TIUKID=0
74 F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
75 . ; If acting on an addendum, don't show it again.
76 . I +TIUKID=+$G(^TMP("TIU FOCUS",$J)) Q
77 . I +$$ISADDNDM^TIULC1(TIUKID) D LOADADD(TIUKID,.TIUL)
78 N IDDAD
79 S IDDAD=+$P(TIUGDATA,U,3)
80 ; ---- If Browsed Record is an ID Note, & this cycle has
81 ; just loaded the parent entry, then load ID kids
82 ; and quit: **100** ----
83 I $P(TIUGDATA,U,2),TIUDA=+TIUGDATA D LOADKIDS(TIUDA,.TIUL,TIUGDATA) Q
84 ; ---- If Browsed Record is an ID Entry, & this cycle hasn't begun
85 ; loading the whole note, then load the whole ID Note after
86 ; the browsed entry and quit: ----
87 I IDDAD,'$G(TIUGWHOL) D Q
88 . S TIUGWHOL=1
89 . N TIULINE S $P(TIULINE,"=",79)=""
90 . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
91 . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE
92 . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
93 . S TIUL=TIUL+1,@TIUARR@(TIUL)=" --- Interdisciplinary Note ---"
94 . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
95 . D LOADID(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
96 ; ---- If Browsed Record is an ID Entry, & this cycle has begun
97 ; loading the whole ID note, and is currently loading the first
98 ; entry of the whole note, then load kids and quit: ----
99 I IDDAD,$G(TIUGWHOL),TIUDA=IDDAD D LOADKIDS(TIUDA,.TIUL,TIUGDATA,TIUGWHOL) K TIUGWHOL
100 Q
101 ;
102LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
103 ; Requires TIUDA, array TIUL, TIUGDATA
104 N TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
105 I $G(^TMP("TIUR",$J,"IDDATA",TIUDA)) S PRMSORT=$P(^TMP("TIUR",$J,"IDDATA",TIUDA),U,4)
106 E S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD21=$G(^TIU(8925,TIUDA,21)),PRMSORT=$P($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
107 D GETIDKID^TIURECL2(TIUDA,PRMSORT) ; sets array ^TMP("TIUIDKID",$J,
108 S TIUK=0
109 F S TIUK=$O(^TMP("TIUIDKID",$J,TIUDA,TIUK)) Q:+TIUK'>0 D
110 . S KIDDA=^TMP("TIUIDKID",$J,TIUDA,TIUK)
111 . D LOADID(KIDDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
112 K ^TMP("TIUIDKID",$J)
113 Q
114 ;
115LOADID(TIUDA,TIUL,TIUGDATA,TIUWHOL) ; Load ID note for browse
116 N TIUREC,TIU
117 I '$D(^TIU(8925,+TIUDA,0)) Q
118 ; ---- If ID Kid has focus, don't show it again ----
119 ; I TIUDA=+$G(^TMP("TIU FOCUS",$J)) Q
120 S TIUL=TIUL+1,@TIUARR@(TIUL)=""
121 D GETTIU^TIULD(.TIU,+TIUDA)
122 D INQUIRE(TIUDA,.TIUREC)
123 ; ---- Load info missing from header since this is ID note entry: ----
124 ; ---- Load dictation, transcription data, etc.: ----
125 D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,$G(TIUGDATA))
126 ; ---- Load the remainder of the record: ----
127 D LOADREC(TIUDA,.TIUL,$G(TIUGDATA),$G(TIUWHOL))
128 Q
129 ;
130INQUIRE(TIUDA,TIUREC,TIUCPF) ; Inquire to document TIUDA and set TIUREC
131 N DA,DIC,DIQ,DR
132 S DA=TIUDA,DIC=8925,DIQ="TIUREC("
133 S DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506"
134 ;If the document is a member of the Clinical Procedures Class, include the
135 ;Procedure Summary Code field and the Date/Time Performed field
136 I $G(TIUCPF) S DR=DR_";70201;70202"
137 D EN^DIQ1
138 Q
139LOADADD(TIUDADD,TIUL) ; Load addenda
140 N TIUDAUTH,TIUDATT,TIUJ,TIUSIG,TIUCSIG,TIUVIEW
141 S TIUL=TIUL+1,@TIUARR@(TIUL)=""
142 S TIUDADT=$$DATE^TIULS($P($G(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
143 S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD) ;P162
144 S TIUVIEW=$$CANDO^TIULP(+TIUDADD,"VIEW")
145 I '+TIUVIEW D Q
146 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(TIUVIEW,U,2)
147 S TIUJ=0
148 F S TIUJ=$O(^TIU(8925,+TIUDADD,"TEXT",TIUJ)) Q:+TIUJ'>0 D
149 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0))
150 D LOADSIG^TIUSRVR3(TIUDADD,.TIUL)
151 Q
Note: See TracBrowser for help on using the repository browser.