source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53558M.m@ 1800

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

initial load of WorldVistAEHR

File size: 7.6 KB
RevLine 
[613]1DG53558M ;ALB/GN - DG*5.3*558 CLEANUP UTILITES ; 7/16/04 11:14am
2 ;;5.3;Registration;**558,579**;Aug 13, 1993
3 ;
4 ;DG*53.*579 - add line for records modified vs. deleted ones
5 ; Misc cleanup utilities
6 ;
7DELMT(IEN,DFN,PUR,DELETED,LINK) ; Kill duplicate MT
8 S DELETED=0
9 Q:'$G(IEN)
10 S TESTING=+$G(TESTING,1),DFN=$G(DFN)
11 S DELETED=$$DEL^DG53558M(IEN,.LINK,DFN)
12 Q:'DELETED
13 S PUR=PUR+1
14 I '$D(ZTQUEUED) W !,"Deleting Dupe IEN in 408.31 > ",IEN," for DFN > ",DFN
15 Q
16 ;
17DEL(IVMMTIEN,IVMLINK,DFN) ; delete 408.31 ien only, no income related files killed here
18 ; input: ien to be deleted
19 ; output: 1 = was deleted
20 ; 0 = was not deleted
21 N DA,DIK,IVMTYP
22 S DFN=$G(DFN)
23 S IVMTYP=$P($G(^DGMT(408.31,IVMMTIEN,0)),"^",19) ;test type
24 S IVMLINK=$P($G(^DGMT(408.31,IVMMTIEN,2)),"^",6)
25 ;don't delete copay test linked to valid means test directly
26 I IVMTYP=2,IVMLINK,$D(^DGMT(408.31,IVMLINK,0)) Q 0
27 ;
28 S DA=IVMMTIEN,DIK="^DGMT(408.31," D:'$G(TESTING) ^DIK ;del MT here
29 D:DFN D4081275(DFN)
30 ;
31 ;delete linked RXCT here after above delete of the MT
32 I IVMTYP=1,IVMLINK D
33 . S DA=IVMLINK,DIK="^DGMT(408.31," D:'$G(TESTING) ^DIK
34 . D:DFN D4081275(DFN)
35 ;
36 Q 1
37 ;
38D4081275(DFN) ; Deletes SPOUSE Effective date multiple entries that may exist
39 ; and point to the MT just deleted.
40 ;
41 Q:'$D(^DPT(DFN,0))
42 N R12,EIEN,ENODE,QUIT,DA,DIK
43 S R12=0
44 F S R12=$O(^DGPR(408.12,"B",DFN,R12)) Q:'R12 D
45 . Q:$P($G(^DGPR(408.12,R12,0)),"^",2)'=2 ;only process spouse
46 . ; drive through the Effective Date Multiple in ien reverse order
47 . S EIEN="A",QUIT=0
48 . F S EIEN=$O(^DGPR(408.12,R12,"E",EIEN),-1) Q:'EIEN D Q:QUIT
49 . . S ENODE=$G(^DGPR(408.12,R12,"E",EIEN,0))
50 . . Q:+$P(ENODE,"^",2) ;active flag
51 . . Q:'+$P(ENODE,"^",4) ;no MT ien
52 . . Q:$D(^DGMT(408.31,$P(ENODE,"^",4),0)) ;points to valid MT
53 . . ; if inactive and does not point to a valid MT, delete this
54 . . ; effective date multiple rec from 408.1275
55 . . S DA=EIEN,DA(1)=R12,DIK="^DGPR(408.12,"_DA(1)_",""E"","
56 . . D:'$G(TESTING) ^DIK
57 . . I '$D(ZTQUEUED) W !,"Deleting BAD 408.1275 > ",R12,",",EIEN
58 . . S QUIT=1
59 Q
60 ;
61MAIL ; mail stats
62 N BTIME,HTEXT,TEXT,NAMSPC,LIN,TYPNAM,MSGNO,IVMBAD,IVMPUR,IVMTOT,IVMPFL
63 S MSGNO=0
64 S NAMSPC=$$NAMSPC^DG53558
65 S IVMTOT=$P($G(^XTMP(NAMSPC,0,0)),U,2)
66 S IVMPUR=$P($G(^XTMP(NAMSPC,0,0)),U,3)
67 S BTIME=$P($G(^XTMP(NAMSPC,0,0)),U,4)
68 S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,5)
69 S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,6)
70 S IVMBAD=$P($G(^XTMP(NAMSPC,0,0)),U,7)
71 S IVMPFL=$P($G(^XTMP(NAMSPC,0,0)),U,8)
72 ;
73 D HDNG(.HTEXT,.MSGNO,.LIN)
74 D SUMRY(.LIN)
75 D MAILIT(HTEXT)
76 ;
77 D SNDDET
78 Q
79 ;
80HDNG(HTEXT,MSGNO,LIN) ;build heading lines for mail message
81 K ^TMP(NAMSPC,$J,"MSG")
82 S LIN=0
83 S HTEXT="Cleanup Dupes in the Means Test file "_STAT_" on "
84 S HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
85 D BLDLINE(HTEXT,.LIN)
86 D BLDLINE("",.LIN)
87 I TESTING S TEXT="** TESTING **" D BLDLINE(TEXT,.LIN)
88 I MSGNO S TEXT="Message number: "_MSGNO D BLDLINE(TEXT,.LIN)
89 D BLDLINE("",.LIN)
90 I MSGNO D
91 . S TEXT="* = modified due to IVM Converted Test scenario"
92 . D BLDLINE(TEXT,.LIN) ;DG*5.3*579
93 S MSGNO=MSGNO+1
94 Q
95 ;
96SUMRY(LIN) ;build summary lines for mail message
97 S TEXT=" Records Processed: "_$J($FN(IVMTOT,","),11)
98 D BLDLINE(TEXT,.LIN)
99 S TEXT="Duplicate Tests Purged: "_$J($FN(IVMPUR,","),11)
100 D BLDLINE(TEXT,.LIN)
101 S TEXT=" Null Tests Purged: "_$J($FN(IVMBAD,","),11)
102 D BLDLINE(TEXT,.LIN)
103 S TEXT="Primary status changed: "_$J($FN(IVMPFL,","),11)
104 D BLDLINE(TEXT,.LIN)
105 D BLDLINE("",.LIN)
106 D BLDLINE("",.LIN)
107 D BLDLINE("",.LIN)
108 ;
109 I (IVMPUR+IVMBAD+IVMPFL) D
110 . D BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
111 Q
112 ;
113SNDDET ;build and send detail messages limit under 2000 lines each
114 N BAD,DATE,GL,MAXLIN,MORE,NAME,SSN
115 S MAXLIN=1995,MORE=0
116 D HDNG(.HTEXT,.MSGNO,.LIN)
117 ;
118 S GL=$NA(^XTMP(NAMSPC_".DET",1)),TYPNAM=""
119 F S GL=$Q(@GL) Q:GL="" Q:$QS(GL,1)'=(NAMSPC_".DET") D
120 . S MORE=1 ;at least 1 more line to send
121 . S DFN=$QS(GL,2)
122 . S ICDT=$QS(GL,3)
123 . S MTIEN=$QS(GL,4)
124 . S BAD=$QS(GL,5)
125 . S SSN=$P($G(^DPT(DFN,0)),"^",9),NAME=$P($G(^DPT(DFN,0)),"^")
126 . S DATE=$$FMTE^XLFDT(ICDT)
127 . S TYPNAM=$G(@GL)
128 . S TEXT=$S(TYPNAM["PRIMARY":"* Prim> ",1:" Dupe> ")
129 . S:BAD="BAD" TEXT=" Null> "
130 . S TEXT=TEXT_"ssn: "_SSN_" "_$J(TYPNAM,22)_" date: "_DATE_" ien: "_MTIEN
131 . D BLDLINE(TEXT,.LIN)
132 . ;max lines reached, print a msg
133 . I LIN>MAXLIN D MAILIT(HTEXT),HDNG(.HTEXT,.MSGNO,.LIN) S MORE=0
134 ;
135 ;print final message if any to print
136 D MAILIT(HTEXT):MORE
137 Q
138 ;
139BLDLINE(TEXT,LIN) ;build a single line into TMP message global
140 S LIN=LIN+1
141 S ^TMP(NAMSPC,$J,"MSG",LIN)=TEXT
142 Q
143MAILIT(HTEXT) ; send the mail message
144 N XMY,XMDUZ,XMSUB,XMTEXT
145 S XMY(DUZ)="",XMDUZ=.5
146 S XMSUB=HTEXT_" Results"
147 S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
148 D ^XMD
149 Q
150 ;
151MONITOR ; Monitor job while running
152 N IOINORM,IOINHI,IOUON,IOUOFF,IOBON,IOBOFF,IORVON,IORVOFF,IOHOME
153 N IOELEOL,NAMSPC,REC,IVMTOT,IVMPUR,STIME,IVMEND,RUN,IVMTOTAL,IVMLST
154 N STAT,IVMLINE,IVMBLNK,NOWTIM,%H,DTOUT,I,IVMLEN,IVMQUIT,TITLE,TLEN,X
155 N NOWTIME,PCT,TMP
156 S:'$D(U) U="^"
157 S NAMSPC=$$NAMSPC^DG53558
158 S TMP=0 F IVMTOTAL=0:1 S TMP=$O(^DGMT(408.31,"C",TMP)) Q:'TMP
159 S IVMQUIT=0
160 D SCRNSET
161 ;
162 F D Q:IVMQUIT
163 . ;check lock status
164 . L +^XTMP(NAMSPC):0
165 . I '$T S RUN=1
166 . E S RUN=0
167 . L -^XTMP(NAMSPC)
168 . S REC=$G(^XTMP(NAMSPC,0,0))
169 . S STAT=$P(REC,U,5) S:STAT="" STAT="NOT RUNNING"
170 . S IVMLST=$P(REC,U,1),IVMTOT=$P(REC,U,2),IVMPUR=$P(REC,U,3)
171 . S STIME=$P(REC,U,6),IVMBAD=$P(REC,U,7)
172 . S:IVMTOTAL>0 PCT=IVMTOT/IVMTOTAL
173 . S PCT=PCT*100
174 . S NOWTIME=$$NOW^XLFDT
175 . I (RUN&(STAT'="RUNNING"))!('RUN&(STAT="RUNNING")) D
176 . . S STAT="ERRORED"
177 . D CLRSCR
178 . S $P(IVMBLNK," ",81)=""
179 . S IVMLINE=IVMBLNK
180 . S TITLE="Cleanup Duplicates in the Means Test file"
181 . S TLEN=(80-$L(TITLE)\2)
182 . W $$FMTE^XLFDT($$NOW^XLFDT,"2P")
183 . W ?65,"Completed ",$FN(PCT,"",0),"%",!!
184 . W ?TLEN,IOINHI,IOUON,TITLE,IOUOFF,IOINORM,!
185 . S IVMLINE=IVMBLNK
186 . S IVMLINE=$$FMTLINE(IVMLINE,4,"Status")
187 . S IVMLINE=$$FMTLINE(IVMLINE,12,"Total recs")
188 . S IVMLINE=$$FMTLINE(IVMLINE,24,"Dupes Purged")
189 . S IVMLINE=$$FMTLINE(IVMLINE,38,"Nulls Purged")
190 . S IVMLINE=$$FMTLINE(IVMLINE,52,"Last DFN")
191 . S IVMLINE=$$FMTLINE(IVMLINE,66,"Completed Time")
192 . W !!,IORVON,IVMLINE,IORVOFF
193 . S IVMLINE=IVMBLNK
194 . S IVMLINE=$$FMTLINE(IVMLINE,2,STAT)
195 . S IVMLINE=$$FMTLINE(IVMLINE,15,IVMTOT)
196 . S IVMLINE=$$FMTLINE(IVMLINE,28,IVMPUR)
197 . S IVMLINE=$$FMTLINE(IVMLINE,40,IVMBAD)
198 . S IVMLINE=$$FMTLINE(IVMLINE,52,IVMLST)
199 . S IVMLINE=$$FMTLINE(IVMLINE,64,$$FMTE^XLFDT(STIME,2))
200 . W !,IVMLINE
201 . S IVMLINE=IVMBLNK
202 . W !,IVMLINE,!!!!!!
203 . K DIR
204 . S DIR("T")=5
205 . W ?13,"screen refreshes automatically every "_DIR("T")_" seconds",!
206 . W !!,"Press "_IORVON_"<Enter>"_IORVOFF_" to Stop Monitor...",!
207 . S DIR(0)="EA"
208 . D ^DIR
209 . I '$D(DTOUT) S IVMQUIT=1
210 . I STAT'="RUNNING" S IVMQUIT=1
211 W @IOF
212 Q
213 ;
214FMTLINE(IVMLINE,IVMTB,IVMTX) ; format a line
215 S IVMLEN=$L(IVMTX)
216 S IVMEND=IVMTB+IVMLEN-1
217 S $E(IVMLINE,IVMTB,IVMEND)=IVMTX
218 Q IVMLINE
219 ;
220SCRNSET ; setup screen variables
221 S:'$D(IOST(0)) IOST(0)="C-VT320"
222 S X="IOINORM;IOINHI;IOUON;IOUOFF;IOBON;IOBOFF;IORVON;IORVOFF;IOHOME"
223 S X=X_";IOELEOL" D ENDR^%ZISS
224 Q
225 ;
226CLRSCR ; clear screen and return to normal
227 W IOHOME,IORVOFF,IOBOFF,IOUOFF,IOINORM,@IOF
228 S $X=0,$Y=0
229 Q
230 ;
231SETUPX(EXPDAY) ;Setup XTMP's according to standards and set expiration days
232 N BEGTIME,PURGDT,NAMSPC
233 S NAMSPC=$$NAMSPC^DG53558
234 S BEGTIME=$$NOW^XLFDT()
235 S PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAY)
236 S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
237 S $P(^XTMP(NAMSPC,0),U,3)="Cleanup Duplicate Means Test File"
238 S ^XTMP(NAMSPC_".DET",0)=PURGDT_U_BEGTIME
239 S $P(^XTMP(NAMSPC_".DET",0),U,3)="Cleanup Duplicate Means Test File detail"
240 Q
Note: See TracBrowser for help on using the repository browser.