Produced by Araxis Merge on 11/9/2018 12:33:52 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMBCCL1.m | Mon Nov 5 16:41:58 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMBCCL1.m | Mon Nov 5 17:42:12 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 4 | 780 |
Changed | 3 | 6 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | CHMBCCL1 ;CVA/YJK;B eneficiary CCL LETTE R REPORT | |
2 | ;;1.00;HA C Reports; ;Dec 23,20 09;Build 1 | |
3 | ;; | |
4 | ;DEF01654 4 JSE 8/3/ 15 CONVERT DECNET TO FTP - ALL OW OLD VMS OPEN/CLOS E NOT TO E RROR | |
5 | ; | |
6 | ; Pri nt CCL let ters for t he input d ate range. | |
7 | ; En d date mus t be less than or eq ual to the current d ate. | |
8 | ; | |
9 | ; VARI ABLE LIST | |
10 | ; CHSN ,SN,LSN .. .......... . Sponsor Name | |
11 | ; CHBN ,BN,LBN... ......... Bene Name | |
12 | ; SREC 0 ........ .......... ......... A Sponsor Record | |
13 | ; BREC 0 ........ .... ..... ........A Bene Recor d | |
14 | ; CHSS SN,SS .... .......... .. Sponsor SSN | |
15 | ; CHBS SN,BS..... .......... ..Bene SSN | |
16 | ; CHBE G......... .......... .......Use r Input fo r the Star t Date - F ileMan for mat YYYMMD D | |
17 | ; CHEN D......... .......... ......User Input for the End D ate - File Man format YYYMMDD | |
18 | ; OUTT YP........ .......... .....User Input for Output Typ e - File o r Print | |
19 | ; SLTR EC........ .......... ......Spon sor Letter Record | |
20 | ; CHLS DT........ .......... ......Lett er Sent Da te | |
21 | ; CHLT YP........ .......... ......LETT ER TYPE PO INTER TO ^ AHADIC(554 801.1) | |
22 | ; LTRN M,LNM..... .......... CCL Letter Name - fr om AHADIC( 554801.1,C HLTYP,0) | |
23 | ; PRTC D ........ .......... .......Pri nt Code - from AHADI C(554801.1 ,CHLTYP,0) | |
24 | ; The P rint Code minus the trailing A lpha is us ed as Lett er Groups | |
25 | ; CHNU M......... .......... ......2nd Piece of t he Print c ode (after "-") | |
26 | ; PRTC DLN....... .......... .... Lengt h of CHNUM | |
27 | ; LTRG RP,LGRP,LG ....... Le tter Group (the Prin t code min us the tra iling Alph a) | |
28 | ; PREV GRP....... .......... ....Previo us Letter Group - wh en Previou s Letter g roup is di fferent fr om the cur rent group , subtotal is writte n for the prev group | |
29 | ; FIRS T ........ .......... .......... Flag for t he first l etter to b e printed | |
30 | ; GRPC NT........ .......... .....Numbe r of lette rs per Let ter Group | |
31 | ; CHBC T......... .......... .......Tot al number of CCL let ters | |
32 | ; PSPS SN ....... .......... ......Hold s previous Sponsor S SN so that Sponsor I nfo is not printed r epeated un til it cha nges | |
33 | ; PG.. .......... .......... .......... Number of Pages | |
34 | ; LINE NUM....... .......... ...Number of lines p rinted - I nitialized to 99. H eader prin ted for LI NENUM >70 | |
35 | ; TMP. .......... .......... .........U sed to hol d the user response before adv ancing the screen pr int. It a lso holds the Wide s creen sett ing until Viewing is done. | |
36 | ||
37 | MAIN; | |
38 | ;======== ========== ========== ========== ========== ========== >>>> | |
39 | K CHDBFY1 ,CHDBFY,CH BEG,CHDEFY 1,CHDEFY,C HEND,%DT,E LR1,ZTIO | |
40 | K ^CHMZHO LD($J,"CCL _BENE_LETT ERS") | |
41 | K DTFLG,T MP,LINENUM ,PG,PSPSSN | |
42 | W # | |
43 | S:'$D(DUZ ) DUZ=1,DU Z(0)="" | |
44 | ||
45 | S RT C=$$GETDAT ES() ; GET REPO RT START & END DATE | |
46 | G:RT C=0 END | |
47 | S GR PCNT=0 | |
48 | D GOUT ; GE T OUTPUT M ETHOD (FIL E OR PRINT ) | |
49 | ;W !,"OUTTYP = "_OUTTY P | |
50 | ||
51 | I OUTTYP="FI LE" D ZTLD F G END | |
52 | I OUTTYP="VI EW" D WTER M G END | |
53 | I OUTTYP="PR INT" D ZTL D G END | |
54 | ||
55 | END K DIR, DT,CHDBFY1 ,CHDBFY,CH BEG,CHEND, OUTTYP,^CH MZHOLD($J, "CCL_BENE_ LETTERS") | |
56 | Q | |
57 | ;<<<<==== ========== ========== ========== ========== ========== ===== | |
58 | ||
59 | GETDATES() ; Get Sta rt and End dates | |
60 | N DTFLG | |
61 | S DTFLG=0 ; 0=Exit /1=Continu e | |
62 | GSTART; Get Report Start Dat e ==> CHBE G | |
63 | D NOW^%DT C S DT=X ; Sets d efault sta rt date to Beg fisca l year; Fu ture date is not acc epted | |
64 | S CHDBFY1 =$$FYR^CHT FLIB(DT) S CHDBFY="1 0/01/"_$E( CHDBFY1,2, 3) | |
65 | S DIR(0)= "DO" | |
66 | S DIR("A" )="Enter a START dat e: " | |
67 | S DIR("B" )=$$FMTE^X LFDT(CHDBF Y,"5D") | |
68 | D ^DIR | |
69 | I $D(DTOU T)!($D(DIR UT))!($D(D IROUT)) Q DTFLG | |
70 | I Y=-1 | |
71 | {U 0 W !! ,"NOT A VA LID DATE" | |
72 | G GSTART | |
73 | } | |
74 | S CHBEG=Y | |
75 | K DIR | |
76 | GEND; Get Report End Date ==> CHEND | |
77 | ; Sets de fault Stop date to N OW | |
78 | D NOW^%DT C S DT=X | |
79 | S DIR(0)="DO " | |
80 | S DIR("A" )="Enter a n END date : " | |
81 | S DIR("B" )=$$FMTE^X LFDT(DT,"5 D") | |
82 | D ^DIR | |
83 | G: $D(DIROUT) GSTART | |
84 | I Y=-1 | |
85 | {W !!,"NO T A VALID DATE" | |
86 | G GEND | |
87 | } | |
88 | S CHEND=Y | |
89 | I $$FMDIF F^XLFDT(CH END,CHBEG, 1)<0 | |
90 | {W !,"End Date can not be bef ore the St art Date." | |
91 | G GEND | |
92 | } | |
93 | K DIR | |
94 | S DTFLG=1 | |
95 | Q DTFLG | |
96 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
97 | GOUT; | |
98 | S DIR(0)="SB ^F:FILE;V: VIEW;P:PRI NT" | |
99 | S DIR("A")=" Enter Outp ut Method" | |
100 | S DIR("A",1) ="<F>ILE t o print to a file (X CEL format )" | |
101 | S DIR("A",2) ="<V>IEW t o View on screen" | |
102 | S DIR("A",3) ="<P>RINT to print a report" | |
103 | S DIR("B")=" P" | |
104 | W ! | |
105 | D ^DIR | |
106 | S OUTTYP=Y(0 ) | |
107 | K DIR | |
108 | Q | |
109 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
110 | ZTLD ; | |
111 | S ION="" | |
112 | SD | |
113 | W !!!,"Pl ease Queue this repo rt to a Wi de Printer ." | |
114 | S %ZIS="Q" | |
115 | D ^%ZIS | |
116 | Q: POP | |
117 | ||
118 | I ION'["/W" W !!,"YOU MUST USE A WIDE PRIN TER." G SD ;CHV DEV$PRT/W | |
119 | S ZTRTN="FND LTR^CHMBCC L1",ZTDESC ="BENEFICI ARY CCL LE TTERS" | |
120 | S ZTDTH=$ H | |
121 | S ZTIO=IO N,ZTSAVE(" CHFIO")="" ,ZTSAVE("C HBEG")="", ZTSAVE("CH END")="" | |
122 | S ZTSAVE( "OUTTYP")= "" | |
123 | D ^%ZTLOA D | |
124 | ;D FNDLTR ^CHMBCCL1 | |
125 | D HOME^%Z IS K IO("Q ") | |
126 | Q | |
127 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
128 | ZTLDF ; | |
129 | S ION="" | |
130 | S $ZE="", $ZT="ZTLDF O^CHMBCCL1 " | |
131 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1) | |
132 | IF CHUCI= "HAC" | |
133 | { | |
134 | ;DEF01655 4 JSE 8/3/ 15 - Conve rting from DECNET to FTP. | |
135 | ;{S ELR1= "HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.BENE_CCL ]"_"DUZ"_D UZ_"_"_CHB EG_"_"_CHE ND_".txt" | |
136 | S FILE="D UZ"_DUZ_"_ "_CHBEG_"_ "_CHEND_". txt" | |
137 | S FOLDER= "HAC_HFS$: [SCR.TEMP_ FILES]",TD IR="/FS3BI G/COMMO_RP TS/BENE_CC L" | |
138 | S ELR1=FO LDER_FILE | |
139 | ;W !,"DAT A WILL BE WRITTEN TO ",ELR1 | |
140 | W !!,"DAT A WILL BE WRITTEN TO THE FILE: ",FILE | |
141 | W !," IN THE VMS D IRECTORY: ",FOLDER | |
142 | W !," AND TH EN SENT VI A FTP TO: FS3BIG/C OMMO_RPTS/ BENE_CCL" | |
143 | } | |
144 | ELSE | |
145 | { | |
146 | ;S ELR1=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .COMMO_RPT S.BENE_CCL _TEST]"_"D UZ"_DUZ_"_ "_CHBEG_"_ "_CHEND_". txt" | |
147 | ;W !,"DAT A WILL BE WRITTEN TO ",ELR1 | |
148 | ; | |
149 | ;DEF01655 4 JSE 8/3/ 15 - Conve rting from DECNET to FTP. | |
150 | S FILE="D UZ"_DUZ_"_ "_CHBEG_"_ "_CHEND_". txt" | |
151 | S FOLDER= "HAC_HFS$: [DSMMANAG. CHAMPVA]", TDIR="/FS3 BIG/COMMO_ RPTS/BENE_ CCL_TEST" | |
152 | S ELR1=FO LDER_FILE | |
153 | W !!,"DAT A WILL BE WRITTEN TO THE FILE: ",FILE | |
154 | W !," IN THE VMS D IRECTORY: ",FOLDER | |
155 | W !," AND TH EN SENT VI A FTP TO: FS3BIG/CO MMO_RPTS/B ENE_CCL_TE ST" | |
156 | } | |
157 | S CHFIO=" " | |
158 | S ZTRTN=" FNDLTR^CHM BCCL1",ZTD ESC="BENEF ICIARY CCL LETTERS" | |
159 | S ZTDTH=$ H | |
160 | S ZTIO="" ,ZTSAVE("E LR1")="",Z TSAVE("CHB EG")="",ZT SAVE("CHEN D")="",ZTS AVE("CHFIO ")="" | |
161 | S ZTSAVE( "OUTTYP")= "" | |
162 | S ZTSAVE( "TDIR")="" ;DEF01655 4 JSE 8/3/ 15 | |
163 | D ^%ZTLOA D | |
164 | I $D(ZTSK ) U 0 W !! ," JOB SUCCE SSFULLY QU EUED: JOB - ",ZTSK | |
165 | ;D FNDLTR ^CHMBCCL1 | |
166 | D HOME^%Z IS | |
167 | Q | |
168 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
169 | WTERM; | |
170 | S TMP="" | |
171 | D HOME^%Z IS | |
172 | S:'$D(SCR W) SCRW="" S:'$D(SCR N) SCRN="" | |
173 | I SCRW="" S SCRW="" S:$D(^%ZI S(2,IOST(0 ),554001)) SCRW=$P(^ (554001),U ,2) | |
174 | I SCRN="" S SCRN="" S:$D(^%ZI S(2,IOST(0 ),554001)) SCRN=$P(^ (554001),U ,1) | |
175 | S:SC RW="" SCRW =$P(^%ZIS( 2,125,5540 01),U,2) | |
176 | S:SCRN="" SCRN=$P(^ %ZIS(2,125 ,554001),U ,1) | |
177 | S X=132 X ^%ZOSF("R M") W @SCR W ;; set t he screen to wide | |
178 | W #,?1,"P reparing r eport..... ..." | |
179 | D FNDLTR^ CHMBCCL1 | |
180 | W !!, "En d of View. .. Hit Ret urn." R TM P | |
181 | S X=80 X ^%ZOSF("RM ") W @SCRN ;; set t he screen to normal | |
182 | Q | |
183 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
184 | FNDLTR ; F ind Bene w ith letter | |
185 | S DFN=0 | |
186 | K ^CHMZHO LD($J,"CCL _BENE_LETT ERS") | |
187 | S DFN=0 | |
188 | S DFN=$O( ^AHCHVA(DF N)) ; Init ial pull | |
189 | WHILE DFN | |
190 | { | |
191 | ;U 0 W !,"DFN = " _DFN | |
192 | IF $D(^ AHCHVA(DFN ,0)) | |
193 | { | |
194 | S SREC0=^A HCHVA(DFN, 0) | |
195 | S (CHSN,SN )=$P(SREC0 ,"^",1) ; Spo nsor Name | |
196 | IF SN'="" | |
197 | {S B FN="",BN=" " S T1=$$D ELCHK^CHTF LIB(SN,DFN ,BN,BFN) ;DELCHK return: 0= not delete d; 1=Spons or deleted ; 2=Bene d eleted | |
198 | IF T1=0 | |
199 | { | |
200 | S CHS SSN=$P(^AH CHVA(DFN,0 ),"^",9) ; Sponsor S SN | |
201 | S BFN =0 | |
202 | S BFN =$O(^AHCHV A(DFN,100, BFN)) | |
203 | WHILE BFN'="",B FN & $D(^A HCHVA(DFN, 100,BFN,0) ) ; START Bene Loop | |
204 | { | |
205 | S BREC 0=^AHCHVA( DFN,100,BF N,0) | |
206 | S (CHB N,BN)=$P(B REC0,"^",1 ) ; Bene Na me | |
207 | I BN'= "" S SN="" S T2=$$DE LCHK^CHTFL IB(SN,DFN, BN,BFN) | |
208 | IF T2= 0 ; Bene No t deleted | |
209 | {S CHBSSN= $P(BREC0," ^",9) ; Bene SSN | |
210 | I CHBSSN ="" S CHBS SN="000000 000" | |
211 | S TMPI=0 | |
212 | S TMPI=$ O(^AHCHVA( DFN,100,BF N,500,TMPI )) | |
213 | WHILE TM PI,$D(^AHC HVA(DFN,10 0,BFN,500, TMPI,0)) ; Loop th ru Bene le tters | |
214 | {S BLTRE C=^AHCHVA( DFN,100,BF N,500,TMPI ,0) | |
215 | S CHLS DT=$P(BLTR EC,"^",1) | |
216 | S CHLT YP=$P(BLTR EC,"^",2) | |
217 | IF (CH LSDT'="" & CHLTYP'=" ") | |
218 | {S CHLSDT= $P(CHLSDT, ".",1) | |
219 | I CHLSDT '<CHBEG&(C HLSDT'>CHE ND) D LTRN M} | |
220 | S TMPI =$O(^AHCHV A(DFN,100, BFN,500,TM PI)) | |
221 | } ; END - WHILE TM PI | |
222 | } ; END - IF T2=0 | |
223 | S BFN= $O(^AHCHVA (DFN,100,B FN)) | |
224 | } ; EN D - Bene W HILE loop | |
225 | } ; END - IF T 1=0 | |
226 | } ; END - Spon sor Name C heck | |
227 | } ; END - IF $D( ^AHCHVA(DF N,0)) | |
228 | S DFN=$O(^AH CHVA(DFN)) | |
229 | } ; END - WHILE | |
230 | ||
231 | D QUE^CHM BCCL1 | |
232 | D ^%ZISC | |
233 | Q | |
234 | ;-------- ----- | |
235 | LTRNM ; Ge t Letter N ame and Pr int Code | |
236 | ;U 0 W !, "LTRNM: " _CHSSSN_" "_CHBSSN_" "_DFN_" " _BFN_" "_C HLSDT | |
237 | S (LTRNM, PRTCD)="" | |
238 | S LTRNM=$ P(^AHADIC( 554801.1,C HLTYP,0)," ^",1) | |
239 | S PRTCD=$ P(^AHADIC( 554801.1,C HLTYP,0)," ^",6) | |
240 | Q:LTRNM=" "!(PRTCD=" ") | |
241 | S CHNUM=$ P(PRTCD,"- ",2) | |
242 | ; To remo ve texts f ollowing t he Print G roup (ex, "CCL-A53 O HI REQUEST " => "CCL- A53") | |
243 | I $F(CHNU M," ") >0 S CHNUM=$E (CHNUM,1,$ F(CHNUM," ")-2) | |
244 | S PRTCDLN =$L(CHNUM) | |
245 | I PRTCDLN >3 S CHNUM =$E(CHNUM, 1,(PRTCDLN -1)) ; CCL-B36A to CCL-B3 6 | |
246 | I PRTCDLN <4 S CHNUM =$E(CHNUM, 1,PRTCDLN) | |
247 | S LTRGRP= $P(PRTCD," -",1)_"-"_ CHNUM ;Let ter Group = Print Co de (6th Pi ece withou t the trai ling Alpha . Ex, CCL -B36) | |
248 | S ^CHMZHO LD($J,"CCL _BENE_LETT ERS",LTRGR P,CHSSSN,C HBSSN)=LTR GRP_"^"_LT RNM_"^"_CH SN_"^"_CHS SSN_"^"_CH BN_"^"_CHB SSN | |
249 | Q | |
250 | QUE ; | |
251 | S PG =0 | |
252 | S CH BCT=0 ; Total Coun t of Benef iciary Let ters | |
253 | D PRINT^C HMBCCL1 | |
254 | K %DT,CHD BFY1,CHDBF Y,CHBEG,CH END,PG | |
255 | K CHUCI,E LR1CHFIO,Z TRTN,ZTDES C,ZTIO,ZTS AVE,CHLTYP ,^CHMZHOLD ($J,"CCL_B ENE_LETTER S") | |
256 | K DFN,SRE C0,CHSN,SN ,BN,T,BFN, CHSSN,BREC 0,CHBN,CHB SSN,TMPI,B LTREC,TMP | |
257 | K CHLSDT, LTRNM,PRTC D,CHNUM,PR TCDLN,LTRG RP | |
258 | K PREVGRP ,LGRP,FIRS T,GRPCNT,S S,BS,LG | |
259 | K LG,LNM, LSN,LSS,LB N,LBS,GRPC NT,CHBCT,P SPSSN,OUTT YP | |
260 | Q | |
261 | PRINT; | |
262 | S GR PCNT=0 | |
263 | IF OUTTYP ="FILE" | |
264 | { | |
265 | ;O ELR1: "NWS":5 | |
266 | ;I '$T U 0 W !,"Er ror Opeing Output fi le!!!" Q | |
267 | ;D PRT | |
268 | ;U ELR1 W !!,"Tota l number o f Benefici ary letter s: ",CHBCT | |
269 | ;C ELR1 | |
270 | ;} | |
271 | ;DEF0165 54 JSE 8/3 /15 - Conv erting fro m DECNET t o FTP. | |
272 | X "D $SY STEM.Proce ss.SetZEOF (1)" | |
273 | N POP | |
274 | S POP=0 | |
275 | S POP=$$ OPENFIWR^C HTFLIB9(.E LR1,"FSIO" ) Q:'POP | |
276 | D PRT | |
277 | U ELR1 W !!,"Total number of Beneficia ry letters : ",CHBCT | |
278 | D CLOSEF ^CHTFLIB9( ELR1,"FSIO ") | |
279 | X "D $SY STEM.Proce ss.SetZEOF (0)" | |
280 | D FTPFILE^ CHTFLIB9(E LR1," DNS fs3. DNS ",TDIR,"PU T") | |
281 | } | |
282 | I OUTTYP= "PRINT"!(O UTTYP="VIE W") | |
283 | {D PRT | |
284 | I GRPCN T>0 D SUBT OT | |
285 | W !!,"T otal numbe r of Benef iciary let ters: ",CH BCT | |
286 | } | |
287 | Q | |
288 | PRT | |
289 | S GR PCNT=0 | |
290 | S T=$C(9) | |
291 | S (LTRGRP ,LTRNM,CHS N,CHSSSN,C HBN,CHBSSN )="" | |
292 | D HEAD | |
293 | IF '$D(^C HMZHOLD($J ,"CCL_BENE _LETTERS") ) | |
294 | { | |
295 | IF OUT TYP="FILE" | |
296 | {U ELR1 W !, "No Benefi ciary lett ers were f ound"} | |
297 | ELSE | |
298 | {W !,"No Ben eficiary l etters wer e found"} | |
299 | Q | |
300 | } | |
301 | BPRT ; | |
302 | S (PREVGR P,LGRP,PSP SSN)="" | |
303 | S FIRST=1 | |
304 | S GRPCNT= 0 ; Letter Cou nt for a L etter Grou p | |
305 | S LGRP=$O (^CHMZHOLD ($J,"CCL_B ENE_LETTER S",LGRP)) ; Initi al Pull | |
306 | WHILE LGR P '= "" | |
307 | {I FIRST S P REVGRP=LGR P S FIRST= 0 | |
308 | S SS="" | |
309 | S SS=$O(^CHM ZHOLD($J," CCL_BENE_L ETTERS",LG RP,SS)) | |
310 | WH ILE SS'="" | |
311 | {S B S="" | |
312 | S BS=$O(^CHM ZHOLD($J," CCL_BENE_L ETTERS",LG RP,SS,BS)) | |
313 | WH ILE BS'="" | |
314 | { | |
315 | S LG=$P( ^CHMZHOLD( $J,"CCL_BE NE_LETTERS ",LGRP,SS, BS),"^",1) ;Letter Group | |
316 | S LNM=$P (^CHMZHOLD ($J,"CCL_B ENE_LETTER S",LGRP,SS ,BS),"^",2 ) ;Lette r Name | |
317 | S LSN=$P (^CHMZHOLD ($J,"CCL_B ENE_LETTER S",LGRP,SS ,BS),"^",3 ) ;Spons or Name | |
318 | S LSS=$P (^CHMZHOLD ($J,"CCL_B ENE_LETTER S",LGRP,SS ,BS),"^",4 ) ;Spons or SSN | |
319 | S LBN=$P (^CHMZHOLD ($J,"CCL_B ENE_LETTER S",LGRP,SS ,BS),"^",5 ) ;Bene Name | |
320 | S LBS=$P (^CHMZHOLD ($J,"CCL_B ENE_LETTER S",LGRP,SS ,BS),"^",6 ) ;Bene SSN | |
321 | S CHBCT= CHBCT+1 ; Tota l letter c ount for t he specifi ed dates | |
322 | I OUTTYP ="FILE" U ELR1 W !,L SN_T_LSS_T _LBN_T_LBS _T_LNM | |
323 | I OUTTYP ="PRINT"!( OUTTYP="VI EW") D PRP T | |
324 | S BS=$O( ^CHMZHOLD( $J,"CCL_BE NE_LETTERS ",LGRP,SS, BS)) | |
325 | } ;E ND - WHILE BS NOT= " " | |
326 | S SS =$O(^CHMZH OLD($J,"CC L_BENE_LET TERS",LGRP ,SS)) | |
327 | } ; END -WHIL E SS NOT=" " | |
328 | S LGRP=$ O(^CHMZHOL D($J,"CCL_ BENE_LETTE RS",LGRP)) | |
329 | } ; END -WH ILE LGRP N OT="" | |
330 | ||
331 | Q | |
332 | HEAD | |
333 | S PG=PG+1 | |
334 | D NOW^%DT C S DT=X | |
335 | S TIME=$$ HTIM^ACKQU TL($H,0) | |
336 | IF OUTTYP ="FILE" | |
337 | { | |
338 | U ELR1 W !, DUZ_T_"HEA LTH ADMINI STRATION C ENTER" | |
339 | U ELR1 W !, TIME_T_"BE NEFICIARY CCL LETTER S"_T_$$FMT E^XLFDT(DT ,"5D") | |
340 | U ELR1 W !! ,"Letter D ates From "_$$FMTE^X LFDT(CHBEG ,"5D")_" t o "_$$FMTE ^XLFDT(CHE ND,"5D") | |
341 | U ELR1 W !! ,"SPONSOR NAME"_T_"S PONSOR SSN "_T_"BENEF ICIARY NAM E"_T_"BENE FICIARY SS N"_T_"CCL LETTER" | |
342 | } | |
343 | EL SE | |
344 | { | |
345 | W # | |
346 | W !,?1,DUZ, ?40,"HEALT H ADMINIST RATION CEN TER",?95," Page: ",P G | |
347 | W !,?1,TIME ,?40,"BENE FICIARY CC L LETTERS" ,!,?95,$$F MTE^XLFDT( DT,"5D") | |
348 | W !!!,?1,"L etter Date s From "_$ $FMTE^XLFD T(CHBEG,"5 D")_" to " _$$FMTE^XL FDT(CHEND, "5D") | |
349 | W !,?1,"SPO NSOR NAME" ,?32,"SPON SOR SSN",? 45,"BENEFI CIARY NAME ",?75,"BEN EFICIARY S SN",?92,"C CL LETTER" | |
350 | W !,?1,$$RE PEAT^XLFST R("=",120) ,! | |
351 | S LINENUM=9 | |
352 | } | |
353 | Q | |
354 | SUBTOT | |
355 | I OUTTYP= "VIEW"&($Y +5>22) | |
356 | { | |
357 | I TMP'="^" D HEAD | |
358 | } | |
359 | W !,?1,$$ REPEAT^XLF STR("-",12 0) | |
360 | W !,?1,PR EVGRP_": " _GRPCNT,!! ! | |
361 | S GRPCNT= 0 | |
362 | S PREVGRP =LGRP | |
363 | S LINENUM =LINENUM+5 | |
364 | ||
365 | Q | |
366 | PRPT ; | |
367 | I OUTTYP= "VIEW",TMP ="^" Q | |
368 | ||
369 | S FLSS=$E (LSS,1,3)_ "-"_$E(LSS ,4,5)_"-"_ $E(LSS,6,9 ) | |
370 | S FLBS=$E (LBS,1,3)_ "-"_$E(LBS ,4,5)_"-"_ $E(LBS,6,9 ) | |
371 | ||
372 | I PREVGRP '=LGRP D S UBTOT | |
373 | IF OUTTYP ="PRINT" | |
374 | {D:LINENU M>55 HEAD} | |
375 | ||
376 | S GRPCNT= GRPCNT+1 ; Coun t letters for a Lett er Group | |
377 | IF LSS = PSPSSN | |
378 | {W !,?45,LBN ,?76,FLBS, ?92,LNM | |
379 | S LINENUM=L INENUM+1} | |
380 | ELSE | |
381 | {W !,?1,LSN, ?32,FLSS | |
382 | W !,?45,LB N,?76,FLBS ,?92,LNM | |
383 | S PSPSSN=L SS | |
384 | S LINENUM= LINENUM+2 | |
385 | } | |
386 | I OUTTYP= "VIEW"&($Y >19) | |
387 | { | |
388 | W !,?1,"Hit <Return> K ey to Cont inue or '^ ' to Stop. " R TMP | |
389 | I TMP'="^" D HEAD | |
390 | } | |
391 | Q | |
392 | ||
393 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.