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

97.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMEDRQT.m Mon Nov 5 16:43:29 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMEDRQT.m Mon Nov 5 17:44:06 2018 UTC

97.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 5 774
Changed 4 8
Inserted 0 0
Removed 0 0

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

97.4 Active regular expressions

No regular expressions were active.

97.5 Comparison detail

  1   CHMEDRQT ; HAC/AEB;QU ARTERLY UP DATE DEERS  WITH CHAM PVA BENE'S ;11/01/99   10:30 AM
  2    ;;;1.0;CH AMPVA SYST EM;;JULY 4 , 1990;V1
  3    ;PC DUO 5 8191 JEH 8 /3/10 - UP DATE ROUTI NE TO MATC H WEEKLY
  4    ;DPT 7/11 /11 - CORR ECT SSNTYP  TO SSSNTY P
  5    ;DPT 9/7/ 11 - MODIF IED EDIT O F BDOB FOR  BENE
  6    ;DPT 9/13 /11- CORRE CT FIELD N AME
  7    ;DPT 10/1 8/11 - ADD  EDIT TO E XCLUDE SB  BENES,SET  BREL TO "Z " IF NOT P RESENT
  8    ;DPT 1/5/ 12- OMIT B ENE WHO AR E CARE GIV ERS 
  9    ;DEV01393 6 DPT 2/9/ 12 - OMIT  BENE WHO A RE INELIBI BLE AND TR ICARE ELIG IBLE
  10    ;DPT 5/4/ 12 - OMIT  BENE WITH  REL "SF" , CHNG NOTIF Y TO MATCH  WEEKLY
  11    ;DPT 10/0 9/12 - add  notify to  include P ST group.
  12    ;DPT 10/2 9/12 MTN01 6594 - EMA IL CHANGE
  13    ;DPT 3/5/ 13 MTN0174 59 - omit  bene witho ut eligibi lity dates (no 105 no de) 
  14    ;MTN02307 3 DPT 4/8/ 15 - CHANG E POC AT D EERS
  15    ;ENC02077  DPT INCLU DE PSUEDO  SSN INDICA TOR WEEKLY ,QUARTERLY  FILES TO  DEERS 
  16    ;MTN02610 4 ADD CONT ACT FOR DE ERS
  17    ;;TEST DP T 9/3/15 S ET RELATIO NSHIP TO " G" IS UNMA RRIED WIDO W CR NUMBE R COMING J AN2016
  18    
  19   START ;
  20    W !,"This  will send  the Quart erly DEERS  update fi le",!
  21    W !,"Do y ou wish to  continue  ? " D CSBR S^CHSC2
  22    G END:$D( DFOUT) G E ND:$D(DUOU T)
  23    I $D(DQOU T) W !,"En ter 'Y' to  send file  to DEERS  'N' to exi t" G START
  24    G:Y="" EN D S ANS=$E (Y) S ANS= $$UP^XLFST R(ANS)
  25    I ANS="Y"  D QUEA^CH MEDRQT
  26    Q
  27   CFILE ;CRE ATE FILE
  28    S U="^",F ILEIO="HAC _HFS$:[DSM MANAG]DEER S_SEND.DAT "
  29    ;O FILEIO  C FILEIO: "D" O FILE IO  ;REMOV ES OLD FIL E AND CREA TES NEW
  30    O FILEIO  C FILEIO:" D" O FILEI O:"NWU"  ; REMOVES OL D FILE AND  CREATES N EW   ; JEH  8/11/05
  31    K ^CHMZHO LD("EA")   ;DELETES L AST RUN LI ST 
  32    I '$D(DT)  D NOW^%DT C S DT=X
  33    I DT="" D  NOW^%DTC  S DT=X
  34    S DFN=0,S FLG=0,CT=1
  35   C1 S DFN=$ O(^AHCHVA( "EA",DFN))  G:'DFN CE ND
  36    G:'$D(^AH CHVA(DFN,0 )) C1
  37     G:$D(^AH CHVA(DFN,1 5)) C1 ;DP T 10/18/11
  38    
  39    S BFN=0
  40   C2 S BFN=$ O(^AHCHVA( "EA",DFN,B FN)) G:'BF N C1
  41    G:'$D(^AH CHVA(DFN,1 00,BFN,0))  C2
  42    I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",4)="CG"  K ^AHCHVA ("EA",DFN, BFN) G C2   ;DPT 1/5/ 12
  43    I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",4)="SF"  K ^AHCHVA ("EA",DFN, BFN) G C2   ;DPT 5/4/ 12
  44    I $P(^AHC HVA(DFN,10 0,BFN,0)," ^",5)="D"  I $P(^AHCH VA(DFN,100 ,BFN,0),"^ ",12)="CHE "  K ^AHCH VA("EA",DF N,BFN) G C 2  ;DEV013 936 DPT 2/ 9/12 
  45    D SPN  ;C REATE SPON  DATA
  46    D BENE ;C RETE BENE  DATA
  47    S SFLG=1
  48    S ^CHMZHO LD("EA",DF N,BFN)=""   ;SETS UP  LIST FOR R ESEND
  49    S CT=CT+1
  50    G C2
  51   CEND C FIL EIO
  52    D ZWCLOSE ^CHMSNUTL( FILEIO,263 ,512)   ;  JEH 8/11/0 5
  53    I SFLG=1  D SEND
  54    K FILEIO, DFN,BFN,SR EC,BREC
  55    Q
  56   SEND ;SEND  FILE
  57    I '$D(DT)  D NOW^%DT C S DT=X
  58    K CHFTPTI M,CHFTPWT
  59    ;
  60    S CHFILE= "DROHAC.DA T "
  61    S CHFILE= $P(FILEIO, ":",2)_" "
  62    ;S CHFTPM SG=0
  63    ;S X=$ZF( -1,"SUBMIT  HAC_HFS$: [DSMMANAG] NEW_DEERS_ MU_FTP_OUT .COM","/NA ME=DEERS_M U_FTP_OUT_ JOB/NOPRIN TER/USER=H ACCACHEMGR ",CHFILE,D T) ; SUBMI T FTP JOB  IN LIVE
  64    S X=$ZF(- 1,"SUBMIT  HAC_HFS$:[ DSMMANAG]N EW_DEERS_M U_FTP_OUT. COM/NAME=D EERS_MU_FT P_OUT_JOB/ NOPRINTER/ USER=HACCA CHEMGR/PAR AM=("_CHFI LE_","_DT_ ")")  ;SUB MIT FTP JO B IN LIVE    ; JEH 8/ 11/05
  65    D NOTIFY  ;DPT 5/4/1 2
  66    ;
  67    ;FFTPCK S  RRD="HAC_ HFS$:[DSMM ANAG]DEERS _MU_FTP_OU T_JOB.LOG"     ;LIVE
  68    ; C RRD
  69    ; K CHFTP TIM,CHFTPW T S ZE="", QFLAG=0,CH FTPWT=$P(^ CHMDIC(741 002.17,1,2 ),U,10)
  70    ; F CHFTP TIM=1:1:CH FTPWT H 60   O RRD:"R ":10  D  Q :(QFLAG=1)
  71    ; .I '$T  C RRD Q
  72    ; .F  U R RD R RRDLI NE  D  Q:( QFLAG=1)!( $ZE["ENDOF FILE")
  73    ; ..I (RR DLINE["250  Transfer  completed" ) S CHFTPM SG=1,QFLAG =1 Q
  74    ; ..I (RR DLINE["Cha rged CPU t ime:") S Q FLAG=1 Q
  75    ; ;
  76    ;FTPERR C  RRD
  77    ;S CCHNB= 2
  78    ;S ZML(CC HNB)=""
  79    ;S ZML(CC HNB)="FILE :HAC_HFS$: [DSMMANAG] "_"DEERS_S END_"_DT_" .DAT"
  80    ;S CCHNB= CCHNB+1
  81    ;S ZML(CC HNB)=""
  82    ;S CCHNB= CCHNB+1
  83    ;I (CHFTP MSG=0)  D
  84    ;.S ZML(C CHNB)="FTP  UNSUCCESS FUL..Quart erly..OUT. .FTP DEERS _SEND_"_DT _".DAT fil e"
  85    ;.S CCHNB =CCHNB+1
  86    ;.S ZML(C CHNB)="Num ber of rec ords sent  "_CT_"."
  87    ;.Q
  88    ;I (CHFTP MSG=1)  D
  89    ;.S ZML(C CHNB)="FTP  successfu l..Quarter ly..OUT..F TP DEERS_S END_"_DT_" .DAT file"
  90    ;.Q
  91    ;S XMDUZ= .5
  92    ;S XMY(98 87)=""
  93    ;S XMY(" PII                    ")=""
  94    ;S XMTEXT ="ZML("
  95    ;I (CHFTP MSG=1)  D
  96    ;.S XMSUB ="SUCC   M O OUT DEER S File"_DT
  97    ;I (CHFTP MSG=0)  D
  98    ;.S XMSUB ="UNSUC MO  OUT DEERS  File"_DT
  99    ;D ^XMD
  100    ;D:CHFTPM SG=1 NOTIF Y                ;SEN D EMAILS V IA MS-EXCH G
  101    ;
  102   END K CHFT PMSG,RRD,R RDLINE,CHF ILE,FMDATE ,CCHNB,QFL AG
  103    Q
  104   NOTIFY ;SE ND MS-EXCH ANGE EMAIL S FROM VIS TA
  105    ;
  106    D UCI^%ZO SV I $P(Y, ",",1)'="H AC" Q
  107    S XMDUZ=D UZ
  108    S XMY(232 49)=""
  109    S XMY(" PII             ")=""    ;DPT 10/09 /12
  110    S XMY("'v eronica.t. parker4.ct r@mail.mil '")=""   ; DPT 4/8/15  MTN023073
  111    S XMY("'r ichard.m.b urton.ctr@ mail.mil'" )="" ;DPT  4/27/16 MT N026104
  112    S XMY(" PII                    ")=""
  113    S TEXT(1) ="DMDC,"    ;DPT 4/8/ 15 MTN0230 73
  114    S TEXT(2) =" "
  115    S TEXT(3) ="The Quar terly file  is availa ble on you r site for  processin g."
  116    S TEXT(4) ="Please l et us know  via this  message wh en you are  finished. "
  117    S TEXT(5) ="Number o f records  sent "_CT_ "."
  118    S TEXT(6) ="Thank Yo u"
  119    S XMTEXT= "TEXT("
  120    S XMSUB=" Quarterly  File"  ;DP T 5/4/12
  121    D ^XMD
  122    K XMY,XMD UZ,TEXT,XM TEXT,XMSUB
  123    I '$D(DT)  D NOW^%DT C S DT=X
  124    S XMY(" PII                    ")=""
  125    S XMDUZ=D UZ,XMSUB=" DEERS Outg oing file  for "_$$FM TE^XLFDT(D T,"5D")
  126    S TEXT(1) ="The DEER S FTP was  successful ly complet ed and sen t on "
  127    S TEXT(1) =TEXT(1)_$ $DOW^XLFDT (DT)_", "_ $$FMTE^XLF DT(DT,"8D" )_"."
  128    
  129    ;S RDT=$$ FMADD^XLFD T(DT,2,0,0 ,0)
  130    ;S TEXT(2 )=" "
  131    ;S TEXT(3 )="The ret urn should  be no lat er then "_ $$DOW^XLFD T(RDT)_",  "_$$FMTE^X LFDT(RDT," 8D")_"."
  132    D ^XMD
  133    K XMY,XMD UZ,TEXT,XM TEXT,XMSUB
  134    Q
  135   SPN ;GET A LL SPONSOR  DATA
  136    ;SSSN - S PONSORS SS N
  137    ;SSSNTYP  - S:ACTUAL  SSN,P:PSU DO
  138    ;SLNAME -  SPONSOR L AST NAME
  139    ;SFNAME -  SPONSOR F IRST NAME
  140    ;SMNAME -  SPONSOR M IDDLE NAME
  141    ;SDOB - S PONSOR DAT  OF BIRTH
  142    ;PTDATE -  SPONSORS  P&T DATE
  143    ;SDOD - S PONSOR DAT E OF DEATH
  144    ;SPSVC -  SPONSORS B RANCH OF S ERVICE (Z  FOR UNKNOW N)
  145    ;SPSTAT -  SPONSORS  STATUS( D: 100% FOR D AV)
  146    ;SPNLBDT  - BEGIN SP ONSOR'S ST ATUS DATE
  147    ;SPNLEDT  - END SPON SOR'S STAT US DATE
  148    S SPEC(". ")=""  ; A DD CHARACT ERS HERE I F THEY ARE  TO BE REM OVED FROM  THE NAME
  149    Q:'$G(DFN )   ;PC DU O 58191 JE H 8/3/10
  150    Q:'$D(^AH CHVA(DFN,0 ))   ;PC D UO 58191 J EH 8/3/10
  151    S (SSSN,S SSNTYP,SSN TYP1,SLNAM E,SFNAME,S MNAME,SDOB ,PTDATE,SD OD,SPSVC,S PSTAT,SPNL BDT,SPNLED T)=""  ;TL H 2/4/09 F IX UNDEFIN ED ERROR     ;PC DUO  58191 JEH  8/3/10
  152    S SREC=^A HCHVA(DFN, 0)
  153    S SSSN=$P (SREC,U,9) ,NAME=$P(S REC,U,1)
  154    S SSNTYP1 =$P(SREC,U ,10) S:SSN TYP1="" SS SNTYP="S"
  155    S:SSNTYP1 '="P" SSSN TYP="S" S: SSNTYP1="P " SSSNTYP= "S" ;ENC02 777 DPT CH ANGE SSNTY P TO SSSNT YP
  156    S SFNAME1 =$P(NAME," ,",2),CHBD AT="000000 00"
  157    S SFNAME= $P(SFNAME1 ," ",1)  S  SFNAME=$$ REPLACE^XL FSTR(SFNAM E,.SPEC) ; DPT 9/13/1 1
  158    S SLNAME= $E($P(NAME ,",",1),1, 26) S SLNA ME=$$REPLA CE^XLFSTR( SLNAME,.SP EC)
  159    S SMNAME= $P(SFNAME1 ," ",2) S  SMNAME=$$R EPLACE^XLF STR(SMNAME ,.SPEC)
  160    S SDOB=$P (SREC,U,3)  I SDOB'=" " S X=SDOB  D ^%DT S: Y=-1 SDOB= CHBDAT
  161    I SDOB'=" " I SDOB'= CHBDAT S S DOB=$$FMTE ^XLFDT(SDO B,"7D")
  162    I SDOB=""  S SDOB="0 0000000"
  163    D  
  164    .S PTDATE =9999999
  165    .S PTDATE =$O(^AHCHV A(DFN,102, PTDATE),-1 )
  166    .I PTDATE '="" S X=P TDATE D ^% DT S:Y=-1  PTDATE=CHB DAT 
  167    I PTDATE' ="" I PTDA TE'=CHBDAT  S PTDATE= $$FMTE^XLF DT(PTDATE, "7D")
  168    I PTDATE= "" S PTDAT E=CHBDAT
  169    S SDOD=$P (SREC,U,4)  I SDOD'=" " S X=SDOD  D ^%DT S: Y=-1 SDOD= CHBDAT
  170    I SDOD'=" " I SDOD'= CHBDAT S S DOD=$$FMTE ^XLFDT(SDO D,"7D")
  171    I SDOD=""  S SDOD=CH BDAT
  172    S SPSVC=" Z"  ;SPEC  ITEM #9
  173    S SPSTAT= "Z"  ;SPEC  ITEM #10
  174    S SPNLBDT =CHBDAT
  175    S SPNLEDT =CHBDAT
  176    ;CHECK FO RMATING TO  ENSURE IT S CORRECT
  177    S SSSN=$$ FXLGTH^CHT FLIB(SSSN, "L",9)
  178    S SFNAME= $$FXLGTH^C HTFLIB(SFN AME,"L",20 ) S SFNAME =$$REPLACE ^XLFSTR(SF NAME,.SPEC )
  179    S SLNAME= $$FXLGTH^C HTFLIB(SLN AME,"L",26 ) S SLNAME =$$REPLACE ^XLFSTR(SL NAME,.SPEC )
  180    S SMNAME= $$FXLGTH^C HTFLIB(SMN AME,"L",20 ) S SMNAME =$$REPLACE ^XLFSTR(SM NAME,.SPEC )
  181    I PTDATE' =CHBDAT D
  182    .I $L($P( PTDATE,"/" ,2))'=2 S  $P(PTDATE, "/",2)="0" _$P(PTDATE ,"/",2)
  183    .I $L($P( PTDATE,"/" ,3))'=2 S  $P(PTDATE, "/",3)="0" _$P(PTDATE ,"/",3)
  184    .S PTDATE =$$STRIP^X LFSTR(PTDA TE,"/")
  185    .Q
  186    I SDOB'=C HBDAT D 
  187    .I $L($P( SDOB,"/",2 ))'=2 S $P (SDOB,"/", 2)="0"_$P( SDOB,"/",2 )
  188    .I $L($P( SDOB,"/",3 ))'=2 S $P (SDOB,"/", 3)="0"_$P( SDOB,"/",3 )
  189    .S SDOB=$ $STRIP^XLF STR(SDOB," /")
  190    .Q
  191    I SDOD'=C HBDAT D
  192    .I $L($P( SDOD,"/",2 ))'=2 S $P (SDOD,"/", 2)="0"_$P( SDOD,"/",2 )
  193    .I $L($P( SDOD,"/",3 ))'=2 S $P (SDOD,"/", 3)="0"_$P( SDOD,"/",3 )
  194    .S SDOD=$ $STRIP^XLF STR(SDOD," /")
  195    .Q
  196    I SPNLBDT '=CHBDAT D
  197    .I $L($P( SPNLBDT,"/ ",2))'=2 S  $P(SPNLBD T,"/",2)=" 0"_$P(SPNL BDT,"/",2)
  198    .I $L($P( SPNLBDT,"/ ",3))'=2 S  $P(SPNLBD T,"/",3)=" 0"_$P(SPNL BDT,"/",3)
  199    .S SPNLBD T=$$STRIP^ XLFSTR(SPN LBDT,"/")
  200    .Q
  201    I SPNLEDT '=CHBDAT D
  202    .I $L($P( SPNLEDT,"/ ",2))'=2 S  $P(SPNLED T,"/",2)=" 0"_$P(SPNL EDT,"/",2)
  203    .I $L($P( SPNLEDT,"/ ",3))'=2 S  $P(SPNLED T,"/",3)=" 0"_$P(SPNL EDT,"/",3)
  204    .S SPNLED T=$$STRIP^ XLFSTR(SPN LEDT,"/")
  205    .Q
  206    ;U FILEIO  W SSSN,SS SNTYP,SLNA ME,SFNAME, SMNAME,SDO B,PTDATE,S DOD,SPSVC, SPSTAT,SPN LBDT,SPNLE DT   ; JEH  8/11/05
  207    S REC=SSS N_SSSNTYP_ SLNAME_SFN AME_SMNAME _SDOB_PTDA TE_SDOD_SP SVC_SPSTAT _SPNLBDT_S PNLEDT   ;  JEH 8/11/ 05
  208    Q
  209   BENE ;GET  ALL BENE D ATA
  210    ;BLNAME -  BENE LAST  NAME 13
  211    ;BFNAME -  BENE FIRS T NAME 14
  212    ;BMNAME -  BENE MIDD ILE NAME 1 5
  213    ;BDOB - B ENE DATE O F BIRTH 16
  214    ;BDOD - B ENE DATE O F DEATH 17
  215    ;BSEX - B ENE GENDER  18
  216    ;BREL - B ENE RELATI ONSHIP WIT H SPONSOR  19
  217    ;BPNABDT  - DATE BEN E BECAME A SSOCIATED  WITH SPONS OR 20
  218    ;BPNAEDT  - DATE BEN E BECAME U NASSOCIATE D WITH SPO NSOR 21
  219    ;BPNATRSN  - REASON  CODE FOR B ENE TO BEC OME UNASSO CIATED WIT H SPONSOR
  220    ;BPNECTYP  - CODE TO  REPRESENT  ASSOCIATI ON TERMINA TION 23
  221    ;BPNECBDT  - BEGIN D ATE THAT A FFECTED BE NE ELIG PE RIOD 24
  222    ;BPNECEDT  - END DAT E THAT AFF ECTED BENE  ELIG PERI OD 25
  223    ;BBEGDT -  CHAMPVA B EG ELIG DA TE 26
  224    ;BENDDT -  CHAMPVA E ND ELIG DA TE 27
  225    ;BSSN - B ENE SSN 28
  226    ;CHFILL -  FILLER OF  LENGTH 1  29
  227    Q:'$G(DFN )  Q:'$G(B FN)   ;PC  DUO 58191  JEH 8/3/10
  228    Q:'$D(^AH CHVA(DFN,1 00,BFN,0))    ;PC DUO  58191 JEH  8/3/10
  229    Q:'$D(^AH CHVA(DFN,1 00,BFN,105 )) ;DPT 3/ 5/13
  230    S (BLNAME ,BFNAME,BM NAME,BDOB, BDOD,BSEX, BREL,BPNAB DT,BPNAEDT ,BPNATRSN, BPNECTYP,B PNECBDT,BP NECEDT,BSS N,CHFILL)= ""  ;TLH 2 /4/09 FIX  UNDEFINED  ERROR      ;PC DUO 58 191 JEH 8/ 3/10
  231    S (BBEGDT ,BENDDT)=" 00000000"    ;PC DUO  58191 JEH  8/3/10
  232    S BREC=^A HCHVA(DFN, 100,BFN,0)
  233    S NAME=$P (^AHCHVA(D FN,100,BFN ,0),U,1)
  234    S BSSN=$P (BREC,U,9)
  235    ;   compa re sponsor  ssn type  and bene s sn type
  236    ;S BSTYPE 1=$P(BREC, U,36) D    ;ENC020777  DPT  
  237    ;  .I (SS NTYP1=""&B STYPE1="") !(SSNTYP1= ""&BSTYPE= "A")!(SSNT YP1="A"&BS TYPE="A")  S SSNTYP1= "S" ;ENC02 0777 DPT  
  238    ;  .I SSN TYP1="A"&B STYPE="P"  S SSNTYP1= "U" ;ENC02 0777 DPT  
  239    ;  .I (SS NTYP1="P"& BSTYPE="A" )!(SSNTYP1 ="P"&BSTYP E="")  S S SNTYP1="V"  ;ENC02077 7 DPT  
  240    ;  .I SSN TYP1="P"&B STYPE="P"  S SSNTYP1= "P" ;ENC02 0777 DPT  
  241    S BDOB=$P (BREC,"^", 3) I BDOB' ="" S X=BD OB D ^%DT  S:Y=-1 BDO B=CHBDAT ; DPT 9/7/11
  242    I BDOB=""  S BDOB=CH BDAT   ;DP T 9/7/11 
  243    S:BDOB'=C HBDAT BDOB =$$FMTE^XL FDT(BDOB," 7D") ;DPT  9/7/11
  244    S BDOD=$P (BREC,"^", 6) I BDOD' ="" S X=BD OD D ^%DT  S:Y=-1 BDO D=CHBDAT
  245    I BDOD=""  S BDOD=CH BDAT
  246    S:BDOD'=C HBDAT BDOD =$$FMTE^XL FDT(BDOD," 7D")
  247    S BSEX=$P (BREC,"^", 2) I BSEX' ="M" I BSE X'="F" S B SEX="Z"
  248    S BREL=$P (BREC,"^", 4)  ;NEED  TO REFINE  TO DEERS C ODE SET
  249    I BREL=""  S BREL="Z " ; DPT 10 /18/11
  250    I BREL="X S" S BREL= "S"  ;DEER S UNABLE T O ACCEPT E X SPOUSE S TATUS    ; PC DUO 581 91 JEH 8/3 /10
  251    I BREL="C " D
  252    .S:$P(BRE C,"^",26)= "S" BREL=" V"
  253    ;I BREL=" S" I $P(BR EC,"^",5)= "EA" I $P( BREC,"^",1 3)="WMT" S  BREL="G"  ;TEST DPT  9/3/15 ACT IVATE IN J AN 2016
  254    
  255    S BFNAME1 =$P(NAME," ,",2)
  256    S BFNAME= $E($P(BFNA ME1," ",1) ,1,20),BFN AME=$$REPL ACE^XLFSTR (BFNAME,.S PEC)
  257    S BMNAME= $E($P(BFNA ME1," ",2) ,1,20),BMN AME=$$REPL ACE^XLFSTR (BMNAME,.S PEC)
  258    S BLNAME= $E($P(NAME ,",",1),1, 26),BLNAME =$$REPLACE ^XLFSTR(BL NAME,.SPEC )
  259    D
  260    .S IDT=0
  261    .S IDT=$O (^AHCHVA(D FN,100,BFN ,105,IDT))  I 'IDT S  (IDT,FDT)= CHBDAT Q
  262    .S FDT=0
  263    .S FDT=$O (^AHCHVA(D FN,100,BFN ,105,IDT,F DT)) I 'FD T S FDT=CH BDAT Q
  264    .Q
  265    I IDT'=CH BDAT S BBE GDT=$$FMTE ^XLFDT(IDT ,"7D")
  266    I FDT'=CH BDAT S BEN DDT=$$FMTE ^XLFDT(FDT ,"7D")
  267    S BPNABDT =CHBDAT D
  268    .I BREL=" C" S BPNAB DT=BDOB D
  269    ..S:$P(BR EC,"^",26) ="A" BPNAB DT=$P(BREC ,"^",27)   ;ADOPTION  DT FOR ADO PTED CHILD
  270    ..S:$P(BR EC,"^",26) ="S" BPNAB DT=$P(^AHC HVA(DFN,10 0,BFN,3)," ^",3)  ;DT  OF MARRIA GE FOR STE P CHILD
  271    ..S:$P(BR EC,"^",26) ="I" BPNAB DT=$P(BREC ,"^",10)   ;QE DT FOR  ILLIG. CH ILD
  272    .I BREL=" V" S BPNAB DT=$P(BREC ,"^",8)
  273    .I BREL=" S" S BPNAB DT="000000 00" Q
  274    .S X=BPNA BDT D ^%DT  I Y=-1 S  BPNABDT=CH BDAT Q
  275    .S BPNABD T=$$FMTE^X LFDT(BPNAB DT,"7D")
  276    .I $L($P( BPNABDT,"/ ",2))'=2 S  $P(BPNABD T,"/",2)=" 0"_$P(BPNA BDT,"/",2)
  277    .I $L($P( BPNABDT,"/ ",3))'=2 S  $P(BPNABD T,"/",3)=" 0"_$P(BPNA BDT,"/",3)
  278    .S BPNABD T=$$STRIP^ XLFSTR(BPN ABDT,"/")
  279    .Q
  280    S BPNAEDT =CHBDAT D
  281    .I BREL=" S" S BPNAE DT="000000 00"
  282    .I BREL=" C" S BPNAE DT="000000 00" D
  283    ..I $P(BR EC,"^",19) =1 I $P(BR EC,"^",31) '="" S BPN AEDT=$P(BR EC,"^",31)  Q  ;ALWAY S SET END  DATE TO CH ILD MARRIA GE DT DPT  9/13/11
  284    ..S:$P(BR EC,"^",26) ="S" BPNAE DT=$P(BREC ,"^",7)  ; DATE OD MA RRIAGE TER M FOR STEP  CHILD.
  285    ..I $P(BR EC,"^",26) ="A" I $P( BREC,"^",6 )'="" S BP NAEDT=$P(B REC,"^",6)   ;ADOPTED  CHILD END  DATE = DT  OF DEATH  DPT 9/13/1 1
  286    .S X=BPNA EDT D ^%DT  I Y=-1 S  BPNAEDT="0 0000000" Q
  287    .S BPNAED T=$$FMTE^X LFDT(BPNAE DT,"7D")
  288    .I $L($P( BPNAEDT,"/ ",2))'=2 S  $P(BPNAED T,"/",2)=" 0"_$P(BPNA EDT,"/",2)
  289    .I $L($P( BPNAEDT,"/ ",3))'=2 S  $P(BPNAED T,"/",3)=" 0"_$P(BPNA EDT,"/",3)
  290    .S BPNAED T=$$STRIP^ XLFSTR(BPN AEDT,"/")
  291    .Q
  292    S BPNATRS N="Z"
  293    ;I BPNAED T'=CHBDAT  D
  294    ;.I BREL= "C" I $P(B REC,"^",31 )'="" S BP NATRSN="H"  Q
  295    ;.I BREL= "V" I $P(B REC,"^",31 )'="" S BP NATRSN="H"  Q
  296    ;.I BREL= "S" I $P(B REC,"^",16 )=1 S BPNA TRSN="T" Q
  297    S BPNECTY P="  " I $ P(BREC,"^" ,22)=1 S B PNECTYP="0 1"
  298    S BPNECED T="0000000 0"
  299    S BPNECBD T="0000000 0" D
  300    .Q:$P(BRE C,"^",22)' =1   ;ONLY  SET FOR S CHOOL DATE S
  301    .S I=99,I =$O(^AHCHV A(DFN,100, BFN,104,I) ,-1) Q:'I   Q:'$D(^AH CHVA(DFN,1 00,BFN,104 ,I,0))
  302    .S BPNECB DT=$P(^AHC HVA(DFN,10 0,BFN,104, I,0),"^",1 )
  303    .S BPNECE DT=$P(^AHC HVA(DFN,10 0,BFN,104, I,0),"^",2 )
  304    .S X=BPNE CBDT D ^%D T I Y=-1 S  (BPNECBDT ,BPNECEDT) =CHBDAT Q
  305    .S X=BPNE CEDT D ^%D T I Y=-1 S  (BPNECBDT ,BPNECEDT) =CHBDAT Q
  306    .S BPNECB DT=$$FMTE^ XLFDT(BPNE CBDT,"7D")
  307    .S BPNECE DT=$$FMTE^ XLFDT(BPNE CEDT,"7D")
  308    .I $L($P( BPNECBDT," /",2))'=2  S $P(BPNEC BDT,"/",2) ="0"_$P(BP NECBDT,"/" ,2)
  309    .I $L($P( BPNECBDT," /",3))'=2  S $P(BPNEC BDT,"/",3) ="0"_$P(BP NECBDT,"/" ,3)
  310    .I $L($P( BPNECEDT," /",2))'=2  S $P(BPNEC EDT,"/",2) ="0"_$P(BP NECEDT,"/" ,2)
  311    .I $L($P( BPNECEDT," /",3))'=2  S $P(BPNEC EDT,"/",3) ="0"_$P(BP NECEDT,"/" ,3)
  312    .S BPNECB DT=$$STRIP ^XLFSTR(BP NECBDT,"/" )
  313    .S BPNECE DT=$$STRIP ^XLFSTR(BP NECEDT,"/" )
  314    .Q
  315    S BSSN=$$ FXLGTH^CHT FLIB(BSSN, "L",9)
  316    S BFNAME= $$FXLGTH^C HTFLIB(BFN AME,"L",20 )
  317    S BLNAME= $$FXLGTH^C HTFLIB(BLN AME,"L",26 )
  318    S BMNAME= $$FXLGTH^C HTFLIB(BMN AME,"L",20 )
  319    I BDOB'=C HBDAT D ;D PT CHECK F OR ZEROS 9 /9/11
  320    .I $L($P( BDOB,"/",2 ))'=2 S $P (BDOB,"/", 2)="0"_$P( BDOB,"/",2 )
  321    .I $L($P( BDOB,"/",3 ))'=2 S $P (BDOB,"/", 3)="0"_$P( BDOB,"/",3 )
  322    .S BDOB=$ $STRIP^XLF STR(BDOB," /")  ;DPT  9/13/11
  323    I BDOD'=C HBDAT D
  324    .I $L($P( BDOD,"/",2 ))'=2 S $P (BDOD,"/", 2)="0"_$P( BDOD,"/",2 )
  325    .I $L($P( BDOD,"/",3 ))'=2 S $P (BDOD,"/", 3)="0"_$P( BDOD,"/",3 )
  326    .S BDOD=$ $STRIP^XLF STR(BDOD," /") ;DPT 9 /9/11
  327    .Q
  328    I IDT'=CH BDAT D
  329    .I $L($P( BBEGDT,"/" ,2))'=2 S  $P(BBEGDT, "/",2)="0" _$P(BBEGDT ,"/",2)
  330    .I $L($P( BBEGDT,"/" ,3))'=2 S  $P(BBEGDT, "/",3)="0" _$P(BBEGDT ,"/",3)
  331    .S BBEGDT =$$STRIP^X LFSTR(BBEG DT,"/")
  332    .Q
  333    I FDT'=CH BDAT D
  334    .I $L($P( BENDDT,"/" ,2))'=2 S  $P(BENDDT, "/",2)="0" _$P(BENDDT ,"/",2)
  335    .I $L($P( BENDDT,"/" ,3))'=2 S  $P(BENDDT, "/",3)="0" _$P(BENDDT ,"/",3)
  336    .S BENDDT =$$STRIP^X LFSTR(BEND DT,"/")
  337    .Q
  338    ;I BPNAED T'=CHBDAT  D        D PT 9/13/11
  339    ;.I $L($P (BPNAEDT," /",2))'=2  S $P(BPNAE DT,"/",2)= "0"_$P(BPN AEDT,"/",2 )
  340    ;.I $L($P (BPNAEDT," /",3))'=2  S $P(BPNAE DT,"/",3)= "0"_$P(BPN AEDT,"/",3 )
  341    ;.S BPNAE DT=$$STRIP ^XLFSTR(BP NAEDT,"/")
  342    ;.Q
  343    ;;I BPNEC BDT'=CHBDA T I BPNECE DT["/" D
  344    ;.I $L($P (BPNECBDT, "/",2))'=2  S $P(BPNE CBDT,"/",2 )="0"_$P(B PNECBDT,"/ ",2)
  345    ;.I $L($P (BPNECBDT, "/",3))'=2  S $P(BPNE CBDT,"/",3 )="0"_$P(B PNECBDT,"/ ",3)
  346    ;.S BPNEC BDT=$$STRI P^XLFSTR(B PNECBDT,"/ ")
  347    ;.Q
  348    ;;I BPNEC EDT'=CHBDA T I BPNECE DT["/" D
  349    ;.I $L($P (BPNECEDT, "/",2))'=2  S $P(BPNE CEDT,"/",2 )="0"_$P(B PNECEDT,"/ ",2)
  350    ;.I $L($P (BPNECEDT, "/",3))'=2  S $P(BPNE CEDT,"/",3 )="0"_$P(B PNECEDT,"/ ",3)
  351    ;.S BPNEC EDT=$$STRI P^XLFSTR(B PNECEDT,"/ ")
  352    ;.Q
  353    S CHFILL= " "
  354    S CHFILL= $$FXLGTH^C HTFLIB(CHF ILL,"L",1)
  355    ;U FILEIO  W BLNAME, BFNAME,BMN AME,BDOB,B DOD,BSEX,B REL,BPNABD T,BPNAEDT, BPNATRSN,B PNECTYP,BP NECBDT,BPN ECEDT,BBEG DT,BENDDT, BSSN,CHFIL L,!  ;TLH  12/14/06 M ODIFIED TO  MATCH WEE KLY DEERS  PROCESS
  356    ; FOR ENC  020777 NE ED TO REPL ACE SECOND  POSITION  OF REC BEF ORE NEXT S TEP 
  357    S REC=REC _BLNAME_BF NAME_BMNAM E_BDOB_BDO D_BSEX_BRE L_BPNABDT_ BPNAEDT_BP NATRSN_BPN ECTYP_BPNE CBDT_BPNEC EDT_BBEGDT _BENDDT_BS SN_CHFILL   ;TLH 12/1 4/06 MODIF ED TO MATC H WEEKLY D EERS PROCE SS
  358    D ZWCHAR^ CHMSNUTL(F ILEIO,REC)
  359    Q
  360   QUEA ;QUE  THIS ROUTI NE MANUALL Y.
  361    I '$D(DUZ ) S DUZ=1, DUZ(0)="@"
  362    D NOW^%DT C S DT=X
  363    S:'$D(DTI ME) DTIME= 300
  364    S U="^"
  365    S CHFIO=" "
  366    S ZTRTN=" CFILE^CHME DRQT",ZTDE SC="SEND Q UARTERLY D ATA FILE T O DEERS"
  367    S ZTIO="" ,ZTSAVE("C HFIO")=""
  368    D ^%ZTLOA D
  369    Q
  370   RFILE ;RES END FILE
  371    S U="^",F ILEIO="HAC _HFS$:[DSM MANAG]DEER S_SEND.DAT "
  372    ;O FILEIO  C FILEIO: "D" O FILE IO
  373    O FILEIO  C FILEIO:" D" O FILEI O:"NWU"    ; JEH 8/11 /05
  374    I '$D(DT)  D NOW^%DT C S DT=X
  375    I DT="" D  NOW^%DTC  S DT=X
  376    S DFN=0,S FLG=0,CT=1
  377   R1 S DFN=$ O(^CHMZHOL D("EA",DFN )) G:'DFN  REND
  378    G:'$D(^AH CHVA(DFN,0 )) R1
  379    S BFN=0
  380   R2 S BFN=$ O(^CHMZHOL D("EA",DFN ,BFN)) G:' BFN R1
  381    G:'$D(^AH CHVA(DFN,1 00,BFN,0))  R2
  382    D SPN  ;C REATE BENE  DATA
  383    D BENE ;C RETE BENE  DATA
  384    S SFLG=1
  385    S CT=CT+1
  386    G R2
  387   REND C FIL EIO
  388    D ZWCLOSE ^CHMSNUTL( FILEIO,263 ,512)   ;  JEH 8/11/0 5
  389    I SFLG=1  D SEND
  390    K FILEIO, DFN,BFN,SR EC,BREC
  391    Q