259. EPMO Open Source Coordination Office Redaction File Detail Report

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

259.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMXWB08.m Mon Nov 5 16:41:20 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMXWB08.m Mon Nov 5 17:53:37 2018 UTC

259.2 Comparison summary

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

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

259.4 Active regular expressions

No regular expressions were active.

259.5 Comparison detail

  1   CHMXWB08                 ;HAC/RK N;WEB NTLY  ELIG DEMO  UPDATE PA RT II;06/1 0/03 1310  PM
  2                   ;;1.0 ;CHAMPVA S YSTEM;;JUL Y 4,1990;
  3                   ;;CAL LED BY ^CH MXWB07
  4                   ;;CAL LS NONE
  5                   ;;
  6                   ;;
  7                   ;;
  8                   ;;AJM  07-03-07  DEV002659  FIXED DATE  FORMATTIN G FOR DATE S PAST 209 9
  9                   ;DEV0 12841 BMJ  added Care giver as c hoice for  the Relati onship
  10                   ;DEV0 16554 -- R eplace wit h extrinsi c open fun ction -- D RW 01/17/2 014
  11   CORRADD I  $D(CHREC3)  D
  12                   .S CH BADC1=$E($ P(CHREC3," ^",1),1,30 ),CHBADC2= $E($P(CHRE C3,"^",2), 1,30)
  13                   .S CH BADC3=$E($ P(CHREC3," ^",3),1,30 ),CHBADC4= $E($P(CHRE C3,"^",4), 1,30)
  14                   .S CH CCTY=$E($P (CHREC3,"^ ",6),1,20) ,CHBCSTE=$ E($P(CHREC 3,"^",7),1 ,2)
  15                   .S CH BCZIP=$E($ P(CHREC3," ^",8),1,10 )
  16                   I CHB CSTE'="" I  $D(^DIC(5 ,CHBCSTE,0 )) S CHBCS TE=$P(^DIC (5,CHBCSTE ,0),"^",2)
  17                   S CHM AXL=30
  18                   S CHX AL=CHBADC1  D PADBLKS  S CHBADC1 =CHXAL
  19                   S CHX AL=CHBADC2  D PADBLKS  S CHBADC2 =CHXAL
  20                   S CHX AL=CHBADC3  D PADBLKS  S CHBADC3 =CHXAL
  21                   S CHX AL=CHBADC4  D PADBLKS  S CHBADC4 =CHXAL
  22                   S CHM AXL=20,CHX AL=CHCCTY  D PADBLKS  S CHCCTY=C HXAL
  23                   S CHM AXL=2,CHXA L=CHBCSTE  D PADBLKS  S CHBCSTE= CHXAL
  24                   Q
  25   RMITADD I  $D(CHREC2)  D
  26                   .S CH BADR1=$E($ P(CHREC2," ^",1),1,30 ),CHBADR2= $E($P(CHRE C2,"^",2), 1,30)
  27                   .S CH RCTY=$E($P (CHREC2,"^ ",3),1,20) ,CHBRSTE=$ E($P(CHREC 2,"^",4),1 ,2)
  28                   .S CH BRZIP=$E($ P(CHREC2," ^",5),1,10 )
  29                   I CHB RSTE'="" I  $D(^DIC(5 ,CHBRSTE,0 )) S CHBRS TE=$P(^DIC (5,CHBRSTE ,0),"^",2)
  30                   I (CH BSEX'="M") &(CHBSEX'= "F") S CHB SEX="U"
  31                   S CHB SSN=$E($P( CHREC1,"^" ,9),1,9),C HBDOB=$E($ P(CHREC1," ^",3),1,7)
  32                   S:$D( CHBDOB) CH BDOB=$$FMT OYYYYMMDD^ CHEDILIB(C HBDOB) ;AJ M 07-03-07  DEV002659
  33                   S CHB CPH=$E($P( CHREC3,"^" ,10),1,20) ,CHBRPH=$E ($P(CHREC2 ,"^",6),1, 20),CHBREL =$E($P(CHR EC1,"^",4) ,1,9)
  34                   S:CHB REL'="" CH BREL=$S(CH BREL="C":" CHILD",CHB REL="S":"S POUSE",CHB REL="XS":" EX-SPOUSE" ,CHBREL="C G":"CAREGI VER",1:"UN KNOWN")  ; DEV012841  BMJ
  35                   S CHM AXL=30
  36                   S CHM AXL=35,CHX AL=CHBLNAM  D PADBLKS  S CHBLNAM =CHXAL
  37                   S CHM AXL=25,CHX AL=CHBFNAM  D PADBLKS  S CHBFNAM =CHXAL
  38                   S CHM AXL=20,CHN UM=CHBCPH  D STRPPH D  STRPIT D  PADZROS S  CHBCPH=CHX 4
  39                   S CHM AXL=20,CHN UM=CHBRPH  D STRPPH D  STRPIT D  PADZROS S  CHBRPH=CHX 4
  40                   S CHM AXL=10,CHN UM=CHBCZIP  D STRPIT  D PADRZRO  S CHBCZIP= CHX4
  41                   S CHD FSSN=$E($P (^AHCHVA(C HDFN,0),"^ ",9),1,9)
  42                   ;S CH MAXL=9,CHX AL=CHDFSSN  D PADZROS  S CHDFSSN =CHX4
  43                   ;
  44   NEWPC      S CHBPAYID ="00232"
  45                   S CHM AXL=5,CHXA L=CHBPAYID  D PADBLKS  S CHBPAYI D=CHXAL
  46                   S CHB MID=CHBSSN ,CHBSID=CH BSSN
  47                   S CHM AXL=20,CHX AL=CHBMID  D PADBLKS  S CHBMID=C HXAL
  48                   S CHM AXL=20,CHX AL=CHBSID  D PADBLKS  S CHBSID=C HXAL
  49                   S CHB REL="18"
  50                   S CHM AXL=3,CHXA L=CHBREL D  PADBLKS S  CHBREL=CH XAL
  51                   S CHM AXL=9,CHXA L=CHBSSN D  PADBLKS S  CHBSSN=CH XAL
  52                   S CHM AXL=8,CHNU M=CHBDOB D  STRPIT D  PADZROS S  CHBDOB=CHX 4
  53                   S CHB NAME=$P(CH REC1,"^",1 )
  54                   S CHB LNAM=$E($P (CHBNAME," ,",1),1,35 )
  55                   S CHB FNAM=$E($P (CHBNAME," ,",2),1,25 )
  56                   S CHB MNAM=$P(CH BFNAM," ", 2)
  57                   S CHB FNAM=$P(CH BFNAM," ", 1)
  58                   S CHM AXL=35,CHX AL=CHBLNAM  D PADBLKS  S CHBLNAM =CHXAL
  59                   S CHM AXL=25,CHX AL=CHBFNAM  D PADBLKS  S CHBFNAM =CHXAL
  60                   S CHB MNAM=" "
  61                   S CHM AXL=20,CHX AL=CHBMNAM  D PADBLKS  S CHBMNAM =CHXAL
  62                   S CHB PNAM=" "
  63                   S CHM AXL=5,CHXA L=CHBPNAM  D PADBLKS  S CHBPNAM= CHXAL
  64                   S CHB SNAM=" "
  65                   S CHM AXL=5,CHXA L=CHBSNAM  D PADBLKS  S CHBSNAM= CHXAL
  66                   S CHB SEX=$E($P( CHREC1,"^" ,2),1,1)
  67                   I (CH BSEX'="M") &(CHBSEX'= "F") S CHB SEX="U"
  68                   S CHB DECDT=" "
  69                   S CHM AXL=8,CHXA L=CHBDECDT  D PADBLKS  S CHBDECD T=CHXAL
  70                   S CHB HAND=" ",C HBMAR=" ", CHBSTUD="  "
  71                   S CHB PLCD="0023 2"
  72                   S CHM AXL=20,CHX AL=CHBPLCD  D PADBLKS  S CHBPLCD =CHXAL
  73                   S CHB PLDS=" ",C HMAXL=80,C HXAL=CHBPL DS D PADBL KS S CHBPL DS=CHXAL
  74                   S CHB GPCD=" ",C HMAXL=20,C HXAL=CHBGP CD D PADBL KS S CHBGP CD=CHXAL
  75                   S CHB GPDS=" ",C HMAXL=80,C HXAL=CHBGP DS D PADBL KS S CHBGP DS=CHXAL
  76                   S CHB STAT="1",C HMAXL=1,CH XAL=CHBSTA T D PADBLK S S CHBSTA T=CHXAL
  77                   S CHB ADR1=" "
  78                   S CHM AXL=50,CHX AL=CHBADR1  D PADBLKS  S CHBADR1 =CHXAL
  79                   S CHB ADR2=" "
  80                   S CHM AXL=50,CHX AL=CHBADR2  D PADBLKS  S CHBADR2 =CHXAL
  81                   S CHR CTY=" "
  82                   S CHM AXL=30,CHX AL=CHRCTY  D PADBLKS  S CHRCTY=C HXAL
  83                   S CHB RSTE=" "
  84                   S CHM AXL=2,CHXA L=CHBRSTE  D PADBLKS  S CHBRSTE= CHXAL
  85                   S CHB RZIP=" "
  86                   S CHM AXL=10,CHX AL=CHBRZIP  D PADBLKS  S CHBRZIP =CHXAL
  87                   S CHB CNTY=" "
  88                   S CHM AXL=30,CHX AL=CHBCNTY  D PADBLKS  S CHBCNTY =CHXAL
  89                   S CHB HFIL1="",C HBHFIL2="" ,CHBDFIL1= " ",CHBTFI L1=" ",CHB TFIL2=" "
  90                   S CHM AXL=100,CH XAL=CHBHFI L1 D PADBL KS S CHBHF IL1=CHXAL
  91                   S CHM AXL=491,CH XAL=CHBHFI L2 D PADBL KS S CHBHF IL2=CHXAL
  92                   S CHM AXL=139,CH XAL=CHBDFI L1 D PADBL KS S CHBDF IL1=CHXAL
  93                   S CHM AXL=200,CH XAL=CHBTFI L1 D PADBL KS S CHBTF IL1=CHXAL
  94                   S CHM AXL=483,CH XAL=CHBTFI L2 D PADBL KS S CHBTF IL2=CHXAL
  95                   S CHB TRCID="TRL R"
  96                   S CHM AXL=4,CHXA L=CHBTRCID  D PADBLKS  S CHBTRCI D=CHXAL
  97                   S CHB HRCID="HDR "
  98                   S CHM AXL=4,CHXA L=CHBHRCID  D PADBLKS  S CHBHRCI D=CHXAL
  99                   S CHB DRCID="DTL "
  100                   S CHM AXL=4,CHXA L=CHBDRCID  D PADBLKS  S CHBDRCI D=CHXAL
  101                   ;
  102   HDRTIME S  CURDT=$H
  103                   S CHB CDTE=$ZDAT E(CURDT,8)
  104                   S CHB CTIME=$$GE THHMMSS^CH EDILIB(CUR DT)
  105                   S CHB SBNM="VA,  Health Adm in Center"
  106                   S CHM AXL=30,CHX AL=CHBSBNM  D PADBLKS  S CHBSBNM =CHXAL
  107                   S CHB RCNM="WEBM D/Empower"
  108                   S CHM AXL=30,CHX AL=CHBRCNM  D PADBLKS  S CHBRCNM =CHXAL
  109                   S CHB LOADT="F"
  110                   ;S CH BLOADT="I"
  111                   S CHB TRACE=CHBC DTE_CHBCTI ME
  112                   S CHM AXL=20,CHX AL=CHBTRAC E D PADBLK S S CHBTRA CE=CHXAL
  113                   S CHB VERCD="01"
  114                   S CHM AXL=2,CHNU M=CHBVERCD  D STRPIT  D PADZROS  S CHBVERCD =CHX4
  115                   S CHB RELCD="03"
  116                   S CHM AXL=2,CHNU M=CHBRELCD  D STRPIT  D PADZROS  S CHBRELCD =CHX4
  117                   Q
  118                   ;
  119   WRGLOB   S  CHRWCT1=C HRWCT1+1
  120                   S CHB RWCT=CHRWC T1
  121                   S CHM AXL=10,CHN UM=CHBRWCT  D STRPIT  D PADZROS  S CHBRWCT= CHX4
  122                   K ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_FCK")
  123                   S ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_FCK",FMD ATE)=""
  124                   ;
  125   WRTMPJ   S  ^CHMZHOLD ("RKN_WELI G",$J,"WEB _NTLY_UPDT ",CHDFN,CH BFN,CHRWCT 1,0)=CHBDR CID_CHBRWC T_CHBPAYID _CHBMID_CH BSID_CHBRE L_CHBDOB_C HBLNAM_CHB FNAM_CHBMN AM_CHBPNAM _CHBSNAM_C HBSEX_CHBS TUD_CHBHAN D_CHBDECDT _CHBELDT1_ CHBELDT2_C HBPLCD_CHB PLDS
  126                   S ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_UPDT",CH DFN,CHBFN, CHRWCT1,1) =CHBGPCD_C HBGPDS_CHB STAT_CHBAD R1_CHBADR2 _CHRCTY_CH BRSTE_CHBR ZIP_CHBCNT Y_CHBDFIL1 _"L"
  127                   ;
  128                   ;
  129   CKSENT   ; ////////// ////////// ////////// ////////// ////////// ///////
  130                   ;K CK HOLD1,CKHO LD2,SENTFL AG
  131                   ;S CK HOLD1=CHBP AYID_CHBMI D_CHBSID_C HBREL_CHBD OB_CHBLNAM _CHBFNAM_C HBMNAM_CHB PNAM_CHBSN AM_CHBSEX_ CHBSTUD_CH BHAND_CHBD ECDT_CHBEL DT1_CHBELD T2_CHBPLCD _CHBPLDS,C KHOLD2=CHB GPCD_CHBGP DS_CHBSTAT _CHBADR1_C HBADR2_CHR CTY_CHBRST E_CHBRZIP_ CHBCNTY_CH BDFIL1
  132                   ;I ($ D(^CHMZHOL D("RKN_WEB HOLD",CHDF N,CHBFN,0) ))&($D(^CH MZHOLD("RK N_WEBHOLD" ,CHDFN,CHB FN,1))) D
  133                   ;.I ( ^CHMZHOLD( "RKN_WEBHO LD",CHDFN, CHBFN,0)=C KHOLD1)&(^ CHMZHOLD(" RKN_WEBHOL D",CHDFN,C HBFN,1)=CK HOLD2) D
  134                   ;..S  SENTFLAG=1
  135                   ;..K  ^CHMZHOLD( "RKN_WELIG ",$J,"WEB_ NTLY_UPDT" ,CHDFN,CHB FN,CHRWCT1 ,0),^CHMZH OLD("RKN_W ELIG",$J," WEB_NTLY_U PDT",CHDFN ,CHBFN,CHR WCT1,1),^C HMZHOLD("R KN_WELIG", $J,"WEB_EL IGDTES",CH DFN,CHBFN)
  136                   ;..S  CHRWCT1=CH RWCT1-1,CH BRWCT=CHRW CT1,CHMAXL =10,CHNUM= CHBRWCT D  STRPIT D P ADZROS S C HBRWCT=CHX 4
  137                   ;..Q
  138                   ;.Q
  139                   ;I $D (SENTFLAG)  K SENTFLA G,CKHOLD1, CKHOLD2 Q
  140                   ;
  141                   ;//// ////////// ////////// ////////// ////////// ////////// ///
  142                   ;
  143                   S ^CH MZHOLD("RK N_WEBHOLD" ,CHDFN,CHB FN,0)=CHBP AYID_CHBMI D_CHBSID_C HBREL_CHBD OB_CHBLNAM _CHBFNAM_C HBMNAM_CHB PNAM_CHBSN AM_CHBSEX_ CHBSTUD_CH BHAND_CHBD ECDT_CHBEL DT1_CHBELD T2_CHBPLCD _CHBPLDS
  144                   S ^CH MZHOLD("RK N_WEBHOLD" ,CHDFN,CHB FN,1)=CHBG PCD_CHBGPD S_CHBSTAT_ CHBADR1_CH BADR2_CHRC TY_CHBRSTE _CHBRZIP_C HBCNTY_CHB DFIL1_"L"
  145                   ;
  146                   S CHB ELDX1=0
  147   GETELG   I  '$D(^CHMZ HOLD("RKN_ WELIG",$J, "WEB_ELIGD TES",CHDFN ,CHBFN)) Q
  148                   S CHB ELDX1=$O(^ CHMZHOLD(" RKN_WELIG" ,$J,"WEB_E LIGDTES",C HDFN,CHBFN ,CHBELDX1) )
  149                   S CHB ELDX2=0
  150                   S CHB ELDX2=$O(^ CHMZHOLD(" RKN_WELIG" ,$J,"WEB_E LIGDTES",C HDFN,CHBFN ,CHBELDX1, CHBELDX2))
  151                   S CHR WCT1=CHRWC T1+1
  152                   S CHB RWCT=CHRWC T1
  153                   S CHM AXL=10,CHN UM=CHBRWCT  D STRPIT  D PADZROS  S CHBRWCT= CHX4
  154                   ;
  155   SENTFIL  ; FIRST RECO RD PART 1- 287 (287 D IGITS), SE COND RECOR D PART 288 -700 (413  DIGITS)
  156                   S ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_UPDT",CH DFN,CHBFN, CHRWCT1,0) =CHBDRCID_ CHBRWCT_CH BPAYID_CHB MID_CHBSID _CHBREL_CH BDOB_CHBLN AM_CHBFNAM _CHBMNAM_C HBPNAM_CHB SNAM_CHBSE X_CHBSTUD_ CHBHAND_CH BDECDT_CHB ELDX1_CHBE LDX2_CHBPL CD_CHBPLDS
  157                   S ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_UPDT",CH DFN,CHBFN, CHRWCT1,1) =CHBGPCD_C HBGPDS_CHB STAT_CHBAD R1_CHBADR2 _CHRCTY_CH BRSTE_CHBR ZIP_CHBCNT Y_CHBDFIL1 _"L"
  158                   K ^CH MZHOLD("RK N_WELIG",$ J,"WEB_ELI GDTES",CHD FN,CHBFN,C HBELDX1,CH BELDX2)
  159                   G GET ELG
  160                   Q
  161                   ;
  162   EMPTYMM S  CHNB=2
  163                   S ZML (CHNB)="", CHNB=CHNB+ 1
  164                   S ZML (CHNB)="NO TICE: Prio r hold fil e missing  for the Ni ghtly WEB  Update!"
  165                   S XMD UZ=.5
  166                    S XMY(" PII                   ")=""
  167                    S XMY("
P II                   ")=""
  168                   S XMT EXT="ZML("
  169                   S XMS UB="WEB EL IG Up..No  Hold File. ."_FMDATE
  170                   D ^XM D
  171                   Q
  172                   ;
  173   VMSFILE S  IO="HAC_HF S$:[KERMIT .WEBMD]"_" WEBELIG.DA T"  ;LIVE
  174                   ;S $Z T="VMSERR^ CHMXWB08"
  175                   S (CH DFN,CHBFN) =0,CHRECT1 ="",CHRECT 2=""
  176                   S CHV MSFL="FILE : "_IO
  177                   ;;N -  NEW FILE   W -- WRIT E S -- STR EAM FORMAT
  178                   I '$$ OPENFIWR^C HTFLIB9(.I O,"IO") G  VMSERR^CHM XWB08      ;;DEF01655 4 -- New e xtrinsic f unction fo r open --  01/22/2014
  179                   U IO
  180                   ;
  181   HEADER   W  CHBHRCID_ CHBCDTE_CH BCTIME_CHB PAYID_CHBS BNM_CHBRCN M_CHBLOADT _CHBTRACE_ CHBVERCD_C HBRELCD_CH BHFIL1,!," ~",CHBHFIL 2,"X",!,"~ ",!  ;this  command w rites the  header inf ormation 
  182                   ;
  183                   D GET TMP
  184                   D CLO SEF^CHTFLI B9(IO,"IO" )             ;;DEF01 6554
  185                   Q
  186                   ;
  187   GETTMP   S  CHDFN=$O( ^CHMZHOLD( "RKN_WELIG ",$J,"WEB_ NTLY_UPDT" ,CHDFN)) G :'CHDFN WR CNT
  188                   S CHB FN=0
  189                   K SEN TFLAG
  190                   ;
  191   GETTMP1 S  CHBFN=$O(^ CHMZHOLD(" RKN_WELIG" ,$J,"WEB_N TLY_UPDT", CHDFN,CHBF N)) G:'CHB FN GETTMP
  192                   S CHR WCT1=0
  193                   S CHR WCT1=$O(^C HMZHOLD("R KN_WELIG", $J,"WEB_NT LY_UPDT",C HDFN,CHBFN ,CHRWCT1))
  194                   S CHR ECT1=^CHMZ HOLD("RKN_ WELIG",$J, "WEB_NTLY_ UPDT",CHDF N,CHBFN,CH RWCT1,0)
  195                   S CHR ECT2=^CHMZ HOLD("RKN_ WELIG",$J, "WEB_NTLY_ UPDT",CHDF N,CHBFN,CH RWCT1,1)
  196                   K ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_UPDT",CH DFN,CHBFN, CHRWCT1,0)
  197                   K ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_UPDT",CH DFN,CHBFN, CHRWCT1,1)
  198                   ;
  199   TOSORT   S  ^CHMZHOLD ("RKN_WELI G",$J,"WEB _NTLY_UPDT _SORT",CHR WCT1,0)=CH RECT1
  200                   S ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_UPDT_SOR T",CHRWCT1 ,1)=CHRECT 2
  201                   S CHB RCCNT=CHBR CCNT+1
  202                   S CHB FN=0
  203                   G GET TMP1
  204                   ;
  205   WRCNT      S CHRWCT1= 0
  206   SORTIT   S  CHRWCT1=$ O(^CHMZHOL D("RKN_WEL IG",$J,"WE B_NTLY_UPD T_SORT",CH RWCT1)) G: 'CHRWCT1 W RCNT2
  207                   S CHR CT1A=^CHMZ HOLD("RKN_ WELIG",$J, "WEB_NTLY_ UPDT_SORT" ,CHRWCT1,0 )
  208                   S CHR CT2A=^CHMZ HOLD("RKN_ WELIG",$J, "WEB_NTLY_ UPDT_SORT" ,CHRWCT1,1 )
  209                   K ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_UPDT_SOR T",CHRWCT1 )
  210                   W CHR CT1A,!,"~" ,CHRCT2A,!   ;this is  the write  command t hat writes  all the d etail info rmation
  211                   G SOR TIT
  212                   ;
  213   WRCNT2   D  NOW^%DTC  S CHDT=$E( %,1,7)
  214                   I $E( CHDT,1,1)= "1" S CEND TE="18"
  215                   I $E( CHDT,1,1)= "2" S CEND TE="19"
  216                   I $E( CHDT,1,1)= "3" S CEND TE="20"
  217                   S CHM AXL=7,CHNU M=CHBRCCNT  D STRPIT  D PADZROS  S CHBRCCNT =CHX4
  218                   ;
  219   TRAILR   W  CHBTRCID_ CHBPAYID_C HBRCCNT_CH BTFIL1,!," ~",CHBTFIL 2,"X"  ;th is command  writes th e trailer  informatio
  220                   ;
  221                   Q
  222                   ;
  223   VMSERR  ;C  IO
  224                    D CL OSEF^CHTFL IB9(IO,"IO ")  
  225                    D ZW CLOSE^CHMS NUTL(IO,28 7,512)     ; JEH
  226                    K ^C HMZHOLD("R KN_WELIG")
  227                D NOW^%D TC
  228                   S FMD ATE=$E(%,1 ,7)
  229                   S ^CH MZHOLD("RK N_WELIG",$ J,"WEB_NTL Y_FCK",FMD ATE)=""
  230                   ;S X= $ZF(-1,"SU BMIT HAC_H FS$:[DSMMA NAG]CHV_DE LETE_WB_WN .COM /NOPR INTER/USER  =DSMMANAG /PARAM="_C HFMDTE)
  231                                ;
  232   ERRMM      S CHERRMSG =1,CHNB=2, ZML(CHNB)= "",ZML(CHN B)=CHVMSFL ,CHNB=CHNB +1,ZML(CHN B)="",CHNB =CHNB+1,ZM L(CHNB)="N OTICE: An  error has  occurred i n writing  the Nightl y ELIGIBIL ITY Update  for the", CHNB=CHNB+ 1,ZML(CHNB )="         WebMD fil e!"
  233                   S XMD UZ=.5
  234                    S XMY(" PII                   ")=""
  235                    S XMY("
P II                   ")=""
  236                   S XMT EXT="ZML(" ,XMSUB="WE B ELIG Up. .Error.."_ FMDATE
  237                   D ^XM D
  238                   Q
  239                   ;
  240   AUTOMM   S  CHNB=2,ZM L(CHNB)="" ,ZML(CHNB) =CHVMSFL_"   (Total R ecords = " _CHBRWCT_" )",CHNB=CH NB+1,ZML(C HNB)=""
  241                   S CHN B=CHNB+1,Z ML(CHNB)=" NOTICE: Su ccessful C REATION We bMD NIGHTL Y ELIGIBIL ITY file!"
  242                   S CHN B=CHNB+1,Z ML(CHNB)="   "
  243                   S CHN B=CHNB+1,Z ML(CHNB)=" Use UltraE dit to edi t file bef ore sendin g to WebMD !"
  244                   S XMD UZ=.5
  245                    S XMY(" PII                   ")=""
  246                    S XMY("
P II                   ")=""
  247                   S XMT EXT="ZML(" ,XMSUB="WE B ELIG Up. .Success.. "_FMDATE
  248                   D ^XM D
  249                   Q
  250                   ;
  251   END          K CHBADC 1,CHBADC2, CHBADC3,CH BADC4,CHBA DR1,CHBADR 2,CHCCTY,C HRCTY,CHBD ED1,CHBDED 2,CHBDOB,C HBELDT,CHB ELDT1,CHBE LDT2,CHBEL STA,CHBFN, CHBNAME
  252                   K CHB LNAM,CHBFN AM,CHBSEX, CHBOSDT,CH BOEDT,CHBO DES,CHBOPH ,CHBCPH,CH BRPH,CHBRE L,CHBSSN,C HBRWCT,CHR WCT1,CHBRC CNT,CHBCST E,CHBRSTE, CHBCZIP,CH BRZIP,CHDT
  253                   K CHL DT,CHDFN,C HDNAME,CHD FSSN,CHFCT CP1,CHFCTC P2,CHFDED1 ,CHFDED2,C HBOHIC1,CH BOHIC2,CHC SFLAG,CHFM DTE,CHFLDT ,CHIVL,CHJ VL,CHKVL,C HREC1,CHRE C2,CHREC3, CHREC4,CHR ECT1
  254                   K CHR ECT2,CHREC T3,CHVMSFL ,CHX1,CHX2 ,CHX3,CHX4 ,CHXAL,CHM AXL,CHNUM, CHERRMSG,C HDLNAM,CHD FNAM,CHLG1 ,CHLG2,DOL FLG,TDFNNA M,TDFNSSN, TBFNNAM,TB FNSSN
  255                   ;
  256                   K CHB CDTE,CHBCN TY,CHBCTIM E,CHBDECDT ,CHBFIL1,C HBDRCID,CH BELDA1,CHB ELDA2,CHBE LDX1,CHBEL DX2,CHBGPC D,CHBGPDS, CHBHAND,CH BHFIL1,CHB HFIL2
  257                   K CHB HRCID,CHBL OADT,CHBMA R,CHBMID,C HBMNAM,CHB NSTAT,CHBP AYID,CHBPL CD,CHBPLDS ,CHBPNAM,C HBRCNM,CHB RELCD,CHBS BNM,CHBSID ,CHBSNAM,C HBSTAT,CHB STUD,CHBTF IL1,CHBTFI L2
  258                   K CHB TRACE,CHBT RCID,CHBVE RCD,CHDRT, CHESTS,CHM XST,CHNB,C HNUM2,CHRC T1A,CHRCT2 A,NWGLOB,T MPCOUNT,CH BDFIL1,CHA R,CENDTE
  259                   K ^CH MZHOLD("RK N_WELIG"), ^CHMZHOLD( "RKN_WEBHO LD")
  260                   ;
  261                   K FMD ATE,FMPDAT E,CHFILE,C HFTPTIM,CH FTPWT,QFLA G,XMDUN,XM DUZ,ZML,IO
  262                   Q
  263                   ;
  264                   ;
  265   STRPIT   S  CHNUM2=""
  266                   F X=1 :1:$L(CHNU M) D
  267                   .S CH AR=$E(CHNU M,X) I CHA R?1N S CHN UM2=CHNUM2 _CHAR
  268                   S CHX 4=CHNUM2
  269                   Q
  270   STRPDL   I  $E(CHNUM, 1,1)=0 D   G STRPIT                     ;st rip leadin g 0's
  271                   .S $E (CHNUM,1,1 )=""
  272                   I $E( CHNUM,$F(C HNUM,"."), $F(CHNUM," .")+1)=""  D  ;Dec on ly
  273                   .S CH NUM=CHNUM_ "00"
  274                   S CHX 1=$L(CHNUM )
  275                   I '$F (CHNUM,"." ) D  Q                              ;No Dec
  276                   .S CH X4=CHNUM
  277                   .I $D (DOLFLG) S  CHX4=CHNU M_"00"
  278                   .S CH X4=$E(CHX4 ,1,CHMAXL)
  279                   .K DO LFLG
  280                   S CHX 2=$F(CHNUM ,"."),CHX3 =CHX2-2
  281                   S CHX 4=$E(CHNUM ,1,CHX3)_$ E(CHNUM,CH X2,CHX2+1)
  282                   I CHX 1=CHX2 S C HX4=CHX4_" 0"
  283   STRPPH   S  CHLG1=$L( CHNUM)
  284                   I ($E (CHNUM,1,1 )=0)!($E(C HNUM,1,1)= " ")!($E(C HNUM,1,1)= "(") D  G  STRPPH
  285                   .S $E (CHNUM,1,1 )=""
  286                   I $F( CHNUM,")")  D  G STRP PH
  287                   .S CH LG2=($F(CH NUM,")")-1 )
  288                   .S CH NUM=$E(CHN UM,1,CHLG2 -1)_$E(CHN UM,CHLG2+1 ,CHLG1)
  289                   I $F( CHNUM," ")  D  G STRP PH
  290                   .S CH LG2=($F(CH NUM," ")-1 )
  291                   .S CH NUM=$E(CHN UM,1,CHLG2 -1)_$E(CHN UM,CHLG2+1 ,CHLG1)
  292                   I $F( CHNUM,"-")  D  G STRP PH
  293                   .S CH LG2=($F(CH NUM,"-")-1 )
  294                   .S CH NUM=$E(CHN UM,1,CHLG2 -1)_$E(CHN UM,CHLG2+1 ,CHLG1)
  295                   Q
  296   PADZROS F  I=1:1:(CHM AXL-$L(CHX 4)) S CHX4 ="0"_CHX4
  297                   S CHX 4=$RE($E($ RE(CHX4),1 ,CHMAXL))
  298                   Q
  299   PADBLKS F  I=1:1:(CHM AXL-$L(CHX AL)) S CHX AL=CHXAL_"  "
  300                   S CHX AL=$E(CHXA L,1,CHMAXL )
  301                   Q
  302   PADRZRO F  I=1:1:(CHM AXL-$L(CHX 4)) S CHX4 =CHX4_"0"
  303                   S CHX 4=$RE($E($ RE(CHX4),1 ,CHMAXL))
  304                   Q
  305