84. EPMO Open Source Coordination Office Redaction File Detail Report

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.

84.1 Files compared

# 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

84.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 4 780
Changed 3 6
Inserted 0 0
Removed 0 0

84.3 Comparison options

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

84.4 Active regular expressions

No regular expressions were active.

84.5 Comparison detail

  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=$
  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=$
  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=
  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
  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