94. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/9/2018 12:33:54 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.

94.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMEAI01.m Mon Nov 5 16:43:07 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMEAI01.m Mon Nov 5 17:43:43 2018 UTC

94.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 744
Changed 1 4
Inserted 0 0
Removed 0 0

94.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

94.4 Active regular expressions

No regular expressions were active.

94.5 Comparison detail

  1   CHMEAI01 ; DGC/DEN;CH AMPVA ELIG IBILITY VI EW/IRS DAT A EXTRACT; 10/19/15   7:25 AM
  2           ;T his routin e is to be  run daily
  3           ;  DEF028772  RFE 07/25/ 17 Cut lin es to be u nder 255 p ositions l ong
  4           ;R 18320413FY 18 ACA Fil e Update.  File Forma t needs to  be update d with an  additional  "^" in th e third fi eld.
  5           ;T his is to  accomdate  the print  vendor whe n they par se the fil e.  DRW 01 /19/2018
  6   INIT    ;
  7           ;
  8           K  ^TEMP("IRS ")
  9           D  TAXYEAR       ;SELECT ION OF TAX  YEAR
  10           D  SELECT ;ME C DATA EXT RACT
  11           D  BENEOUTFIL E ;BUILDS  BENE ALIVE  & DECEASE D OUTPUT F ILES
  12           G  END
  13           ;
  14   INITRP(DFN ,BFN,TY,RP TEMP) ;Ent ry for Rep rints
  15           ;I NPUT DFN,B FN,TY(TAX  YEAR) -- O UTPUT RPTE MP
  16           K  ^TEMP("IRS ")
  17           N  I,J,CPYR
  18           S  I=DFN,J=BF N,CPYR=TY
  19           D  SELECTRP
  20           G  END
  21           ;
  22   TAXYEAR ;  SELECTION  OF TAX YEA R
  23           ;
  24           S  CPYR=""
  25           W  !,"Enter T AX year (Y YYY format ): " R Y:$ S($D(DTIME ):DTIME,1: 60)
  26           ;I  (Y="^")!( Y="^^") G  END
  27           I  Y?4N S CPY R=Y
  28              E  W !,"IN CORRECT YE AR FORMAT"  G TAXYEAR
  29           I  $E(CPYR,1, 2)'=20 W ! ,"INCORREC T" G TAXYE AR
  30           W  !!,"EXTRAC T PROCESSI NG TAX YEA R","_'",CP YR,"'",!
  31           Q
  32   SELECT  ;   Selection  of eligib le BENE'S
  33           ;
  34           S  U="^",CNT= 0,YRFL=0,( H01,H02,H0 3,H04,H05, H06,H07,H0 8,H09,H10, H11,H12,H1 3)="",(BDC NT1)=0
  35           S  DTE=$ZDATE ($H,1),RDA TE=($P(DTE ,"/",1))_( $P(DTE,"/" ,2))_($P(D TE,"/",3)) ,DTYR=$P(D TE,"/",3)   ;,CPYR=20 15
  36           D  NOW^%DTC S  CHEDT=%
  37           S  SECTI=$P(C HEDT,".",2 ),TIST=($P (DTE,"/",3 ))_($P(DTE ,"/",1))_( $P(DTE,"/" ,2))_SECTI
  38           ;  SPONSOR CH ECK
  39           S  I=0  F  S  I=$O(^AHCH VA(I)) Q:( I="")!(I[" A")  D        ;EXTRAC TION OF BE NE INFFORM ATION
  40           .S  SBYN=0
  41           .I  $D(^AHCHV A(I,15)) S  SBYN=$P(^ AHCHVA(I,1 5),U,1)
  42           .Q :'$D(^AHCH VA(I,0))
  43           .Q :'$D(^AHCH VA(I,100))
  44           .  ;CHECK IF  DELETED SP ONSOR
  45           .  S (SPNAM1, SPNAM2,D12 ,D2)="",SP NAM1=$P(^A HCHVA(I,0) ,U,01),SPN AM2=SPNAM1 _"  (SN)"
  46           .  Q:SPNAM1=" "
  47           .  S NDEL=0
  48           .  I ($D(^AHA DIC(554804 .07,"B",SP NAM1))) D
  49           ..  S D2=$O(^ AHADIC(554 804.07,"B" ,SPNAM1,D2 ))
  50           ..  Q:D2=""
  51           ..  S DSB2=0, DSB2=$P(^A HADIC(5548 04.07,D2,0 ),U,2)
  52           ..  Q:DSB2="B E"
  53           ..  S DI2=$P( ^AHADIC(55 4804.07,D2 ,0),U,3)
  54           ..  I (DI2=I)  S NDEL=1  Q
  55           .  Q:NDEL=1
  56           .  I ($D(^AHA DIC(554804 .07,"B",SP NAM2))) D
  57           ..  S D2=$O(^ AHADIC(554 804.07,"B" ,SPNAM2,D2 ))
  58           ..  Q:D2=""
  59           ..  S DSB2=0, DSB2=$P(^A HADIC(5548 04.07,D2,0 ),U,2)
  60           ..  Q:DSB2="B E"
  61           ..  S DI2=$P( ^AHADIC(55 4804.07,D2 ,0),U,3)
  62           ..  I (DI2=I)  S NDEL=1  Q
  63           .  Q:NDEL=1
  64           .  ;BENE CHEC KS        
  65           .S  J=0 F  S  J=$O(^AHCH VA(I,100,J )) Q:(J="B ")!(J="")   D
  66           ..  Q:'$D(^AH CHVA(I,100 ,J,0))
  67           ..  ; CHECK I F DELETED  BENE
  68           ..  S (BNAM1, BNAM2,D12, D2)="",BNA M1=$P(^AHC HVA(I,100, J,0),U,01) ,BNAM2=BNA M1_"  (SN) "
  69           ..  Q:BNAM1=" "
  70           ..  S NDEL=0
  71           ..  I ($D(^AH ADIC(55480 4.07,"B",B NAM1))) D
  72           .. . S D2=0,D 2=$O(^AHAD IC(554804. 07,"B",BNA M1,D2))
  73           .. . Q:D2=""
  74           .. . S DSB2=0 ,DSB2=$P(^ AHADIC(554 804.07,D2, 0),U,2)
  75           .. . Q:DSB2=" SP"
  76           .. . S DI2=$P (^AHADIC(5 54804.07,D 2,0),U,3), DJ2=$P(^AH ADIC(55480 4.07,D2,0) ,U,4)
  77           .. . I (DI2=I )&(DJ2=J)  S NDEL=1 Q
  78           ..  Q:NDEL=1
  79           ..  I ($D(^AH ADIC(55480 4.07,"B",B NAM2))) D
  80           .. . S D2=0,D 2=$O(^AHAD IC(554804. 07,"B",BNA M2,D2))
  81           .. . Q:D2=""
  82           .. . S DSB2=0 ,DSB2=$P(^ AHADIC(554 804.07,D2, 0),U,2)
  83           .. . Q:DSB2=" SP"
  84           .. . S DI2=$P (^AHADIC(5 54804.07,D 2,0),U,3), DJ2=$P(^AH ADIC(55480 4.07,D2,0) ,U,4)
  85           .. . I (DI2=I )&(DJ2=J)  S NDEL=1 Q
  86           ..  Q:NDEL=1
  87           ..  S (H01,H0 2,H03,H04, H05,H06,H0 7,H08,H09, H10,H11,H1 2,H13,STYR ,STMTH,QED TE)="",DLF LAG="A",(A DEATH,CHMF LAG,BEGTOO )=0
  88           ..  I (SBYN=1 ) & $D(^AH CHVA("SB", I,J)) D SB SELECT Q
  89           ..  S BENEL=" Y",DLFLAG= "A"
  90           ..  Q:'$D(^AH CHVA(I,100 ,J,109))
  91           ..  Q:'$D(^AH CHVA(I,100 ,J,105))
  92           ..  ;DECEASED  CHECK
  93           ..  S AD=$P(^ AHCHVA(I,1 00,J,0),"^ ",6)
  94           ..  I AD'=""  S DLFLAG=" D"
  95           ..  ; Eligibi lity perio d CHECKS
  96           ..  S E1=0 F   S E1=$O(^ AHCHVA(I,1 00,J,109,E 1)) Q:E1=" "  D
  97           .. . ;CHECK B EGIN DATE  ELIGIBILIT Y
  98           .. . S CKMFLA G=0
  99           .. . I $E(E1, 1,1)=2 S E 1YR=19
  100           .. . I $E(E1, 1,1)=3 S E 1YR=20
  101           .. . I $E(E1, 1,1)=4 S E 1YR=21
  102           .. . S E1YR=E 1YR_$E(E1, 2,3),E1MTH =$E(E1,4,5
  103           .. . ; CHECK  END DATE E LIGIBILITY  
  104           .. . S E2=0,E 2=$O(^AHCH VA(I,100,J ,109,E1,E2 ))
  105           .. . I $E(E2, 1,1)=2 S E 2YR=19
  106           .. . I $E(E2, 1,1)=3 S E 2YR=20
  107           .. . I $E(E2, 1,1)=4 S E 2YR=21       
  108           .. . S E2YR=E 2YR_$E(E2, 2,3),E2MTH =$E(E2,4,5 )
  109           .. . ; CALCUL ATE TAX YE AR ELIGIBI LITY
  110           .. . I (E2YR< CPYR) S CK MFLAG=1 Q
  111           .. . I (E2YR> CPYR) & (E 1YR>CPYR)  Q
  112           .. . I (E2YR= CPYR) & (E 1YR=CPYR)  D QEMONTH
  113           .. . I (E2YR= CPYR) & (E 1YR<CPYR)  S STMTH=E2 MTH,BGTOO= 1 D CKMONT H
  114           .. . I (E2YR> CPYR) & (E 1YR=CPYR)  S STMTH=E1 MTH,BGTOO= 0 D CKMONT H
  115           .. . I (E2YR> CPYR) & (E 1YR<CPYR)  S H01="Y" 
  116           .. . ;BAD ADD RESS CHECK
  117           .. . S FMAIL= $P(^AHCHVA (I,100,J,1 ),U,10)
  118           .. . I FMAIL= "0"  Q
  119           .. . I FMAIL= "2"  Q
  120           .. . Q:CKMFLA G=1
  121           .. . D EXTRAC T
  122           .. . Q
  123           .Q
  124           Q
  125   SBSELECT ;  SPINA BIF IDA BENE C HECK
  126           S  CKSBYR=0
  127           S  SB1STAT=$P (^AHCHVA(I ,100,J,0), U,5)
  128           S  SBD=$P(^AH CHVA(I,100 ,J,0),U,6)         
  129           S  SBS=$P(^AH CHVA(I,100 ,J,10),U,3 )
  130           I  SBD'="" S  DLFLAG="D"
  131           ;D isenrollme nt
  132           I  $D(^AHCHVA (I,100,J,1 1)) D
  133           .  S SBENR=$P (^AHCHVA(I ,100,J,11) ,U,1)
  134           .  I SBENR=""  Q
  135           .  S SBENRD=$ P(^AHCHVA( I,100,J,11 ),U,2)
  136           .  I $E(SBENR D,1,1)=2 S  SBENRDYR= 19
  137           .  I $E(SBENR D,1,1)=3 S  SBENRDYR= 20
  138           .  I $E(SBENR D,1,1)=4 S  SBENRDYR= 21
  139           .  S SBENRDYR =SBENRDYR_ $E(SBENRD, 2,3),SBENR DMTH=$E(SB D,4,5) 
  140           .  I (SBENR=" DIS") & (S BENRDYR<CP YR) Q
  141           .  I (SBENR=" DIS") & (S BENRDYR>CP YR) Q
  142           .  I (SBENR=" DIS") & (S BENRDYR=CP YR) S STMT H=SBENRDMT H,BGTOO=1, CKSBYR=1 D  CKMONTH
  143           .  Q
  144           ;  NOT DECEAS ED
  145           I  (SBS'="")  & (SBD="")  D
  146           .  I CKSBYR=1  Q
  147           .  I $E(SBS,1 ,1)=2 S SB SYR=19
  148           .  I $E(SBS,1 ,1)=3 S SB SYR=20
  149           .  I $E(SBS,1 ,1)=4 S SB SYR=21
  150           .  S SBSYR=SB SYR_$E(SBS ,2,3),SBSM TH=$E(SBS, 4,5) 
  151           .  I SBSYR<CP YR S H01=" Y",CKSBYR=
  152           .  I SBSYR=CP YR S STMTH =SBDMTH,BG TOO=0,CKSB YR=1 D CKM ONTH 
  153           .  Q
  154           ;  DECEASED
  155           I  (SBS'="")  & (SBD'="" ) D
  156           .  S DLFLAG=" D"
  157           .  I CKSBYR=1  Q
  158           .  I $E(SBD,1 ,1)=2 S SB DYR=19
  159           .  I $E(SBD,1 ,1)=3 S SB DYR=20
  160           .  I $E(SBD,1 ,1)=4 S SB DYR=21
  161           .  S SBDYR=SB DYR_$E(SBD ,2,3),SBDM TH=$E(SBD, 4,5) 
  162           .  I $E(SBS,1 ,1)=2 S SB SYR=19
  163           .  I $E(SBS,1 ,1)=3 S SB SYR=20
  164           .  I $E(SBS,1 ,1)=4 S SB SYR=21
  165           .  S SBSYR=SB SYR_$E(SBS ,2,3),SBSM TH=$E(SBS, 4,5) 
  166           .  I SBDYR<CP YR  Q 
  167           .  I (SBDYR=C PYR) & (SB SYR=CPYR)  S E1MTH=SB SMTH,E2MTH =SBDMTH,CK SBYR=1 D Q EMONTH 
  168           .  I (SBDYR=C PYR) & (SB SYR<CPYR)  S STMTH=SB DMTH,BGTOO =1,CKSBYR= 1 D CKMONT
  169           .  I (SBDYR>C PYR) & (SB SYR<CPYR)  S H01="",C KSBYR=1 
  170           .  Q
  171           ;S B BAD ADDR ESS CHECK
  172           S  FMAIL=$P(^ AHCHVA(I,1 00,J,1),U, 10)
  173           I  FMAIL="0"  Q
  174           I  FMAIL="2"  Q
  175           ;
  176           Q: CKSBYR=0  
  177           D  EXTRACT
  178           Q    
  179   SELECTRP   ;  Selecti on for Rep rints of E ligible BE NE'S
  180           ;
  181           S  U="^",CNT= 0,YRFL=0,( H01,H02,H0 3,H04,H05, H06,H07,H0 8,H09,H10, H11,H12,H1 3)="",(BDC NT1)=0
  182           S  DTE=$ZDATE ($H,1),RDA TE=($P(DTE ,"/",1))_( $P(DTE,"/" ,2))_($P(D TE,"/",3)) ,DTYR=$P(D TE,"/",3)   ;,CPYR=20 15
  183           D  NOW^%DTC S  CHEDT=%
  184           S  SECTI=$P(C HEDT,".",2 ),TIST=($P (DTE,"/",3 ))_($P(DTE ,"/",1))_( $P(DTE,"/" ,2))_SECTI
  185           Q: '$D(^AHCHV A(I,100,J, 0))
  186           S  BENEL="Y", DLFLAG="A"
  187           S  (H01,H02,H 03,H04,H05 ,H06,H07,H 08,H09,H10 ,H11,H12,H 13,STYR,ST MTH,QEDTE) ="",DLFLAG ="A",(ADEA TH,CHMFLAG ,BEGTOO)=0
  188           ;S PINA BIFID A CHECK
  189                    I $D (^AHCHVA(" SB",I,J))  D SBSELECT  Q
  190                    Q:'$ D(^AHCHVA( I,100,J,10 9))
  191           ;D ECEASED CH ECK
  192           S  AD=$P(^AHC HVA(I,100, J,0),"^",6 )
  193           I  AD'="" S D LFLAG="D"
  194           ;  Eligibilit y period C HECKS
  195           S  E1=0 F  S  E1=$O(^AHC HVA(I,100, J,109,E1))  Q:E1=""   D
  196           .  ;CHECK BEG IN DATE EL IGIBILITY
  197           .  S CKMFLAG= 0
  198           .  I $E(E1,1, 1)=2 S E1Y R=19
  199           .  I $E(E1,1, 1)=3 S E1Y R=20
  200           .  I $E(E1,1, 1)=4 S E1Y R=21
  201           .  S E1YR=E1Y R_$E(E1,2, 3),E1MTH=$ E(E1,4,5) 
  202           .  ; CHECK EN D DATE ELI GIBILITY 
  203           .  S E2=0,E2= $O(^AHCHVA (I,100,J,1 09,E1,E2))
  204           .  I $E(E2,1, 1)=2 S E2Y R=19
  205           .  I $E(E2,1, 1)=3 S E2Y R=20
  206           .  I $E(E2,1, 1)=4 S E2Y R=21      
  207           .  S E2YR=E2Y R_$E(E2,2, 3),E2MTH=$ E(E2,4,5)
  208           .  ; CALCULAT E TAX YEAR  ELIGIBILI TY
  209           .  I (E2YR<CP YR) S CKMF LAG=1 Q
  210           .  I (E2YR>CP YR) & (E1Y R>CPYR) Q
  211           .  I (E2YR=CP YR) & (E1Y R=CPYR) D  QEMONTH
  212           .  I (E2YR=CP YR) & (E1Y R<CPYR) S  STMTH=E2MT H,BGTOO=1  D CKMONTH
  213           .  I (E2YR>CP YR) & (E1Y R=CPYR) S  STMTH=E1MT H,BGTOO=0  D CKMONTH
  214           .  I (E2YR>CP YR) & (E1Y R<CPYR) S  H01="Y" 
  215           .  ;BAD ADDRE SS CHECK
  216           .  S FMAIL=$P (^AHCHVA(I ,100,J,1), U,10)
  217           .  I FMAIL="0 "  Q
  218           .  I FMAIL="2 "  Q
  219           .  Q:CKMFLAG= 1
  220           .  D EXTRACT
  221           .  Q
  222           Q
  223           ;
  224   EXTRACT ;E XTRACTION  ON BENES R EQUIRED IN FORMATION
  225           ;
  226           I  DLFLAG="A"  S FORM="F ORM=742-80 1A"
  227           I  DLFLAG="D"  S FORM="F ORM=742-80 1D"
  228           S  CDATE=RDAT E
  229           S  A00=""         ;CLIEN T PREFIX
  230           S  A01=$P($P( $P(^AHCHVA (I,100,J,0 ),"^",1)," ,",1)," ", 1)  ;CLIEN T LAST NAM E
  231           S  A02=$P($P( $P(^AHCHVA (I,100,J,0 ),"^",1)," ,",2)," ", 1)  ;CLIEN T FIRST NA NE
  232           S  A03=$P($P( $P(^AHCHVA (I,100,J,0 ),"^",1)," ,",2)," ", 2)  ;CLIEN T MID NAMA ME
  233           I  A03?2.A S  A02=A02_"  "_A03,A03= ""
  234           S  A04=$P($P( $P(^AHCHVA (I,100,J,0 ),"^",1)," ,",1)," ", 2)  ;CLIEN T NAME SUF FIX
  235           I  (A04'="SR" )&(A04'="J R")&(A04'= "I")&(A04' ="II")&(A0 4'="III")& (A04'="VI" )&(A04'="D R") S A01= A01_" "_A0 4,A04=""
  236           S  A04A=$P($P ($P(^AHCHV A(I,100,J, 0),"^",1), ",",1)," " ,3)
  237           I  (A04A'="") &(A04A'="S R")&(A04A' ="JR")&(A0 4A'="I")&( A04A'="II" )&(A04A'=" III")&(A04 A'="VI")&( A04A'="DR" ) S A01=A0 1_" "_A04A
  238                             E  S A 04=A04A
  239           S  A05=$P(^AH CHVA(I,100 ,J,0),"^", 2)
  240           I  A05="" S A 05="U"
  241           S  A15=I_"-"_ J   ;CLIEN T VPID
  242           S  A16=$P(^AH CHVA(I,100 ,J,0),"^", 9)      ;C LIENT SSN
  243           I  (A16?9N=0) !(A16="")  Q ;W !,"BA D SSN"," -  ",I," ",J ," = ",A16  Q
  244           S  N03=$P(^AH CHVA(I,100 ,J,0),"^", 3)      ;C LIENT DOB
  245           I  $E(N03,1,1 )=1 S N03Y R=18
  246           I  $E(N03,1,1 )=2 S N03Y R=19
  247           I  $E(N03,1,1 )=3 S N03Y R=20
  248           S  N03Y=N03YR _$E(N03,2, 3)
  249           S  N03=N03Y_$ E(N03,4,7)
  250           S  B01=$P(^AH CHVA(I,100 ,J,1),"^", 1)      ;C LIENT ADD  LN 1
  251           S  B02=$P(^AH CHVA(I,100 ,J,1),"^", 2)      ;C LIENT ADD  LN 2
  252           S  B03=$P(^AH CHVA(I,100 ,J,1),"^", 12)     ;C LIENT ADD  LN 3
  253           S  B04=$P(^AH CHVA(I,100 ,J,1),"^", 3)      ;C LIENT CITY
  254           S  B05=$P(^AH CHVA(I,100 ,J,1),"^", 4)
  255           S  B06=$P(^AH CHVA(I,100 ,J,1),"^", 13)     ;C OUTNRY
  256           I  B06=""  D
  257           .  I B05<61 S  B06=295
  258           I  B06'=""        D
  259           .  I '$D(^DIC (5,B06,0))  S B06="NA
  260           .  S B06=$P(^ DIC(5,B06, 0),"^",2)  ;CLIENT CO UNTRY
  261           I  B05'="" D
  262           .  I '$D(^DIC (5,B05,0))  S B05="NA "
  263           .  S B05=$P(^ DIC(5,B05, 0),"^",2)  ;CLIENT ST ATE
  264           S  B07=$P(^AH CHVA(I,100 ,J,1),"^", 5) ;! $P(^ AHCHVA(I,1 ),"^",13)    ;CLIENT  COUNTRY CO DE OR ZIP  CODE
  265           S  B08=""         ;CLIEN T COUNTY - - OPTIONAL
  266           S  B09=""         ;PROVI NCE FOREIG N ADD -- O PTIONAL
  267           S  B10=$P(^AH CHVA(I,100 ,J,1),"^", 13)     ;C OUTNRY
  268           I  B10'=""        D
  269           .  I '$D(^DIC (5,B10,0))  S B10="NA "
  270           .  S B10=$P(^ DIC(5,B10, 0),"^",2)  ;CLIENT CO UNTRY
  271           .  I B10="USA " S B10=""
  272           S  CNT=CNT+1, BETL="B"_" A"         ;MODIFIED  FOR ONE OU TPUT FILE
  273           S  I1=I_J         ;TO CA PTURE ALL  ELIGABLE B ENEIES
  274           ;I  DLFLAG="A " Q ;S BAC NT1=BACNT1 +1 Q:BACNT 1>240
  275           ;I  DLFLAG="D " S BDCNT1 =BDCNT1+1  Q:BDCNT1>3 0
  276           ;  RFE 07/25/ 17 DEF0287 72 Cut fol lowing lin e into 2
  277           ;R 18320413FY 18 DRW 01/ 19/2018  A DD AN ADDI TIONAL "U"  BELOW
  278           S  ^TEMP("IRS ",BETL,I1) =(FORM_U_C DATE_U_U_" A00="_A00_ U_"A01="_A 01_U_"A02= "_A02_U_"A 03="_A03_U _"A04="_A0 4_U_"A05=" _A05_U_"A1 5="_A15_U_ "A16="_A16 _U_"N03="_ N03_U_"B01 ="_B01_U_" B02="_B02_ U_"B03="_B 03_U_"B04= "_B04_U_"B 05="_B05_U _"B06="_B0 6_U_"B07=" _B07)
  279           ;  CJM SPLIT  LONG LINE  20170728
  280           S  ^TEMP("IRS ",BETL,I1) =^TEMP("IR S",BETL,I1 )_(U_"B08= "_B08_U_"B 09="_B09_U _"B10="_B1 0_U_"H01=" _H01_U_"H0 2="_H02_U_ "H03="_H03 _U_"H04="_ H04)
  281           S  ^TEMP("IRS ",BETL,I1) =^TEMP("IR S",BETL,I1 )_(U_"H05= "_H05_U_"H 06="_H06_U _"H07="_H0 7_U_"H08=" _H08_U_"H0 9="_H09_U_ "H10="_H10 _U_"H11="_ H11_U_"H12 ="_H12_U_" H13="_H13)
  282                    S RP TEMP=^TEMP ("IRS",BET L,I1)
  283           Q
  284   QEMONTH ;
  285           S  QEMTH=E1MT H+1-1,STMT H=E2MTH+1- 1 D  
  286           .I  QEMTH=1 S  H02="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  287           .I  QEMTH=2 S  H03="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  288           .I  QEMTH=3 S  H04="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  289           .I  QEMTH=4 S  H05="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  290           .I  QEMTH=5 S  H06="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  291           .I  QEMTH=6 S  H07="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  292           .I  QEMTH=7 S  H08="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  293           .I  QEMTH=8 S  H09="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  294           .I  QEMTH=9 S  H10="Y",Q EMTH=QEMTH +1 Q:QEMTH >STMTH
  295           .I  QEMTH=10  S H11="Y", QEMTH=QEMT H+1 Q:QEMT H>STMTH
  296           .I  QEMTH=11  S H12="Y", QEMTH=QEMT H+1 Q:QEMT H>STMTH
  297           .I  QEMTH=12  S H13="Y", QEMTH=QEMT H+1 Q:QEMT H>STMTH
  298           Q
  299   LTR1095 ;P ROCESS LET TER TAX YE AR AND 109 5 TAX YEAR  PDF
  300           ;
  301           Q
  302   CMSERR  ;P ROCESS CMS  ERROR FIL E
  303           ;
  304           Q
  305   CODE1R  ;P ROCESS CMS  CODE1 REJ ECT FILE
  306           ;
  307           Q
  308   ADDSUC  ;P ROCESS CMS  ADDRESS S UCCESS FIL E
  309           ;
  310           Q
  311   CKMONTH ;  FIND MONTH S IN YEAR
  312           I  BGTOO=0 D
  313           .I  STMTH="01 " S H01="Y "
  314           .I  STMTH="02 " S (H13,H 12,H11,H10 ,H09,H08,H 07,H06,H05 ,H04,H03)= "Y"
  315           .I  STMTH="03 " S (H13,H 12,H11,H10 ,H09,H08,H 07,H06,H05 ,H04)="Y"
  316           .I  STMTH="04 " S (H13,H 12,H11,H10 ,H09,H08,H 07,H06,H05 )="Y"
  317           .I  STMTH="05 " S (H13,H 12,H11,H10 ,H09,H08,H 07,H06)="Y "
  318           .I  STMTH="06 " S (H13,H 12,H11,H10 ,H09,H08,H 07)="Y"
  319           .I  STMTH="07 " S (H13,H 12,H11,H10 ,H09,H08)= "Y"
  320           .I  STMTH="08 " S (H13,H 12,H11,H10 ,H09)="Y"
  321           .I  STMTH="09 " S (H13,H 12,H11,H10 )="Y"
  322           .I  STMTH="10 " S (H13,H 12,H11)="Y "
  323           .I  STMTH="11 " S (H13,H 12)="Y"
  324           .I  STMTH="12 " S (H13)= "Y"
  325           .Q
  326           I  BGTOO=1 D
  327           .I  STMTH="01 " S (H02)= "Y"
  328           .I  STMTH="02 " S (H03,H 02)="Y"
  329           .I  STMTH="03 " S (H04,H 03,H02)="Y "
  330           .I  STMTH="04 " S (H05,H 04,H03,H02 )="Y"
  331           .I  STMTH="05 " S (H06,H 05,H04,H03 ,H02)="Y"
  332           .I  STMTH="06 " S (H07,H 06,H05,H04 ,H03,H02)= "Y"
  333           .I  STMTH="07 " S (H08,H 07,H06,H05 ,H04,H03,H 02)="Y"
  334           .I  STMTH="08 " S (H09,H 08,H07,H06 ,H05,H04,H 03,H02)="Y "
  335           .I  STMTH="09 " S (H10,H 09,H08,H07 ,H06,H05,H 04,H03,H02 )="Y"
  336           .I  STMTH="10 " S (H11,H 10,H09,H08 ,H07,H06,H 05,H04,H03 ,H02)="Y"
  337           .I  STMTH="11 " S (H12,H 11,H10,H09 ,H08,H07,H 06,H05,H04 ,H03,H02)= "Y"
  338           .I  STMTH="12 " S H01="Y "
  339           .Q       
  340           Q
  341           ;
  342   BENEOUTFIL E     ;MEC _DataExtra ct_O_CPYR_ A_B_TIST.t xt
  343           N  FILENM,MEC D,CORID,BE ND,BENID
  344           N  IOF,UCI
  345           S  IOF="#,*27 ,*91,*50,* 74,*27,*91 ,*72"
  346           X  ^%ZOSF("UC I") S UCI= $P(Y,",",1 )
  347           S  MECD="MEC_ DataExtrac t",CORID=" O",BEND="A ",BENID="B "
  348           S  FILENM=MEC D_"_"_CORI D_"_"_CPYR _"_"_BENID _"_"_TIST
  349           ;S  FILENM=ME CD_"_"_COR ID_BEND_BE NID_"_"_DT YR_"_"_TIS T
  350           ;
  351           S  VDFILE="HA C_HFS$:[SC R.TEMP_FIL ES]"_FILEN M_".TXT"
  352           I  UCI'="HAC"  S VDFILE= "HAC_HFS$: [DSMMANAG. CHAMPVA]"_ FILENM_".T XT"
  353           I  '$$OPENFIW R^CHTFLIB9 (.VDFILE," VDFILE") W  !,"FILE O PEN failed  on the fi le : "_VDF ILE Q
  354           ;U  VDFILE W  !,FILENM,! !
  355           S  BACNT=0,BA X=0 F  S B AX=$O(^TEM P("IRS","B A",BAX)) Q :'+BAX  D   
  356           .  U VDFILE W  !,^TEMP(" IRS","BA", BAX)
  357           .  S BACNT=BA CNT+1
  358           .  Q
  359           D  CLOSEF^CHT FLIB9(VDFI LE,"VDFILE ")
  360           H  5
  361             D FTPFILE^ CHTFLIB9(V DFILE," DNS     fs3. DNS             ","/FS3BIG /IRS_Lette rs","PUT")
  362             D FTPFILE^ CHTFLIB9(V DFILE," DNS     feedb1. DNS             ","/acaust in/ToESR", "PUT")
  363           Q
  364           ;
  365   END     ;C LEAN UP an d END
  366           W  !,"ELIGIBL E COUNT =  ",CNT 
  367           W  !,"DATA EX TRACT COMP LETED",!
  368           ;
  369           K  A01,A02,A0 4,A05,A15, A16,N03,B0 1,B02,B03, B04,B05,B0 6,B07,B08, B09,B10
  370           K  ADEATH,BAC NT1,BDCNT1 ,BENEL,CDA TE,CNT,CPY R,DLFLAG,D TE,DTYR,FO RM,I,I1
  371           K  ^TEMP("IRS ") ;****** ********** *** REMOVE  COMMENT A FTER TESTI NG
  372           Q
  373           ;
  374