source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUASRPT.m@ 1094

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1TIUASRPT ; SLC/JMH - Review unsigned additional signer Documents by DIVISION ; [12/2/04 11:50am]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997
3BEGIN ; Select Division(s), Entry Date Range, Service, Type of Report
4 N TIUI,TIUSTDT,TIUENDT,TIUSVCS
5 D SELDIV^TIULA Q:SELDIV'>0
6 I $D(TIUDI) D
7 . S TIUI=0 F S TIUI=$O(TIUDI(TIUI)) Q:'TIUI D
8 . . S TIUDI("ENTRIES")=$G(TIUDI("ENTRIES"))_TIUI_";"
9 E D
10 . S TIUDI("ENTRIES")="ALL DIVISIONS"
11 ;
12 ;Ask Date Range, exit if timeout, '^' or no selection
13 Q:'$$ASKRNG(.TIUSTDT,.TIUENDT)
14 ;
15 ;Select Service, exit if timeout, '^' or no selection
16 Q:'$$SELSVC^TIULA(.TIUSVCS)
17 ;
18 N DIR,DIRUT,DTOUT,DUOUT,TIURPT
19 S DIR(0)="S^F:FULL;S:SUMMARY",DIR("A")="Type of Report"
20 S DIR("?",1)="Summary lists the number of documents by author's"
21 S DIR("?",2)="service/section. Full lists detailed document"
22 S DIR("?",3)="information by author's service/section."
23 S DIR("?")="Enter ""^"", or a RETURN to quit."
24 D ^DIR Q:$D(DIRUT) S TIURPT=Y
25 ;
26DEV ; Device selection
27 I TIURPT="F" D
28 . W !!,"This report should be sent to a 132 Column Device"
29 S %ZIS="Q" W ! D ^%ZIS I POP K POP G EXIT
30 I $D(IO("Q")) D G EXIT
31 . S ZTRTN="BUILD^TIUASRPT"
32 . S ZTSAVE("TIUDI(")="",ZTSAVE("TIURPT")=""
33 . S ZTSAVE("TIUSTDT")="",ZTSAVE("TIUENDT")=""
34 . S ZTSAVE("TIUSVCS")="",ZTSAVE("TIUSVCS(")=""
35 . S ZTDESC="TIU PENDING ADD. SIGNATURES BY DIV"
36 . D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
37 . K ZTSK,ZTDESC,ZTRTN,ZTSAVE,%ZIS,TIUDIV,TIURPT,TIUIFP
38 . D HOME^%ZIS
39 U IO D BUILD,^%ZISC
40 Q
41BUILD ; Build list
42 N TIUIFP,TIUK
43 K ^TMP("TIUD",$J)
44 I $D(ZTQUEUED) S ZTREQ="@"
45 I +$G(TIUDI("ENTRIES")) D
46 . S TIUK=0 F S TIUK=$O(TIUDI(TIUK)) Q:'TIUK D
47 . . S TIUIFP=$G(TIUDI(TIUK))
48 . . D GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
49 E D
50 . S TIUIFP=0
51 . F S TIUIFP=$O(^TIU(8925,"ADIV",TIUIFP)) Q:+TIUIFP'>0 D
52 . . D GATHER(TIUIFP,TIUSTDT,TIUENDT,.TIUSVCS)
53 D PRINT
54 ;
55EXIT ; Clean up and exit
56 K SELDIV,TIUDI,TIUSTDT,TIUENDT,TIUSVCS K ^TMP("TIUD",$J)
57 Q
58GATHER(TIUIFP,TIUSTDT,TIUENDT,TIUSVCS) ; Find records for the list
59 ; Input -- TIUIFP INSTITUTION file (#4) IEN
60 ; (0 = gather all divisions)
61 ; TIUSTDT Start Date
62 ; TIUENDT End Date
63 ; TIUSVCS Service Selection Array
64 ; Output -- None
65 N TIUDA,TIUJ,TIUS,TIUTP
66 S TIUTP=TIUSTDT
67 F S TIUTP=$O(^TIU(8925.7,"AC",TIUTP)) Q:'TIUTP!(TIUTP>(TIUENDT+1)) D
68 . N TIUIEN S TIUIEN=0
69 . F S TIUIEN=$O(^TIU(8925.7,"AC",TIUTP,TIUIEN)) Q:'TIUIEN D
70 . . I $P($G(^TIU(8925,TIUIEN,12)),U,12)'=TIUIFP Q
71 . . D ADDELMNT(TIUIEN,.TIUSVCS)
72 Q
73 ;
74ADDELMNT(TIUDA,TIUSVCS) ; Add each element to the list
75 ; Input -- TIUDA TIU DOCUMENT file (#8925) IEN
76 ; TIUSVCS Service Selection Array
77 ; Output -- None
78 N TIUASREC,TIUSVC,TIUEDT,TIUD12,TIUIFP,TIUSTAT
79 S TIUSTAT=$P($G(^TIU(8925,TIUDA,0)),U,5)
80 I TIUSTAT>8 Q
81 S TIUASREC=0
82 S TIUD12=$G(^TIU(8925,TIUDA,12))
83 S TIUEDT=+$P(TIUD12,U),TIUIFP=+$P(TIUD12,U,12)
84 F S TIUASREC=$O(^TIU(8925.7,"B",TIUDA,TIUASREC)) Q:'TIUASREC D
85 . N TIUAS,TIUASSVC
86 . S TIUAS=$P(^TIU(8925.7,TIUASREC,0),U,3)
87 . I 'TIUAS!$P(^TIU(8925.7,TIUASREC,0),U,4) Q
88 . S TIUASSVC=$$PROVSVC^TIULV(TIUAS)
89 . I $G(TIUSVCS)="ALL"!($D(TIUSVCS(+TIUASSVC))) D
90 . . S TIUAS=$$PERSNAME^TIULC1(TIUAS)
91 . . I $P(TIUASSVC,U,2)]"" S TIUASSVC=$P(TIUASSVC,U,2)
92 . . E S TIUASSVC="UNKNOWN"
93 . . I TIUAS'="UNKNOWN" S TIUAS=$$NAME^TIULS(TIUAS,"LAST, FI MI")
94 . . S ^TMP("TIUD",$J,TIUIFP,TIUASSVC,TIUAS,TIUEDT)=TIUDA
95 Q
96 ;
97PRNT(TIUDA) ; Does document have a parent?
98 ; Input -- TIUDA TIU Document file (#8925) IEN
99 ; Output -- TIUPRNT Null= TIU Document file (#8925) entry does
100 ; not have a parent
101 ; Exists= TIU Document file (#8925) entry is
102 ; an addendum or ID child.
103 ; Value: Parent TIU Document file
104 ; (#8925) IEN
105 N ADDMPRNT,IDPRNT,TIUPRNT
106 S TIUPRNT=""
107 S ADDMPRNT=+$P($G(^TIU(8925,TIUDA,0)),U,6) ; Addm parent
108 I '$D(^TIU(8925,ADDMPRNT,0)) S ADDMPRNT=0
109 I ADDMPRNT D
110 . S TIUPRNT=ADDMPRNT
111 E D
112 . S IDPRNT=+$G(^TIU(8925,TIUDA,21)) ; ID parent
113 . I '$D(^TIU(8925,IDPRNT,0)) S IDPRNT=0
114 . I IDPRNT D
115 . . S TIUPRNT=IDPRNT
116 Q TIUPRNT
117 ;
118ASKRNG(STDT,ENDT) ;Prompt for entry date range
119 ; Input -- None
120 ; Output -- 1=Successful and 0=Failure
121 ; STDT Start Date
122 ; ENDT End Date
123 N DIRUT,DTOUT,DUOUT,Y
124 W !!,"Please specify an Entry Date Range:",!
125 S STDT=+$$READ^TIUU("DA^:DT:E"," Start Entry Date: ")
126 I $D(DIRUT)!(STDT'>0) G ASKRNGQ
127 S ENDT=+$$READ^TIUU("DA^"_STDT_":DT:E","Ending Entry Date: ")_"."_235959
128 I $D(DIRUT)!(ENDT'>0) G ASKRNGQ
129 S Y=1
130ASKRNGQ Q +$G(Y)
131DHDR(TIUFP,TIUSTDT,TIUENDT) ;
132 ;DIVISION HEADER
133 N TIUR,TIURNG,TIUINST
134 S TIUPG=(+$G(TIUPG))+1
135 D DT^DILF("ET","NOW",.TIUR)
136 S TIURNG=$$FMTE^XLFDT(TIUSTDT)_" thru "_$$FMTE^XLFDT(TIUENDT)
137 S TIUINST=$S(TIUIFP:$P($$NS^XUAF4(TIUIFP),U),1:"ALL DIVISIONS")
138 W @IOF,"Pending Additional Signature Documents for "_TIUINST
139 W " on "_$$FMTE^XLFDT($$NOW^XLFDT)
140 W !,?10,TIURNG,?70,"Page: "_+$G(TIUPG)
141 I TIURPT'="F" D
142 . W !,"------------------------------------------------------------------------------"
143 I TIURPT="F" D
144 . W !,"------------------------------------------------------------------------------------------------------------------------------------"
145 . W !,"IDENT. SIGNER",?17,"PATIENT",?27,"STATUS",?35,"ENTRY DATE"
146 . W ?54,"DOCUMENT TITLE",?81,"DOCUMENT IEN"
147 . W !,"------------------------------------------------------------------------------------------------------------------------------------"
148 Q
149SHDR(TIUSVC) ;
150 ; SERVICE HEADER
151 W !!?10,"SERVICE: ",TIUSVC
152 Q
153PRINT ;
154 N TIUPG,TIUIFP,TIUOUT,TIUTOT
155 S (TIUPG,TIUIFP,TIUOUT,TIUTOT)=0
156 F S TIUIFP=$O(^TMP("TIUD",$J,TIUIFP)) Q:'TIUIFP!(TIUOUT) D
157 . N TIUSVC,TIUDCNT
158 . S (TIUSVC,TIUDCNT)=0
159 . D DHDR(TIUIFP,TIUSTDT,TIUENDT)
160 . F S TIUSVC=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC)) Q:TIUSVC=""!(TIUOUT) D
161 . . N TIUAS,TIUSVCNT
162 . . S (TIUAS,TIUSVCNT)=0
163 . . I $Y>(IOSL-5) D ASK Q:TIUOUT D DHDR(TIUIFP,TIUSTDT,TIUENDT)
164 . . I TIURPT="F" D SHDR(TIUSVC)
165 . . F S TIUAS=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAS)) Q:TIUAS=""!(TIUOUT) D
166 . . . N TIUEDT
167 . . . S TIUEDT=""
168 . . . F S TIUEDT=$O(^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAS,TIUEDT)) Q:'TIUEDT!(TIUOUT) D
169 . . . . N TIUDA
170 . . . . S TIUDA=^TMP("TIUD",$J,TIUIFP,TIUSVC,TIUAS,TIUEDT)
171 . . . . I TIURPT="F" D PRNTITEM(TIUDA,TIUAS,TIUEDT)
172 . . . . I $Y>(IOSL-5) D ASK Q:TIUOUT D DHDR(TIUIFP,TIUSTDT,TIUENDT)
173 . . . . S TIUSVCNT=TIUSVCNT+1,TIUDCNT=TIUDCNT+1
174 . . W !," Totals for Service ",TIUSVC,": ",?55,TIUSVCNT
175 . . I $Y>(IOSL-5) D ASK Q:TIUOUT D DHDR(TIUIFP,TIUSTDT,TIUENDT)
176 . Q:TIUOUT
177 . N TIUDVSTR S TIUDVSTR=$E($P($$NS^XUAF4(TIUIFP),U),1,25)
178 . W !,"Totals for Division ",TIUDVSTR,": ",?55,TIUDCNT
179 . I $O(^TMP("TIUD",$J,TIUIFP)) D ASK Q:TIUOUT
180 . S TIUTOT=TIUTOT+TIUDCNT
181 Q:TIUOUT
182 W !,"Totals for all Divisions: ",?55,TIUTOT
183 Q
184PRNTITEM(TIUDA,TIUAS,TIUEDT) ;
185 N TIUPRNT,TIUPAT,TIUSTAT,TIUTYP,TIUD0,TIUD12,TIULST4,TIUDATE
186 S TIUPRNT=$$PRNT(TIUDA)
187 S TIUD0=$G(^TIU(8925,TIUDA,0))
188 S TIULST4=$E($$GET1^DIQ(2,$G(TIUPAT),.09),6,9)
189 S TIUPAT=$$PATPRNT($P($G(TIUD0),U,2))
190 S TIUSTAT=$P($G(TIUD0),U,5)
191 S TIUSTAT=$S(TIUSTAT:$E($$EXTERNAL^DILFD(8925,.05,"",TIUSTAT),1,11),1:"UNKNOWN")
192 S TIUSTAT=$$STATXFER(TIUSTAT)
193 S TIUTYP=+TIUD0
194 S TIUTYP=$E($P($G(^TIU(8925.1,TIUTYP,0)),U),1,25)
195 S TIUDATE=$$FMTE^XLFDT(TIUEDT,2)
196 W !,TIUAS,?17,$G(TIUPAT),?27," "_TIUSTAT,?35,$G(TIUDATE)
197 W ?54,$G(TIUTYP),?81,TIUDA
198 I +$G(TIUPRNT) W " PARENT = "_TIUPRNT
199 Q
200ASK ;
201 I IO=IO(0),$E(IOST)="C" D
202 . W ! N DIR,Y S DIR(0)="E" D ^DIR K DIR
203 . I Y=""!(Y=0) S TIUOUT=1
204 Q
205STATXFER(TIUSTAT) ;format a small status string
206 I TIUSTAT="COMPLETED"!(TIUSTAT="completed") Q "com"
207 I TIUSTAT="UNSIGNED"!(TIUSTAT="unsigned") Q "uns"
208 I TIUSTAT="UNCOSIGNED"!(TIUSTAT="uncosigned") Q "uncos"
209 I TIUSTAT="UNDICTATED"!(TIUSTAT="undictated") Q "undic"
210 I TIUSTAT="UNTRANSCRIBED"!(TIUSTAT="untranscribed") Q "untr"
211 I TIUSTAT="UNRELEASED"!(TIUSTAT="unreleased") Q "unrel"
212 I TIUSTAT="UNVERIFIED"!(TIUSTAT="unverified") Q "unver"
213 I TIUSTAT="AMENDED"!(TIUSTAT="amended") Q "amend"
214 Q "???"
215PATPRNT(TIUPAT) ; format patient as initials and then last 6 SSN
216 N PAT,LST4,INIT
217 I 'TIUPAT Q ""
218 S PAT=$$EXTERNAL^DILFD(8925,.02,"",TIUPAT)
219 S LST4=$E($$GET1^DIQ(2,$G(TIUPAT),.09),4,9)
220 S INIT=$E($P(PAT,",",2))_$E($P(PAT,","))
221 Q INIT_LST4
Note: See TracBrowser for help on using the repository browser.