source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURDIV.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1TIURDIV ; SLC/JAK - Review unsig/uncosig Documents by DIVISION ;12/01/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**113**;Jun 20, 1997
3 ; Multidivisional Enhancements - from BUF/DCN - modified by SLC/JAK
4 ;
5BEGIN ; Select Division(s), Entry Date Range, Service, Type of Report
6 N TIUI,TIUSTDT,TIUENDT,TIUSVCS
7 D SELDIV^TIULA Q:SELDIV'>0
8 I $D(TIUDI) D
9 . S TIUI=0 F S TIUI=$O(TIUDI(TIUI)) Q:'TIUI D
10 . . S TIUDI("ENTRIES")=$G(TIUDI("ENTRIES"))_TIUI_";"
11 E D
12 . S TIUDI("ENTRIES")="ALL DIVISIONS"
13 ;
14 ;Ask Date Range, exit if timeout, '^' or no selection
15 Q:'$$ASKRNG(.TIUSTDT,.TIUENDT)
16 ;
17 ;Select Service, exit if timeout, '^' or no selection
18 Q:'$$SELSVC^TIULA(.TIUSVCS)
19 ;
20 N DIR,DIRUT,DTOUT,DUOUT,TIURPT
21 S DIR(0)="S^F:FULL;S:SUMMARY",DIR("A")="Type of Report"
22 S DIR("?",1)="Summary lists the number of documents by author's"
23 S DIR("?",2)="service/section. Full lists detailed document"
24 S DIR("?",3)="information by author's service/section."
25 S DIR("?")="Enter ""^"", or a RETURN to quit."
26 D ^DIR Q:$D(DIRUT) S TIURPT=Y
27 I TIURPT="F" W !!,"This report must be sent to a 132-column device.",!
28 ;
29DEV ; Device selection
30 S %ZIS="Q" W ! D ^%ZIS I POP K POP G EXIT
31 I TIURPT="F",IOM'>131 W !!,"You must select a 132-column device." G DEV
32 I $D(IO("Q")) D G EXIT
33 . S ZTRTN="BUILD^TIURDIV"
34 . S ZTSAVE("TIUDI(")="",ZTSAVE("TIURPT")=""
35 . S ZTSAVE("TIUSTDT")="",ZTSAVE("TIUENDT")=""
36 . S ZTSAVE("TIUSVCS")="",ZTSAVE("TIUSVCS(")=""
37 . S ZTDESC="TIU UNSIG/UNCOSIG DOCS BY DIV"
38 . D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
39 . K ZTSK,ZTDESC,ZTRTN,ZTSAVE,%ZIS,TIUDIV,TIURPT,TIUIFP
40 . D HOME^%ZIS
41 U IO D BUILD,^%ZISC
42 Q
43BUILD ; Build list
44 N TIUIFP,TIUK
45 K ^TMP("TIUD",$J)
46 I $D(ZTQUEUED) S ZTREQ="@"
47 I +$G(TIUDI("ENTRIES")) D
48 . S TIUK=0 F S TIUK=$O(TIUDI(TIUK)) Q:'TIUK D
49 . . S TIUIFP=$G(TIUDI(TIUK))
50 . . D GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
51 E D
52 . S TIUIFP=0
53 . F S TIUIFP=$O(^TIU(8925,"ADIV",TIUIFP)) Q:+TIUIFP'>0 D
54 . . D GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
55 D PRINT(TIUSTDT,TIUENDT)
56 ;
57EXIT ; Clean up and exit
58 K SELDIV,TIUDI,TIUSTDT,TIUENDT,TIUSVCS K ^TMP("TIUD",$J)
59 Q
60GATHER(TIUIFP,TIUSTDT,TIUENDT,TIUSVCS) ; Find records for the list
61 ; Input -- TIUIFP INSTITUTION file (#4) IEN
62 ; (0 = gather all divisions)
63 ; TIUSTDT Start Date
64 ; TIUENDT End Date
65 ; TIUSVCS Service Selection Array
66 ; Output -- None
67 N TIUDA,TIUJ,TIUS,TIUTP
68 S TIUTP=0
69 F S TIUTP=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP)) Q:+TIUTP'>0 D
70 . S TIUS=4
71 . F S TIUS=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS)) Q:+TIUS'>0!(+TIUS>6) D
72 . . S TIUJ=0
73 . . F S TIUJ=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS,TIUJ)) Q:+TIUJ'>0 D
74 . . . S TIUDA=0
75 . . . F S TIUDA=$O(^TIU(8925,"ADIV",TIUIFP,TIUTP,TIUS,TIUJ,TIUDA)) Q:+TIUDA'>0 D
76 . . . . D ADDELMNT(TIUDA,TIUSTDT,TIUENDT,.TIUSVCS)
77 Q
78 ;
79ADDELMNT(TIUDA,TIUSTDT,TIUENDT,TIUSVCS) ; Add each element to the list
80 ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
81 ; TIUSTDT Start Date
82 ; TIUENDT End Date
83 ; TIUSVCS Service Selection Array
84 ; Output -- None
85 N TIUAU,TIUD12,TIUEDT,TIUIFP,TIUSVC
86 S TIUD12=$G(^TIU(8925,TIUDA,12))
87 S TIUEDT=+$P(TIUD12,U),TIUAU=+$P(TIUD12,U,2),TIUIFP=+$P(TIUD12,U,12)
88 ;Check Date Range
89 I TIUEDT,TIUEDT>TIUSTDT,TIUEDT<TIUENDT D
90 . S TIUSVC=$$PROVSVC^TIULV(TIUAU)
91 . ;Check Service
92 . I $G(TIUSVCS)="ALL"!($D(TIUSVCS(+TIUSVC))) D
93 . . S TIUAU=$$PERSNAME^TIULC1(TIUAU)
94 . . I $P(TIUSVC,U,2)]"" D
95 . . . S TIUSVC=$P(TIUSVC,U,2)
96 . . E D
97 . . . S TIUSVC="UNKNOWN"
98 . . I TIUAU'="UNKNOWN" S TIUAU=$$NAME^TIULS(TIUAU,"LAST, FI MI")
99 . . S ^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAU,TIUEDT)=TIUDA
100 Q
101 ;
102PRINT(TIUSTDT,TIUENDT) ; Display/print the output
103 ; Input -- TIUSTDT Start Date
104 ; TIUENDT End Date
105 ; Output -- None
106 N GTCT,ICT,SCT,TIUAU,TIUDA,TIUECS,TIUEDT
107 N TIUIFP,TIULST4,TIUOUT,TIUPG,TIUPT,TIUSVC,TIUTP
108 S (GTCT(5),GTCT(6),TIUIFP,TIUPG,TIUOUT)=0
109 I '$D(^TMP("TIUD",$J)) W !!,"NO Unsigned/Uncosigned Documents!!" Q
110 F S TIUIFP=$O(^TMP("TIUD",$J,TIUIFP)) Q:TIUIFP=""!(TIUOUT) D HDR(TIUIFP,TIUSTDT,TIUENDT) D
111 . S (ICT(TIUIFP,5),ICT(TIUIFP,6))=0 S TIUSVC=""
112 . F S TIUSVC=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC)) Q:TIUSVC=""!(TIUOUT) D
113 . . I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT)
114 . . D FHDR(TIUSVC):TIURPT="F"
115 . . S (SCT(TIUIFP,TIUSVC,5),SCT(TIUIFP,TIUSVC,6))=0 S TIUAU=""
116 . . F S TIUAU=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAU)) Q:TIUAU=""!(TIUOUT) D
117 . . . S TIUEDT=0
118 . . . F S TIUEDT=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAU,TIUEDT)) Q:TIUEDT=""!(TIUOUT) D
119 . . . . S TIUDA=+$G(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAU,TIUEDT))
120 . . . . D PRTELMNT(TIUDA,TIUIFP,TIUSVC,TIUAU,TIUEDT,TIUSTDT,TIUENDT)
121 . . . . ;
122 . . Q:TIUOUT
123 . . I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT),FHDR(TIUSVC):TIURPT="F"
124 . . W !!," Totals for Service: ",$E(TIUSVC,1,25),"---"
125 . . W " UNSIGNED: ",$G(SCT(TIUIFP,TIUSVC,5))
126 . . W " UNCOSIGNED: ",$G(SCT(TIUIFP,TIUSVC,6))
127 . Q:TIUOUT
128 . I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT)
129 . W !!,"Totals for Division: ",$E($P($$NS^XUAF4(TIUIFP),U),1,25),"---"
130 . W " UNSIGNED: ",$G(ICT(TIUIFP,5))
131 . W " UNCOSIGNED: ",$G(ICT(TIUIFP,6))
132 . S GTCT(5)=GTCT(5)+ICT(TIUIFP,5),GTCT(6)=GTCT(6)+ICT(TIUIFP,6)
133 . D ASK Q:TIUOUT
134 Q:TIUOUT
135 S TIUIFP="ALL" D HDR(TIUIFP,TIUSTDT,TIUENDT)
136 W !!,"GRAND Totals (All Divisions)--- UNSIGNED: ",+$G(GTCT(5))
137 W " UNCOSIGNED: ",+$G(GTCT(6))
138 Q
139PRTELMNT(TIUDA,TIUIFP,TIUSVC,TIUAU,TIUEDT,TIUSTDT,TIUENDT) ; Print each element
140 ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
141 ; TIUIFP INSTITUTION file (#4) IEN
142 ; TIUSVC SERVICE/SECTION file (#49) NAME
143 ; TIUAU AUTHOR/DICTATOR's NAME
144 ; TIUEDT Inverse REFERENCE DATE
145 ; TIUSTDT Start Date
146 ; TIUENDT End Date
147 ; Output -- None
148 N TIUD0,TIUD12,TIUS
149 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^TIU(8925,TIUDA,12))
150 S TIUS=+$P(TIUD0,U,5) I TIUS'=5,TIUS'=6 Q
151 S ICT(TIUIFP,TIUS)=ICT(TIUIFP,TIUS)+1
152 S SCT(TIUIFP,TIUSVC,TIUS)=SCT(TIUIFP,TIUSVC,TIUS)+1
153 I $Y>(IOSL-5) D ASK Q:TIUOUT D HDR(TIUIFP,TIUSTDT,TIUENDT),FHDR(TIUSVC):TIURPT="F"
154 I TIURPT="F" D
155 . S TIUPT=+$P(TIUD0,U,2),TIULST4=$E($$GET1^DIQ(2,TIUPT,.09),6,9)
156 . S TIUTP=+$P(TIUD0,U),TIUECS=+$P(TIUD12,U,8)
157 . W !,$G(TIUAU)
158 . W ?17,$S(TIUPT:$E($$EXTERNAL^DILFD(8925,.02,"",TIUPT),1,15),1:"UNK")
159 . W ?34,$S(TIULST4]"":$G(TIULST4),1:"UNK")
160 . W ?41,$E($$EXTERNAL^DILFD(8925,.05,"",TIUS),1,10)
161 . W ?53,$S(TIUEDT>0:$$FMTE^XLFDT(TIUEDT,2),1:"UNK")
162 . W ?71,$G(TIUDA)
163 . W ?85,$S(TIUTP:$E($$EXTERNAL^DILFD(8925,.01,"",TIUTP),1,15),1:"UNK")
164 . W ?102,$S(TIUECS:$E($$EXTERNAL^DILFD(8925,1208,"",TIUECS),1,15),1:"")
165 . W ?119,$$PRNT(TIUDA)
166 Q
167ASK ; End of page
168 I IO=IO(0),$E(IOST)="C" D
169 . W ! N DIR,Y S DIR(0)="E" D ^DIR K DIR
170 . I Y=""!(Y=0) S TIUOUT=1
171 Q
172HDR(TIUIFP,TIUSTDT,TIUENDT) ; Page (Division) Header
173 ; Input -- TIUIFP INSTITUTION file (#4) IEN
174 ; TIUSTDT Start Date
175 ; TIUENDT End Date
176 ; Output -- None
177 N LNE,TIUR,TIUINST,TIURNG
178 S TIUPG=(+$G(TIUPG))+1
179 D DT^DILF("ET","NOW",.TIUR)
180 S TIURNG=$$FMTE^XLFDT(TIUSTDT)_" thru "_$$FMTE^XLFDT(TIUENDT)
181 S TIUINST=$S(TIUIFP:$P($$NS^XUAF4(TIUIFP),U),1:"ALL DIVISIONS")
182 W @IOF,?26,"Unsigned and Uncosigned Documents "_TIURNG,?(IOM-10)
183 W "Page ",+$G(TIUPG),!,"PRINTED:",?26,"for ",TIUINST,!,TIUR(0)
184 W ! S LNE="",$P(LNE,"-",(IOM-1))="" W LNE
185 I TIURPT="F" D
186 . W !,"AUTHOR",?17,"PATIENT",?34,"LAST4",?41,"STATUS"
187 . W ?53,"ENTRY DATE",?71,"IEN",?85,"DOC TYPE"
188 . W ?102,"EXP COSIGNER",?119,"PARENT IEN",!,LNE
189 Q
190FHDR(TIUSVC) ; Service Header
191 ; Input -- TIUSVC SERVICE/SECTION file (#49) NAME
192 ; Output -- None
193 W !!?10,"SERVICE: ",TIUSVC
194 Q
195PRNT(TIUDA) ; Does document have a parent?
196 ; Input -- TIUDA TIU Document file (#8925) IEN
197 ; Output -- TIUPRNT Null= TIU Document file (#8925) entry does
198 ; not have a parent
199 ; Exists= TIU Document file (#8925) entry is
200 ; an addendum or ID child.
201 ; Value: Parent TIU Document file
202 ; (#8925) IEN
203 N ADDMPRNT,IDPRNT,TIUPRNT
204 S TIUPRNT=""
205 S ADDMPRNT=+$P($G(^TIU(8925,TIUDA,0)),U,6) ; Addm parent
206 I '$D(^TIU(8925,ADDMPRNT,0)) S ADDMPRNT=0
207 I ADDMPRNT D
208 . S TIUPRNT=ADDMPRNT
209 E D
210 . S IDPRNT=+$G(^TIU(8925,TIUDA,21)) ; ID parent
211 . I '$D(^TIU(8925,IDPRNT,0)) S IDPRNT=0
212 . I IDPRNT D
213 . . S TIUPRNT=IDPRNT
214 Q TIUPRNT
215 ;
216ASKRNG(STDT,ENDT) ;Prompt for entry date range
217 ; Input -- None
218 ; Output -- 1=Successful and 0=Failure
219 ; STDT Start Date
220 ; ENDT End Date
221 N DIRUT,DTOUT,DUOUT,Y
222 W !!,"Please specify an Entry Date Range:",!
223 S STDT=+$$READ^TIUU("DA^:DT:E"," Start Entry Date: ")
224 I $D(DIRUT)!(STDT'>0) G ASKRNGQ
225 S ENDT=+$$READ^TIUU("DA^"_STDT_":DT:E","Ending Entry Date: ")_"."_235959
226 I $D(DIRUT)!(ENDT'>0) G ASKRNGQ
227 S Y=1
228ASKRNGQ Q +$G(Y)
Note: See TracBrowser for help on using the repository browser.