source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUADCL.m@ 1608

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

initial load of WorldVistAEHR
File size: 8.2 KB
RevLine 
[613]1TIUADCL ; SLC/AJB - UNK Addenda Cleanup ; 10/01/04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**173**;Jun 20, 1997
3 ;
4 ; Cleanup Utility for OPERATION REPORT addenda.
5 ; Finds parentless/unknown addenda and attaches to user
6 ; selected parent.
7 ;
8 Q
9EN ; main entry point for TIU UNK ADDENDA CLEANUP
10 N DTR1,TIUQUIT
11 D DTRANGE(.DTR1) Q:$D(TIUQUIT)
12 D EN^VALM("TIU UNK ADDENDA CLEANUP")
13 Q
14EXIT ;
15 D XQORM
16 Q
17HDR ; sets header
18 N HDR
19 S HDR="UNKNOWN ADDENDA from "_$$FMTE^XLFDT(DTR1("BEGDT"),"D")_" to "_$$FMTE^XLFDT(DTR1("ENDDT"),"D")
20 S VALMHDR(1)=$$SETSTR^VALM1(HDR,"",(IOM-$L(HDR))/2,$L(HDR))
21 D XQORM
22 Q
23HELP ; help code
24 N DIR
25 I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
26 D FULL^VALM1
27 W !!,"The following actions are available:"
28 W !,"Browse a Document - View a selected document (if authorized)"
29 W !,"Change View - Modify search criteria"
30 W !,"Detailed Display - View detailed display of a document (if authorized)"
31 W !,"Find Parent - Find available OPERATION REPORTS to assign as parent",!
32 I $D(DIR("A")) D ^DIR
33 S VALMBCK="R"
34 Q
35INIT ; finds unknown addenda & creates list
36 N ADDENDUM,STRTDT,TIUDA,TIU
37 S TIU("IOCUOFF")=$C(27)_"[?25l",TIU("IOCUON")=$C(27)_"[?25h"
38 W TIU("IOCUOFF")
39 W !!,"Searching for the documents."
40 S ADDENDUM=$$CHKFILE(8925.1,"ADDENDUM","I $P(^(0),U,4)=""DOC"""),TIUDA="",STRTDT=DTR1("BEGDT"),VALMCNT=0
41 F S STRTDT=$O(^TIU(8925,"F",STRTDT)) Q:STRTDT=""!(STRTDT>DTR1("ENDDT")) F S TIUDA=$O(^TIU(8925,"F",STRTDT,TIUDA)) Q:TIUDA="" I +$G(^TIU(8925,TIUDA,0))=ADDENDUM,'+$P($G(^TIU(8925,TIUDA,0)),U,6) D
42 . N DISPLAY
43 . S VALMCNT=VALMCNT+1 W:VALMCNT#3=0 "."
44 . S DISPLAY=$$SETSTR^VALM1(VALMCNT,"",1,4)
45 . S DISPLAY=$$SETSTR^VALM1($$PATIENT^TIU144($P($G(^TIU(8925,TIUDA,0)),U,2)),DISPLAY,6,38)
46 . S DISPLAY=$$SETSTR^VALM1(TIUDA,DISPLAY,40,50)
47 . S DISPLAY=$$SETSTR^VALM1($$FDATE^VALM1($$GET1^DIQ(8925,TIUDA,1201,"I")),DISPLAY,52,62)
48 . S DISPLAY=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),DISPLAY,62,73)
49 . S DISPLAY=$$SETSTR^VALM1("NO",DISPLAY,74,76)
50 . D SET^VALM10(VALMCNT,DISPLAY,TIUDA)
51 I VALMCNT=0 D
52 . D SET^VALM10(2,$$SETSTR^VALM1("No records found to satisfy search criteria.","",(IOM-$L("No records found to satisfy search criteria."))/2,$L("No records found to satisfy search criteria.")),0)
53 Q
54XQORM ; default action for list manager
55 S XQORM("#")=$O(^ORD(101,"B","TIU UNK ADDENDA SELECT",0))_U_"1:"_VALMCNT
56 Q
57ACTIONS ; user selectable actions
58 N ACTION,TIUCONT
59 D I ACTION=-1 S VALMBCK="R" Q
60 . N DIR,DIRUT,POP,X,Y
61 . S DIR(0)=$S(VALM("TITLE")="TIU/Surgery Cleanup":"SA^1:Browse Document;2:Detailed Display;3:Find Parent",1:"SA^1:Browse Document;2:Detailed Display;3:Attach to Parent")
62 . S DIR("A")="Select Action: "
63 . S DIR("B")=$S(VALM("TITLE")="TIU/Surgery Cleanup":"Find Parent",1:"Attach to Parent")
64 . S DIR("L",1)="1. Browse a Document"
65 . S DIR("L",2)=$S(VALM("TITLE")="TIU/Surgery Cleanup":"2. Detailed Display 3. Find Parent",1:"2. Detailed Display 3. Attach to Parent")
66 . S DIR("L",4)=""
67 . S DIR("L")="Enter selection by typing the name, number, or abbreviation"
68 . S DIR("?",1)="The following actions are available:"
69 . S DIR("?",2)=""
70 . S DIR("?",3)="Browse a Document - View a selected document (if authorized)"
71 . S DIR("?",4)="Detailed Display - Detailed View of a selected document (if authorized)"
72 . S DIR("?")=$S(VALM("TITLE")="TIU/Surgery Cleanup":"Find Parent - Find OPERATION REPORT to attach as parent",1:"Attach to Parent - Attach selected addenda to parent")
73 . F D ^DIR D Q:$G(TIUCONT)!$D(DIRUT)
74 . . I VALM("TITLE")="Operation Reports",$$MULTI("TIUDOCS")>1,+Y=3 D Q
75 . . . W !!,"You may only attach addenda to one parent at a time."
76 . . . W !,"Select only one parent for this action.",!
77 . . . I $$READ^TIUU("EA","Press <RETURN> to continue")
78 . . I $$MULTI("TIUDOCS")>1,(+Y=1!(+Y=2)) D Q
79 . . . W !!,"You may only view one document at a time."
80 . . . W !,"Select only one document for this action.",!
81 . . . I $$READ^TIUU("EA","Press <RETURN> to continue")
82 . . S TIUCONT=1
83 . I VALM("TITLE")="TIU/Surgery Cleanup" S ACTION=$S(+Y=1:"BROWSE",+Y=2:"DETDISP",+Y=3:"FNDPRNT",Y=U:-1,1:-1)
84 . E S ACTION=$S(+Y=1:"BROWSE",+Y=2:"DETDISP",+Y=3:"ATTACH^TIUADCL1",Y=U:-1,1:-1)
85 I $G(TIUCONT)=1 D @ACTION
86 S VALMBCK=$S(ACTION="ATTACH^TIUADCL1":"Q",1:"R")
87 Q
88BROWSE ; browse document
89 N TIUDA S TIUDA=+$$ONEDOC()
90 D EN^VALM("TIU BROWSE FOR READ ONLY")
91 Q
92CHKFILE(FILE,NAME,SCREEN) ; checks entry in file and returns IEN
93 N DIC,X,Y S DIC=FILE,DIC(0)="X",DIC("S")=$G(SCREEN),X=NAME D ^DIC
94 Q +Y
95CHNGVIEW ; allows user to change search parameters
96 D FULL^VALM1
97 W @IOF
98 I VALM("TITLE")="TIU/Surgery Cleanup" D I $D(TIUQUIT) S VALMBCK="R" Q
99 . D DTRANGE(.DTR1) Q:$D(TIUQUIT)
100 . D CLEAN^VALM10,INIT,HDR S VALMBG=1
101 I VALM("TITLE")="Operation Reports" D I $D(TIUQUIT) S VALMBCK="R" Q
102 . D DTRANGE(.DTR2) Q:$D(TIUQUIT)
103 . D CLEAN^VALM10,INIT^TIUADCL1,HDR^TIUADCL1 S VALMBG=1
104 Q
105DATE(TIUDT,TIUSEQ) ; if date is year entry only, appends Jan 01/Dec 31@2400 respectively
106 I TIUDT["0000" S TIUDT=TIUDT/10000,TIUDT=TIUDT_$S(TIUSEQ=1:"0101",TIUSEQ=2:"1231")
107 I TIUSEQ=2 S TIUDT=TIUDT_".24"
108 Q TIUDT
109DTRANGE(DTRANGE) ; prompts user for date range input
110 N %DT,CNT,POP,X,Y
111 S %DT="AE",%DT(0)=$$NOW^XLFDT*-1
112 W @IOF
113 F CNT=1:1:2 D
114 . S %DT("A")=$S(CNT=1:"START WITH REFERENCE DATE: ",CNT=2:" GO TO REFERENCE DATE: ")
115 . S %DT("B")=$S(CNT=1:"Jan 01, 2003",CNT=2:$P($$HTE^XLFDT($H),"@"))
116 . D ^%DT
117 . I Y=-1 S CNT=2,TIUQUIT=1 Q
118 . I CNT=1 S DTRANGE("BEGDT")=$$DATE(Y,CNT),%DT(0)=DTRANGE("BEGDT") Q
119 . S DTRANGE("ENDDT")=$$DATE(Y,CNT),X=$P($$NOW^XLFDT,".")_".24" I DTRANGE("ENDDT")>X S CNT=1 W !!,?42,"Future dates are not allowed.",!
120 Q
121DETDISP ; detailed display
122 N D0,DIROUT,RSTRCTD,TIUDA,TIUD,TIUDATA,TIUGDATA,TIUSEL,TIUI,TIUQUIT,Y
123 S TIUDA=+$$ONEDOC()
124 D
125 . N TIUVIEW
126 . D CLEAR^VALM1
127 . S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
128 . I +TIUVIEW'>0 D Q
129 . . W !!,$C(7),$P(TIUVIEW,U,2),!
130 . . I $$READ^TIUU("EA","Press <RETURN> to continue")
131 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
132 . I RSTRCTD D Q
133 . . W !!,$C(7),"Ok, no harm done...",!
134 . . I $$READ^TIUU("EA","Press <RETURN> to continue")
135 . D EN^TIUAUDIT
136 . I +$G(TIUQUIT) D FIXLSTNW^TIULM Q
137 K VALMY S VALMBCK="R"
138 Q
139FNDPRNT ; executes LM for TIU UNK ADDENDA ATTACH
140 N PARENT,TIUDISP,TIUTMP
141 D EN^TIUADCL1
142 S TIUTMP=""
143 F S TIUTMP=$O(TIUDOCS(TIUTMP)) Q:TIUTMP="" D
144 . S TIUDISP=@VALMAR@(TIUTMP,0)
145 . S PARENT=+$P($G(^TIU(8925,TIUDOCS(TIUTMP),0)),U,6)
146 . S TIUDISP=$$SETSTR^VALM1($S(PARENT=0:"NO",PARENT>0:"#"_PARENT),TIUDISP,74,80)
147 . D SET^VALM10(TIUTMP,TIUDISP,TIUDOCS(TIUTMP))
148 D RE^VALM4
149 Q
150MULTI(TIUCHK) ;
151 N TIUCNT,TIUTMP
152 S TIUCNT=0,TIUTMP=""
153 F S TIUTMP=$O(@TIUCHK@(TIUTMP)) Q:TIUTMP="" S TIUCNT=TIUCNT+1
154 Q TIUCNT
155ONEDOC() ;
156 N TIUTMP
157 S TIUTMP=""
158 F S TIUTMP=$O(TIUDOCS(TIUTMP)) Q:+TIUTMP
159 Q TIUDOCS(TIUTMP)
160SELECT(ACTION) ; selects document(s) and calls ACTION
161 N TIUDOCS,TIUSEL,TIUQUIT
162 D FULL^VALM1
163 I VALMCNT=0 W !,"No documents to select." H 3 Q
164 S TIUSEL=$P(XQORNOD(0),"=",2)
165 I TIUSEL="" D Q:$D(TIUQUIT)
166 . I VALMLST=1 S TIUDOCS(1)=$O(@VALMAR@("IDX",1,"")) Q
167 . N DIR,X,Y
168 . S DIR("A")="Select Document(s): (1-"_VALMLST_") "
169 . S DIR(0)="LAC^1:"_VALMLST
170 . D ^DIR I $D(DIRUT)!(Y=U) S TIUQUIT=1 Q
171 . S TIUSEL=Y(0)
172 I $A($E(TIUSEL,$L(TIUSEL)))<48!($A($E(TIUSEL,$L(TIUSEL)))>57) S TIUSEL=$E(TIUSEL,1,$L(TIUSEL)-1)
173 F X=1:1 Q:$P(TIUSEL,",",X)="" D
174 . N TIUCNT
175 . I $P(TIUSEL,",",X)["-" F TIUCNT=+$P(TIUSEL,",",X):1:$P($P(TIUSEL,",",X),"-",2) S:TIUCNT<VALMLST TIUDOCS(TIUCNT)=$O(@VALMAR@("IDX",TIUCNT,""))
176 . E S:$P(TIUSEL,",",X)'>VALMLST TIUDOCS($P(TIUSEL,",",X))=$O(@VALMAR@("IDX",$P(TIUSEL,",",X),""))
177 I $$MULTI("TIUDOCS")>1,VALM("TITLE")="Operation Reports" D Q
178 . W !!,"You may not select multiple OPERATION Reports to view or attach addenda to."
179 . W !,"Select only one document to view or attach addenda.",!
180 . I $$READ^TIUU("EA","Press <RETURN> to continue")
181 . S VALMBCK="R"
182 I $$MULTI("TIUDOCS")>1,(ACTION="BROWSE"!(ACTION="DETDISP")) D Q
183 . W !!,"You may only view one document at a time."
184 . W !,"Select only one document for this action.",!
185 . I $$READ^TIUU("EA","Press <RETURN> to continue")
186 I VALM("TITLE")'="Operation Reports" S VALMBCK="R"
187 S TIUDOCS="" F S TIUDOCS=$O(TIUDOCS(TIUDOCS)) Q:TIUDOCS="" I $$GET1^DIQ(8925,TIUDOCS(TIUDOCS),.06)'="" K TIUDOCS(TIUDOCS)
188 I $D(TIUDOCS)'>1 S VALMBCK="R" Q
189 D @ACTION
190 Q
Note: See TracBrowser for help on using the repository browser.