23. EPMO Open Source Coordination Office Redaction File Detail Report

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

23.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHCMLRPT.m Mon Nov 5 16:43:32 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHCMLRPT.m Tue Nov 6 22:06:22 2018 UTC

23.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 10 1246
Changed 9 22
Inserted 0 0
Removed 0 0

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

23.4 Active regular expressions

No regular expressions were active.

23.5 Comparison detail

  1   CHCMLRPT ; HAC/SKD -  CML REPORT  - 2-12-08
  2    ;;1.0;CHA MPVA SYSTE M;;JULY 4,  1990;Buil d 1
  3    ;NEW ROUT INE per DE V000276-02 ,DEV007033 : Benie Ma iling List
  4    ;Last mod ified by S KD, 4-24-0 9/DEV00703 3, 5-29-09 /DEV002408
  5    ;TLH 09/2 2/09 DEV00 7959 CORRE CTION FOR  BENES THAT  WERE INEL IGIBLE ON  MAILING LI ST 
  6    ;TLH 09/2 9/09 DEV00 7520 CORRE CTION FOR  ** WITHIN  REMIT TO A DDRESS/PHY SICAL ADDR ESS
  7    ;YJK 02/2 5/10 DEV00 9056-02 SK IP "ELIGIB LE" STATUS  CHECK FOR  "SB" AND  "CWVV"
  8    ;SBB 11/2 5/13 DEF01 6554 Modif ied Writin g to a fil e as per V HA standar d.
  9    ;                          Conv ersion fro m DECNET t o FTP
  10    ;SBB 07/3 0/15 DEF01 6554 Addin g changes  for DECNET
  11    ;
  12    ;Bene mai ling list
  13   BENE(Z1,Z2 ,Z3,Z4,Z5, Z6,Z7,Z8,Z 9,Z10,Z11, Z12) 
  14    ; CHCML.C SP call wi th Z1(CHPR OG),Z2(CHU NIQ),Z3(CH ALLMAIL),Z 4(CHCTY),Z 5(CHST),Z6 (DUZ),Z7(C HBENE),Z8( CHSBIDDT), Z9(CHZFG), Z10(CHDOB) ,Z11(CHSEX ),Z12(CHOH I) argumen ts  ;SKD,D EV007033
  15    Q:Z7'=1    ;1=bene l ist, 0=pro v list
  16    I Z1="" S  Z1="CHAMP VA"
  17    NEW CHPRO G,CHUNIQ,C HALLMAIL,C HCTY,CHST, DUZ,CHBENE ,CHSBIDDT, CHZIPFG,CH DOB,CHSEX, CHOHI       ;SKD,DEV0 07033
  18    S CHPROG= Z1,CHUNIQ= Z2,CHALLMA IL=Z3,CHCT Y=$$UPPER^ CHTFLIB(Z4 ),CHST=Z5, DUZ=Z6,CHB ENE=Z7,CHS BIDDT=Z8,C HZIPFG=Z9, CHDOB=Z10, CHSEX=Z11, CHOHI=Z12    ;SKD,DEV 007033,DEV 002408
  19   BQUE ;S IO P="Q",%ZIS ="Q" W !!  D ^%ZIS G: POP QEND
  20    S CHFIO=" "
  21    S ZTDTH=$ H
  22    S ZTRTN=" BENELIST^C HCMLRPT",Z TDESC="CML  Beneficia ry Mailing  List"
  23    S ZTIO="" ,ZTSAVE("C HFIO")="", ZTSAVE("CH PROG")="", ZTSAVE("CH UNIQ")="", ZTSAVE("CH ALLMAIL")= "",ZTSAVE( "CHCTY")=" ",ZTSAVE(" CHST")="", ZTSAVE("DU Z")=""
  24    S ZTSAVE( "CHFORNFG" )="",ZTSAV E("CHBPFG" )="",ZTSAV E("CHDFN") ="",ZTSAVE ("CHBFN")= "",ZTSAVE( "CHSBIDDT" )="",ZTSAV E("CH*")=" "
  25    S ZTSAVE( "^CHMZHOLD (""CML""," )="",ZTSAV E("CHDOB") ="",ZTSAVE ("CHSEX")= "",ZTSAVE( "CHOHI")=" "
  26    D ^%ZTLOA D
  27    Q
  28    ;
  29   BENELIST ;
  30    K ^CHMZHO LD("CML",D UZ),^CHMZH OLD("CML", "FINAL",DU Z),^CHMZHO LD("CML"," DUPADDR",D UZ),^CHMZH OLD("CML", "ALLMAILIN G",DUZ),^C HMZHOLD("C ML","ONEMA ILING",DUZ )
  31    S CHBPFG= "BENE"
  32    ;SBB; DEF 016554-11/ 25/13 - us ing POP fo r OPEN^%ZI SH.
  33    N POP
  34    D INIT
  35    I 'CHUNIQ  D ALLELIG   ;get all  elig bene s
  36    E  D UNQB ENE          ;filed a  claim wit hin last 1 2 or 18 mo nths (CHAM PVA)
  37    D BENECT
  38    D BFILEIO
  39    D KILLVAR
  40    Q
  41    ; 
  42   ALLELIG 
  43    I CHPROG= "CHAMPVA"  D  Q  ;get  all CHAMP VA EA bene s
  44    .S CHDFN= 0 F  S CHD FN=$O(^AHC HVA(CHDFN) ) Q:'CHDFN   D  
  45    ..S CHBFN =0 F  S CH BFN=$O(^AH CHVA(CHDFN ,100,CHBFN )) Q:'CHBF N  D  
  46    ...Q:$D(^ AHCHVA("SB ",CHDFN,CH BFN))   ;S B bene
  47    ...Q:$D(^ AHCHVA("FM P",CHDFN))   ;FMP ben e
  48    ...Q:$D(^ AHCHVA("WV ",CHDFN,CH BFN))   ;C WVV bene
  49    ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG
  50    ...D GETB ADDR
  51    I CHPROG= "SB" D  Q   
  52    .S CHDFN= 0 F  S CHD FN=$O(^AHC HVA("SB",C HDFN)) Q:' CHDFN  D  
  53    ..S CHBFN =0 F  S CH BFN=$O(^AH CHVA("SB", CHDFN,CHBF N)) Q:'CHB FN  D  
  54    ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG
  55    ...D GETB ADDR
  56    I CHPROG= "CWVV" D   Q
  57    .S CHDFN= 0 F  S CHD FN=$O(^AHC HVA("WV",C HDFN)) Q:' CHDFN  D  
  58    ..S CHBFN =0 F  S CH BFN=$O(^AH CHVA("WV", CHDFN,CHBF N)) Q:'CHB FN  D  
  59    ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG
  60    ...D GETB ADDR
  61    I CHPROG= "FMP" D  Q
  62    .S CHDFN= 0 F  S CHD FN=$O(^AHC HVA("FMP", CHDFN)) Q: 'CHDFN  D   
  63    ..I '$D(^ AHCHVA(CHD FN,0)) Q
  64    ..S CHNM= "",CHNM=$P ($G(^AHCHV A(CHDFN,0) ),"^",1) Q :CHNM=""
  65    ..Q:CHNM[ "(SN)"
  66    ..Q:$D(^A HADIC(5548 04.07,"B", CHNM,CHDFN ))
  67    ..D GFMPA DDR
  68    I CHPROG= "CMOP" D   Q  
  69    .S CHDFN= 0 F  S CHD FN=$O(^AHC HVA(CHDFN) ) Q:'CHDFN   D  
  70    ..S CHBFN =0 F  S CH BFN=$O(^AH CHVA(CHDFN ,100,CHBFN )) Q:'CHBF N  D  
  71    ...S CHQF LAG=0 D QU ITCHK(CHDF N,CHBFN) Q :CHQFLAG
  72    ...S CHMD FNI=0,CHMD FNI=$O(^CH MDFN("B",C HDFN,CHMDF NI)) Q:'CH MDFNI
  73    ...S CHMD FNJ=0,CHMD FNJ=$O(^CH MDFN(CHMDF NI,100,"B" ,CHBFN,CHM DFNJ)) Q:' CHMDFNJ
  74    ...Q:'$D( ^CHMDFN(CH MDFNI,100, CHMDFNJ,5) )
  75    ...S CHMD FNK="A" S  CHMDFNK=$O (^CHMDFN(C HMDFNI,100 ,CHMDFNJ,5 ,CHMDFNK), -1) Q:'CHM DFNK  D  
  76    ....S CHC MOPEA=$P($ G(^CHMDFN( CHMDFNI,10 0,CHMDFNJ, 5,CHMDFNK, 0)),"^",3)
  77    ....Q:CHC MOPEA'=1   ;NOT CMOP  EA
  78    ....D GET BADDR
  79    Q
  80    ;
  81   UNQBENE2 ;
  82    Q:'$G(CHY R)
  83    I CHPROG= "CHAMPVA"! (CHPROG="C MOP") Q:'$ G(CHJUL548 )
  84    E  Q:'$G( CHJUL365)   
  85    S CHPDI=$ S(CHPROG=" CHAMPVA":C HYR_$E(CHJ UL548,3,5) _"00000000 ",CHPROG=" CMOP":CHYR _$E(CHJUL5 48,3,5)_"0 0000000",1 :CHYR_$E(C HJUL365,3, 5)_"000000 00")
  86    ; 
  87    F  S CHPD I=$O(^CHMP AY("C",CHP DI)) Q:'CH PDI  D
  88    .S CHCLI= 0 F  S CHC LI=$O(^CHM PAY("C",CH PDI,CHCLI) ) Q:'CHCLI   D
  89    ..Q:$P($G (^CHMPAY(C HCLI,0))," ^",2)=10    ;skip if  a deleted  claim
  90    ..S CHPRG =$P($G(^CH MPAY(CHCLI ,0)),"^",2 7) Q:'CHPR G
  91    ..I CHPRO G="CHAMPVA " Q:CHPRG' =1&(CHPRG' =2)
  92    ..I CHPRO G="FMP" Q: CHPRG'=3
  93    ..I CHPRO G="SB" Q:C HPRG'=6
  94    ..I CHPRO G="CWVV" Q :CHPRG'=7
  95    ..I CHPRO G="CMOP" Q :'$D(^CHMP AY(CHCLI," ZEMC","CMO P"))
  96    ..S CHDFN =$P($G(^CH MPAY(CHCLI ,0)),"^",2 1)
  97    ..S CHBFN =$P($G(^CH MPAY(CHCLI ,0)),"^",2 2)
  98    ..D GETBA DDR  
  99    Q
  100    ; 
  101   UNQBENE ;
  102    I CHPROG= "CHAMPVA"! (CHPROG="C MOP") Q:'$ G(CH548)
  103    E  Q:'$G( CH365)
  104    I CHPROG= "CHAMPVA"! (CHPROG="C MOP") S CH DONEDT=CH5 48
  105    E  S CHDO NEDT=CH365
  106    I CHPROG= "FMP" D UN IQFMP Q
  107    S CHCLI=" A",CHDONE= 0
  108    F  S CHCL I=$O(^CHMP AY(CHCLI), -1) Q:'CHC LI  Q:CHDO NE  D  
  109    .Q:'$D(^C HMPAY(CHCL I,0))
  110    .Q:$P($G( ^CHMPAY(CH CLI,0)),"^ ",2)=10    ;skip if a  deleted c laim
  111    .S CHCRED T="",CHCRE DT=$P($G(^ CHMPAY(CHC LI,0)),"^" ,25) Q:CHC REDT=""
  112    .I CHCRED T<CHDONEDT  S CHDONE= 1
  113    .S CHPRG= $P($G(^CHM PAY(CHCLI, 0)),"^",27 ) Q:'CHPRG
  114    .I CHPROG ="CHAMPVA"  Q:CHPRG'= 1&(CHPRG'= 2)
  115    .;I CHPRO G="FMP" Q: CHPRG'=3
  116    .I CHPROG ="SB" Q:CH PRG'=6
  117    .I CHPROG ="CWVV" Q: CHPRG'=7
  118    .I CHPROG ="CMOP" Q: '$D(^CHMPA Y(CHCLI,"Z EMC","CMOP "))
  119    .S CHDFN= $P($G(^CHM PAY(CHCLI, 0)),"^",21 )
  120    .S CHBFN= $P($G(^CHM PAY(CHCLI, 0)),"^",22 )
  121    .D GETBAD DR  
  122    Q
  123    ; 
  124   GETBADDR ; bene remit -to addres s, domesti c and fore ign
  125    S (CHNAME ,CHADDR1,C HADDR2,CHA DDR3,CHCIT Y,CHSTI,CH STATE,CHZI P9,CHZIP5, CHFORNFG)= ""
  126    S CHNAME= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 0)),"^",1)  Q:CHNAME= ""
  127    ;S CHSTAT =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,0)),"^",5 ) Q:CHSTAT '="EA"  ;T LH 9/22/09 ;YJK 2/25/ 2010 DEV00 9056-02
  128    S CHSTAT= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 0)),"^",5)    ;YJK 2/ 25/2010 DE V009056-02
  129    Q:CHSTAT' ="EA"&(CHP ROG'="SB") &(CHPROG'= "CWVV")       ;YJK 2/ 25/2010 DE V009056-02
  130    Q:CHNAME[ "(SN)"      ;don't in clude SN b ene
  131    ;adding d eleted ben e/sponsor  check to e nsure that  persons a re not del eted prior  to creati ng mailing  list
  132    S CHSNAME =$P(^AHCHV A(CHDFN,0) ,"^",1)  ; TLH DEV007 959
  133    S DELFLG= $$DELCHK^C HTFLIB(CHS NAME,CHDFN ,CHNAME,CH BFN) Q:DEL FLG=1   ;T LH DEV0079 59    
  134    ;S CHSNAM E="",CHNAM E=$P(^AHCH VA(CHDFN,1 00,CHBFN,0 ),"^",1)           ;Y JK 2/25/20 10 DEV0090 56-02 TYPO  correctio n
  135    S CHNAME= "",CHNAME= $P(^AHCHVA (CHDFN,100 ,CHBFN,0), "^",1)             ;Y JK 2/25/20 10 DEV0090 56-02
  136    S DELFLG= $$DELCHK^C HTFLIB(CHS NAME,CHDFN ,CHNAME,CH BFN) Q:DEL FLG=1   ;T LH DEV0079 59
  137    I CHPROG= "CHAMPVA"  Q:$P($G(^A HCHVA(CHDF N,100,CHBF N,1)),"^", 10)'=1  ;b ad address
  138    I CHPROG= "CMOP" Q:$ P($G(^AHCH VA(CHDFN,1 00,CHBFN,1 )),"^",10) '=1  ;bad  address
  139    Q:$P($G(^ AHCHVA(CHD FN,100,CHB FN,0)),"^" ,6)'=""  ; deceased   ;TLH chang ed to look  at 0 node  piece 6 f or DOD 
  140    I CHPROG= "FMP" Q:$P ($G(^AHCHV A(CHDFN,6) ),"^",14)= ""  ;no ac ceptance l tr sent
  141    S CHNAME= $$CNVTNAME (CHNAME)
  142    S CHADDR1 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",1 ) Q:CHADDR 1=""    
  143    S CHADDR2 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",2 )  
  144    S CHADDR3 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",1 2)   
  145    S CHCITY= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 1)),"^",3)  Q:CHCITY= ""
  146    I CHCTY'= "" Q:CHCIT Y'=CHCTY
  147    S CHFORNF G=$S($P($G (^AHCHVA(C HDFN,100,C HBFN,1))," ^",11)=1:" F",1:"D")    ;D-Domes tic F-Fore ign
  148    S CHQFG=0
  149    I CHFORNF G="D" D  Q :$G(CHQFG)
  150    .S CHSTI= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 1)),"^",4)  I 'CHSTI  S CHQFG=1  Q
  151    .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",2 ) I CHSTAT E="" S CHQ FG=1 Q
  152    .I CHST'= "" I CHSTA TE'=CHST S  CHQFG=1 Q
  153    .S CHZIP9 =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,1)),"^",5 ) I 'CHZIP 9 S CHQFG= 1 Q
  154    .S CHZIP5 =$E(CHZIP9 ,1,5) I 'C HZIP5 S CH QFG=1 Q
  155    E  D  Q:$ G(CHQFG)
  156    .S CHSTI= $P($G(^AHC HVA(CHDFN, 100,CHBFN, 1)),"^",13 ) I 'CHSTI  S CHQFG=1  Q   
  157    .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",1 ) I CHSTAT E="" S CHQ FG=1 Q   ; Country 
  158    .S (CHZIP 5,CHZIP9)= "1"
  159    I $G(CHZI PFG) Q:'$D (^CHMZHOLD ("CML",DUZ ,"CHZIPS", CHZIP5))     ;SKD,5-2 9,09,DEV00 2408
  160    I CHADDR2 ="" S CHAD DR2="NOADD R2"
  161    I CHADDR3 ="" S CHAD DR3="NOADD R3"
  162    S CHOHITO C=0
  163    I '$G(CHO HI) S ^CHM ZHOLD("CML ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHADDR3,CH DFN,CHBFN) =$G(CHNAME )_"^"_$G(C HZIP9)     ;SKD,5-29, 09,DEV0024 08 
  164    E  D  
  165    .I $G(CHO HI)=1 D  
  166    ..S ^CHMZ HOLD("CML" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HADDR3,CHD FN,CHBFN)= $G(CHNAME) _"^"_$G(CH ZIP9)    ; SKD,5-29,0 9,DEV00240 8      ;if  OHI
  167    .I $G(CHO HI)=2 D  
  168    ..I CHOHI TOC S ^CHM ZHOLD("CML ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHADDR3,CH DFN,CHBFN) =$G(CHNAME )_"^"_$G(C HZIP9)     ;SKD,5-29, 09,DEV0024 08      ;i f OHI
  169    .I $G(CHO HI)=3 D
  170    ..I 'CHOH ITOC S ^CH MZHOLD("CM L",DUZ,CHB PFG,CHFORN FG,CHZIP5, CHSTATE,CH CITY,CHADD R1,CHADDR2 ,CHADDR3,C HDFN,CHBFN )=$G(CHNAM E)_"^"_$G( CHZIP9)    ;SKD,5-29, 09,DEV0024 08      ;i f no OHI
  171    ;I CHPROG ="SB",$G(C HSBIDDT)=1  D       ; SKD,DEV007 033
  172    ;.S CHIDD T="",CHIDD T=$$CONVDT 5($P($G(^A HCHVA(CHDF N,100,CHBF N,10)),"^" ,3))
  173    ;.S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",3)= $G(CHIDDT)
  174    ;I $G(CHD OB) D        ;SKD,DEV 002408,5-2 9-09
  175    ;.S CHBDO B="",CHBDO B=$$CONVDT 5($P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 3))
  176    ;.S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",4)= $G(CHBDOB)
  177    ;I $G(CHS EX) D        ;SKD,DEV 002408,5-2 9-09
  178    ;.S CHBSE X="",CHBSE X=$P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 2)
  179    ;.S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",5)= $G(CHBSEX)
  180    Q
  181    ;
  182   UNIQFMP ;
  183    Q:CHPROG' ="FMP"
  184    S CHCLI=" A",CHDONE= 0
  185    F  S CHCL I=$O(^CHFM PCL(CHCLI) ,-1) Q:'CH CLI  Q:CHD ONE  D  
  186    .Q:'$D(^C HFMPCL(CHC LI,0))
  187    .S CHCLJ= 0
  188    .F  S CHC LJ=$O(^CHF MPCL(CHCLI ,100,CHCLJ )) Q:'CHCL J  D
  189    ..Q:'$D(^ CHFMPCL(CH CLI,100,CH CLJ,0))
  190    ..S CHCRE DT="",CHCR EDT=$P($G( ^CHFMPCL(C HCLI,100,C HCLJ,0))," ^",7) Q:CH CREDT=""
  191    ..I CHCRE DT<CHDONED T S CHDONE =1
  192    ..S CHDFN =$P($G(^CH FMPCL(CHCL I,0)),"^", 2)
  193    ..D GFMPA DDR
  194    Q
  195    ;
  196   GFMPADDR ; FMP remit- to address , domestic  and forei gn
  197    S (CHNAME ,CHADDR1,C HADDR2,CHA DDR3,CHCIT Y,CHSTI,CH STATE,CHZI P9,CHZIP5, CHFORNFG)= ""
  198    S CHNAME= $P($G(^AHC HVA(CHDFN, 0)),"^",1)  Q:CHNAME= ""
  199    Q:CHNAME[ "(SN)"      ;don't in clude SN b ene
  200    Q:$P($G(^ AHCHVA(CHD FN,1)),"^" ,10)'=1  ; bad addres s
  201    Q:$P($G(^ AHCHVA(CHD FN,0)),"^" ,4)'=""  ; deceased
  202    Q:$P($G(^ AHCHVA(CHD FN,6)),"^" ,14)=""  ; no accepta nce ltr se nt
  203    S CHNAME= $$CNVTNAME (CHNAME)
  204    S CHADDR1 =$P($G(^AH CHVA(CHDFN ,1)),"^",1 ) Q:CHADDR 1=""    
  205    S CHADDR2 =$P($G(^AH CHVA(CHDFN ,1)),"^",2 )  
  206    S CHADDR3 =$P($G(^AH CHVA(CHDFN ,1)),"^",1 2)   
  207    S CHCITY= $P($G(^AHC HVA(CHDFN, 1)),"^",3)  Q:CHCITY= ""
  208    I CHCTY'= "" Q:CHCIT Y'=CHCTY
  209    S CHFORNF G=$S($P($G (^AHCHVA(C HDFN,1))," ^",11)=1:" F",1:"D")    ;D-Domes tic F-Fore ign
  210    S CHQFG=0
  211    I CHFORNF G="D" D  Q :$G(CHQFG)
  212    .S CHSTI= $P($G(^AHC HVA(CHDFN, 1)),"^",4)  I 'CHSTI  S CHQFG=1  Q
  213    .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",2 ) I CHSTAT E="" S CHQ FG=1 Q
  214    .I CHST'= "" I CHSTA TE'=CHST S  CHQFG=1 Q
  215    .S CHZIP9 =$P($G(^AH CHVA(CHDFN ,1)),"^",5 ) I 'CHZIP 9 S CHQFG= 1 Q
  216    .S CHZIP5 =$E(CHZIP9 ,1,5) I 'C HZIP5 S CH QFG=1 Q
  217    E  D  Q:$ G(CHQFG)
  218    .S CHSTI= $P($G(^AHC HVA(CHDFN, 1)),"^",13 ) I 'CHSTI  S CHQFG=1  Q   
  219    .S CHSTAT E=$P($G(^D IC(5,CHSTI ,0)),"^",1 ) I CHSTAT E="" S CHQ FG=1 Q   ; Country 
  220    .S (CHZIP 5,CHZIP9)= "1"
  221    I CHADDR2 ="" S CHAD DR2="NOADD R2"
  222    I CHADDR3 ="" S CHAD DR3="NOADD R3"
  223    S CHBFN=1
  224    S ^CHMZHO LD("CML",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHA DDR3,CHDFN ,CHBFN)=$G (CHNAME)_" ^"_$G(CHZI P9)
  225    Q
  226    ;
  227   BENECT ;
  228    F CHFORNF G="D","F"  D  
  229    .S CHZIP5 =0 F  S CH ZIP5=$O(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 )) Q:'CHZI P5  D
  230    ..S CHSTA TE="" F  S  CHSTATE=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE)) Q:CHS TATE=""  D   
  231    ...S CHCI TY="" F  S  CHCITY=$O (^CHMZHOLD ("CML",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY))  Q:CHCITY= ""  D
  232    ....S CHA DDR1="" F   S CHADDR1 =$O(^CHMZH OLD("CML", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1) ) Q:CHADDR 1=""  D  
  233    .....S CH ADDR2="" S  CHADDR2=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)) Q: CHADDR2=""   D  
  234    ......S C HADDR3=""  F  S CHADD R3=$O(^CHM ZHOLD("CML ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHADDR3))  Q:CHADDR3= ""  D  
  235    .......S  CHDFN=0 F   S CHDFN=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHAD DR3,CHDFN) ) Q:'CHDFN   D  
  236    ........S  CHBFN=0 F   S CHBFN= $O(^CHMZHO LD("CML",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHA DDR3,CHDFN ,CHBFN)) Q :'CHBFN  D   
  237    ......... S CHNAME=" ",CHNAME=$ P(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHAD DR3,CHDFN, CHBFN),"^" ,1)
  238    ......... S CHZIP9=" ",CHZIP9=$ P(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHAD DR3,CHDFN, CHBFN),"^" ,2)
  239    ......... S ^CHMZHOL D("CML",DU Z,CHBPFG," CT","TOTCT ",CHFORNFG )=$G(^CHMZ HOLD("CML" ,DUZ,CHBPF G,"CT","TO TCT",CHFOR NFG))+1
  240    ......... I CHALLMAI L D  
  241    ......... .S ^CHMZHO LD("CML"," ALLMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2, CHDFN,CHBF N)=CHNAME_ "^"_CHZIP9 _"^"_CHADD R3 
  242    ......... .I $G(CHSB IDDT)=1 D     ;SKD,DE V007033 
  243    ......... ..S CHIDDT ="",CHIDDT =$$CONVDT5 ($P($G(^AH CHVA(CHDFN ,100,CHBFN ,10)),"^", 3))
  244    ......... .I $G(CHDO B) D        ;SKD,DEV0 02408,5-29 -09
  245    ......... ..S CHBDOB ="",CHBDOB =$$CONVDT5 ($P($G(^AH CHVA(CHDFN ,100,CHBFN ,0)),"^",3 ))
  246    ......... ..S $P(^CH MZHOLD("CM L",DUZ,CHB PFG,CHFORN FG,CHZIP5, CHSTATE,CH CITY,CHADD R1,CHADDR2 ,CHADDR3,C HDFN,CHBFN ),"^",4)=$ G(CHBDOB)
  247    ......... .I $G(CHSE X) D        ;SKD,DEV0 02408,5-29 -09
  248    ......... ..S CHBSEX ="",CHBSEX =$P($G(^AH CHVA(CHDFN ,100,CHBFN ,0)),"^",2 )
  249    ......... ..S ^CHMZH OLD("CML", "ALLMAILIN G",DUZ,CHB PFG,CHFORN FG,CHZIP5, CHSTATE,CH CITY,CHADD R1,CHADDR2 ,CHDFN,CHB FN)=CHNAME _"^"_CHZIP 9_"^"_CHAD DR3_"^"_$G (CHIDDT)_" ^"_$G(CHBD OB)_"^"_$G (CHBSEX)  
  250    ......... E  S ^CHMZ HOLD("CML" ,"ONEMAILI NG",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2)=CHNAME_ "^"_CHZIP9    ;***
  251    ......... I '$D(^CHM ZHOLD("CML ","FINAL", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2))  D  
  252    ......... .S ^CHMZHO LD("CML",D UZ,CHBPFG, "CT","UNQC T",CHFORNF G)=$G(^CHM ZHOLD("CML ",DUZ,CHBP FG,"CT","U NQCT",CHFO RNFG))+1
  253    ......... .I CHALLMA IL D         ;SKD,DEV 007033
  254    ......... ..I CHPROG ="SB",$G(C HSBIDDT)=1  S CHIDDT= "",CHIDDT= $$CONVDT5( $P($G(^AHC HVA(CHDFN, 100,CHBFN, 10)),"^",3 ))
  255    ......... ..I $G(CHD OB) D        ;SKD,DEV 002408,5-2 9-09
  256    ......... ...S CHBDO B="",CHBDO B=$$CONVDT 5($P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 3))
  257    ......... ...S $P(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 ,CHSTATE,C HCITY,CHAD DR1,CHADDR 2,CHADDR3, CHDFN,CHBF N),"^",4)= $G(CHBDOB)
  258    ......... ..I $G(CHS EX) D        ;SKD,DEV 002408,5-2 9-09
  259    ......... ...S CHBSE X="",CHBSE X=$P($G(^A HCHVA(CHDF N,100,CHBF N,0)),"^", 2)
  260    ......... ..I $G(CHO HI) D        ;SKD,DEV 002408,5-2 9-09
  261    ......... ...
  262    ......... ..S ^CHMZH OLD("CML", "FINAL",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHDF N,CHBFN)=C HNAME_"^"_ CHZIP9_"^" _CHADDR3_" ^"_$G(CHID DT)_"^"_$G (CHBDOB)_" ^"_$G(CHBS EX)
  263    ......... .E  S ^CHM ZHOLD("CML ","FINAL", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2)=C HNAME_"^"_ CHZIP9 
  264    ......... E  D  
  265    ......... .I 'CHALLM AIL D        ;SPLIT L ONG LINES  FOR MIGRAT ION CJM 20 170718
  266    ......... .. S CHTMP ="Attentio n "_$S(CHP ROG="SB":" Spina Bifi da",CHPROG ="CWVV":"C hildren of  Women Vie tnam Veter an",CHPROG ="FMP":"Fo reign Medi cal Progra m",CHPROG= "CMOP":"CM OP",1:"CHA MPVA")_" B eneficiari es"
  267    ......... .. S $P(^C HMZHOLD("C ML","FINAL ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2) ,"^",1)=CH TMP
  268    ......... .S ^CHMZHO LD("CML",D UZ,CHBPFG, "CT","DUPC T",CHFORNF G)=$G(^CHM ZHOLD("CML ",DUZ,CHBP FG,"CT","D UPCT",CHFO RNFG))+1
  269    ......... .S CHTMP=" Attention  "_$S(CHPRO G="SB":"Sp ina Bifida ",CHPROG=" CWVV":"Chi ldren of W omen Vietn am Veteran ",CHPROG=" FMP":"Fore ign Medica l Program" ,CHPROG="C MOP":"CMOP ",1:"CHAMP VA")_" Ben eficiaries "
  270    ......... .S ^CHMZHO LD("CML"," DUPADDR",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2)=CH TMP
  271    Q
  272    ;
  273   BFILEIO ;
  274    X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1)
  275    ;DEF01655 4 SBB 11/2 5/13  - Co nverting f rom DECNET  to FTP.
  276    ;S FILELO C="HACFS3" "
D NS       Welcome1!" "::e:[CML] "
  277    ;I UCI'=" HAC" S FIL ELOC="HACF S3""
D NS       Welcome1!" "::e:[CML] TEST_"
  278    S FILELOC ="HAC_HFS$ :[SCR.TEMP _FILES]"
  279    I UCI'="H AC" S FILE LOC="HAC_H FS$:[DSMMA NAG.CHAMPV A]TEST_"
  280    I CHALLMA IL=1 S CHF ILEBDOM=FI LELOC_DUZ_ "_CML_BENE _ALL_D.TXT ",CHFILEBF OR=FILELOC _DUZ_"_CML _BENE_ALL_ F.TXT"
  281    E  S CHFI LEBDOM=FIL ELOC_DUZ_" _CML_BENE_ ONE_D.TXT" ,CHFILEBFO R=FILELOC_ DUZ_"_CML_ BENE_ONE_F .TXT"
  282    ;DEF01655 4-11/25/13 -SBB use O PEN^%ZISH  to open fi le
  283    ;O CHFILE BDOM:"NWS" :5 Q:'$T 
  284    ;O CHFILE BFOR:"NWS" :5 Q:'$T
  285    ;SBB 07/3 0/15 DEF01 6554
  286    X "D $SYS TEM.Proces s.SetZEOF( 1)"
  287    I '$$OPEN FIWR^CHTFL IB9(.CHFIL EBDOM,"CHF ILEBDOM")  X "D $SYST EM.Process .SetZEOF(0 )" Q
  288    I '$$OPEN FIWR^CHTFL IB9(.CHFIL EBFOR,"CHF ILEBFOR")  X "D $SYST EM.Process .SetZEOF(0 )" Q
  289    D BSUMMAR Y
  290    D PRTBENE
  291    ;DEF01655 4-11/25/13 -SBB use C LOSE^%ZISH  to close  file
  292    ;C FILE,C HFILEBDOM, CHFILEBFOR
  293    D CLOSEF^ CHTFLIB9(F ILE,"FILE" )
  294    D CLOSEF^ CHTFLIB9(C HFILEBDOM, "CHFILEBDO M")
  295    D CLOSEF^ CHTFLIB9(C HFILEBFOR, "CHFILEBFO R")
  296    D CLOSEF^ CHTFLIB9(F IO,"FIO")
  297    ;SBB 07/3 0/15 DEF01 6554
  298    X "D $SYS TEM.Proces s.SetZEOF( 0)"
  299    D FTPFILE ^CHTFLIB9( CHFILEBDOM ," DNS     . DNS             ","/CML"," PUT")
  300    H 3
  301    D FTPFILE ^CHTFLIB9( CHFILEBFOR ," DNS     . DNS             ","/CML"," PUT")
  302    H 3
  303    D FTPFILE ^CHTFLIB9( FIO," DNS     . DNS             ","/FS3BIG ","PUT")
  304    Q
  305    ;
  306   BSUMMARY ;
  307    F CHFORNF G="D","F"  D  
  308    .S FILE=$ S(CHFORNFG ="D":CHFIL EBDOM,1:CH FILEBFOR)
  309    .D PRINTT OT
  310    Q
  311    ;
  312   PRTBENE ;
  313    F CHFORNF G="D","F"  D  
  314    .S FILE=$ S(CHFORNFG ="D":CHFIL EBDOM,1:CH FILEBFOR)
  315    .I CHALLM AIL D BALL MAIL
  316    .E  D ONE MAIL
  317    Q
  318    ;
  319   BALLMAIL ;
  320    S CHZIP5= 0 F  S CHZ IP5=$O(^CH MZHOLD("CM L","ALLMAI LING",DUZ, CHBPFG,CHF ORNFG,CHZI P5)) Q:'CH ZIP5  D
  321    .S CHSTAT E="" F  S  CHSTATE=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE)) Q:C HSTATE=""   D  
  322    ..S CHCIT Y="" F  S  CHCITY=$O( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY )) Q:CHCIT Y=""  D
  323    ...S CHAD DR1="" F   S CHADDR1= $O(^CHMZHO LD("CML"," ALLMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1)) Q:CHAD DR1=""  D   
  324    ....S CHA DDR2="" S  CHADDR2=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2))  Q:CHADDR2= ""  D  
  325    .....S CH DFN=0 F  S  CHDFN=$O( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHD FN)) Q:'CH DFN  D  
  326    ......S C HBFN=0 F   S CHBFN=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2,CH DFN,CHBFN) ) Q:'CHBFN   D  
  327    .......S  CHNAME="", CHNAME=$P( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHD FN,CHBFN), "^",1)
  328    .......S  CHZIP9="", CHZIP9=$P( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY ,CHADDR1,C HADDR2,CHD FN,CHBFN), "^",2)
  329    .......I  CHFORNFG=" F" S CHZIP 9=""
  330    .......S  CHADDR3="" ,CHADDR3=$ P(^CHMZHOL D("CML","A LLMAILING" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HDFN,CHBFN ),"^",3)
  331    .......I  CHPROG="SB ",$G(CHSBI DDT)=1 S C HIDDT="",C HIDDT=$$CO NVDT5($P($ G(^AHCHVA( CHDFN,100, CHBFN,10)) ,"^",3))
  332    .......I  $G(CHDOB)  D       ;S KD,DEV0024 08,5-29-09
  333    ........S  CHBDOB="" ,CHBDOB=$$ CONVDT5($P ($G(^AHCHV A(CHDFN,10 0,CHBFN,0) ),"^",3))
  334    ........S  $P(^CHMZH OLD("CML", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2,CH ADDR3,CHDF N,CHBFN)," ^",4)=$G(C HBDOB)
  335    .......I  $G(CHSEX)  D       ;S KD,DEV0024 08,5-29-09
  336    ........S  CHBSEX="" ,CHBSEX=$P ($G(^AHCHV A(CHDFN,10 0,CHBFN,0) ),"^",2)
  337    .......I  $G(CHOHI)  S CHOHDSP= $$GETOHI(C HDFN,CHBFN )
  338    .......U  FILE W !,C HNAME_T_CH ADDR1_T_$S (CHADDR2=" NOADDR2":" ",1:CHADDR 2)_T_$S(CH ADDR3="NOA DDR3":"",1 :CHADDR3)_ T_CHCITY_T _CHSTATE_T _T_$$CNVZI P9(CHZIP9) _T_$G(CHID DT)_T_$G(C HBDOB)_T_$ G(CHBSEX)_ T_$G(CHOHD SP)    ;SK D,DEV00703 3,DEV00240 8
  339    Q
  340    ;
  341   CNVZIP9(ZI P) ;
  342    Q $S($L(Z IP)>5:$E(Z IP,1,5)_"- "_$E(ZIP,6 ,9),1:ZIP)
  343    ;
  344   CNVTNAME(N 1) ;conver t name to  the last M I first fo rmat
  345    Q:N1=""
  346    S NM=N1
  347    S NML=$P( NM,",",1), NMF=$P($P( NM,",",2), " ",1),NMM =$P($P(NM, ",",2)," " ,2)
  348    ;I NMM'=" " S NMM=NM M_"."
  349    Q NMF_" " _$S(NMM'=" ":NMM_" ", 1:"")_NML
  350    ;
  351    ;*******p rovider ma iling list ********** ********** ********** ********
  352    ;
  353   PROV(Z3,Z4 ,Z5,Z6,Z7, Z9) ;CML.C SP call wi th Z3(CHAL LMAIL),Z4( CHCTY),Z5( CHST),Z6(D UZ),Z7(CHB ENE),Z9(CH ZFG) argum ents
  354    Q:Z7'=0    ;1=bene l ist, 0=pro v list
  355    Q:Z6=""    ;NO DUZ
  356    NEW CHALL MAIL,CHCTY ,CHST,CHBE NE,CHJUL36 5,CHYR,CHZ IPFG
  357    S CHALLMA IL=Z3,CHCT Y=$$UPPER^ CHTFLIB(Z4 ),CHST=Z5, DUZ=Z6,CHB ENE=Z7,CHZ IPFG=CHZFG
  358    ;
  359   VQUE ;S IO P="Q",%ZIS ="Q" W !!  D ^%ZIS G: POP QEND
  360    S CHFIO=" "
  361    S ZTDTH=$ H
  362    S ZTRTN=" PROVLIST^C HCMLRPT",Z TDESC="CML  Provider  Mailing Li st"
  363    S ZTIO="" ,ZTSAVE("C HFIO")="", ZTSAVE("CH ALLMAIL")= "",ZTSAVE( "CHCTY")=" ",ZTSAVE(" CHST")="", ZTSAVE("DU Z")=""
  364    S ZTSAVE( "CH*")=""
  365    D ^%ZTLOA D
  366    Q
  367    ;
  368   PROVLIST ;
  369    K ^CHMZHO LD("CML",D UZ),^CHMZH OLD("CML", "FINAL",DU Z),^CHMZHO LD("CML"," DUPADDR",D UZ),^CHMZH OLD("CML", "ALLMAILIN G",DUZ),^C HMZHOLD("C ML","ONEMA ILING",DUZ )
  370    S CHBPFG= "PROV"
  371    D PROV1,P ROV2,VFILE IO
  372    D KILLVAR
  373    Q
  374    ;
  375   PROV1 ;
  376    D INIT
  377    Q:'$G(CHJ UL365)  Q: '$G(CHYR)
  378    S CHPDI=C HYR_$E(CHJ UL365,3,5) _"00000000 "
  379    F  S CHPD I=$O(^CHMP AY("C",CHP DI)) Q:'CH PDI  D
  380    .S CHCLI= 0
  381    .F  S CHC LI=$O(^CHM PAY("C",CH PDI,CHCLI) ) Q:'CHCLI   D
  382    ..Q:$P($G (^CHMPAY(C HCLI,0))," ^",2)=10    ;skip if  a deleted  claim
  383    ..S CHVP= $P($G(^CHM PAY(CHCLI, 0)),"^",3)  Q:'$G(CHV P)
  384    ..Q:$P($G (^CHMVEN(C HVP,1)),"^ ",7)=45       ;skip i f a pharma cy vendor
  385    ..Q:$P($G (^CHMVEN(C HVP,0)),"^ ",8)'=0       ;skip i f not in a n active s tatus
  386    ..S (CHNA ME,CHADDR1 ,CHADDR2,C HCITY,CHST ATE,CHZIP9 ,CHZIP5,CH FORNFG)=""
  387    ..;;tlh 9 /28/09 cha nged all n odes from  2 to 1 to  pull remit  to addres s not phys ical locat ion addres s
  388    ..;;prior  to 9/28/0 9 all the  nodes were  pulling ^ CHMVEN(CHV P,2) now c hanged to  ^CHMVEN(CH VP,1) 
  389    ..;;chang e chname t o pull rem it to name  not physi cal name.   
  390    ..S CHNAM E=$P($G(^C HMVEN(CHVP ,0)),"^",1 ) Q:CHNAME =""   ;rem it name an d address  only
  391    ..S CHADD R1=$P($G(^ CHMVEN(CHV P,1)),"^", 1) Q:CHADD R1=""     
  392    ..S CHADD R2=$P($G(^ CHMVEN(CHV P,1)),"^", 2)
  393    ..S CHCIT Y=$P($G(^C HMVEN(CHVP ,1)),"^",3 ) Q:CHCITY =""
  394    ..S CHCIT Y=$$UPPER^ CHTFLIB(CH CITY)
  395    ..I CHCTY '="" Q:CHC ITY'=CHCTY
  396    ..S CHFOR NFG=$S($P( $G(^CHMVEN (CHVP,1)), "^",18):"F ",1:"D")    ;Domestic ,Foreign
  397    ..S CHQFG =0
  398    ..I CHFOR NFG="D" D   Q:$G(CHQF G)
  399    ...S CHST I=$P($G(^C HMVEN(CHVP ,1)),"^",4 ) I 'CHSTI  S CHQFG=1  Q
  400    ...S CHST ATE=$P($G( ^DIC(5,CHS TI,0)),"^" ,2) I CHST ATE="" S C HQFG=1 Q
  401    ...I CHST '="" I CHS TATE'=CHST  S CHQFG=1  Q
  402    ...S CHZI P9=$P($G(^ CHMVEN(CHV P,1)),"^", 5) I CHZIP 9="" S CHQ FG=1 Q
  403    ...S CHZI P5=$E(CHZI P9,1,5) I  CHZIP5=""  S CHQFG=1  Q
  404    ..E  D  Q :$G(CHQFG)
  405    ...S CHST I=$P($G(^C HMVEN(CHVP ,1)),"^",1 7) I 'CHST I S CHQFG= 1 Q
  406    ...S CHST ATE=$P($G( ^DIC(5,CHS TI,0)),"^" ,1) I CHST ATE="" S C HQFG=1 Q    ;Country 
  407    ...S (CHZ IP5,CHZIP9 )="1"
  408    ..I $G(CH ZIPFG) Q:' $D(^CHMZHO LD("CML",D UZ,"CHZIPS ",CHZIP5))     ;SKD,5 -29,09,DEV 002408
  409    ..I CHADD R2="" S CH ADDR2="NOA DDR2" 
  410    ..I ((CHA DDR1["*")!  (CHADDR2[ "*")) U FI O W !,CHNA ME_T_CHADD R1_T_CHADD R2_T_CHCIT Y_T_CHSTAT E_T_T_CHZI P9 Q   ;TL H 9/29/09 
  411    ..S ^CHMZ HOLD("CML" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HVP)=CHNAM E_"^"_CHZI P9
  412    Q
  413    ;
  414   PROV2 ;
  415    F CHFORNF G="D","F"  D  
  416    .S CHZIP5 =0 F  S CH ZIP5=$O(^C HMZHOLD("C ML",DUZ,CH BPFG,CHFOR NFG,CHZIP5 )) Q:'CHZI P5  D
  417    ..S CHSTA TE="" F  S  CHSTATE=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE)) Q:CHS TATE=""  D   
  418    ...S CHCI TY="" F  S  CHCITY=$O (^CHMZHOLD ("CML",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY))  Q:CHCITY= ""  D
  419    ....S CHA DDR1="" F   S CHADDR1 =$O(^CHMZH OLD("CML", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1) ) Q:CHADDR 1=""  D  
  420    .....S CH ADDR2="" S  CHADDR2=$ O(^CHMZHOL D("CML",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)) Q: CHADDR2=""   D  
  421    ......S C HVP=0 F  S  CHVP=$O(^ CHMZHOLD(" CML",DUZ,C HBPFG,CHFO RNFG,CHZIP 5,CHSTATE, CHCITY,CHA DDR1,CHADD R2,CHVP))  Q:'CHVP  D  
  422    .......S  CHNAME=$P( ^CHMZHOLD( "CML",DUZ, CHBPFG,CHF ORNFG,CHZI P5,CHSTATE ,CHCITY,CH ADDR1,CHAD DR2,CHVP), "^",1)
  423    .......S  CHZIP9=$P( ^CHMZHOLD( "CML",DUZ, CHBPFG,CHF ORNFG,CHZI P5,CHSTATE ,CHCITY,CH ADDR1,CHAD DR2,CHVP), "^",2)
  424    .......S  ^CHMZHOLD( "CML",DUZ, CHBPFG,"CT ","TOTCT", CHFORNFG)= $G(^CHMZHO LD("CML",D UZ,CHBPFG, "CT","TOTC T",CHFORNF G))+1
  425    .......I  CHALLMAIL  S ^CHMZHOL D("CML","A LLMAILING" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2,C HVP)=CHNAM E_"^"_CHZI P9
  426    .......E   S ^CHMZHO LD("CML"," ONEMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2) =CHNAME_"^ "_CHZIP9
  427    .......I  '$D(^CHMZH OLD("CML", "FINAL",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)) D   
  428    ........S  ^CHMZHOLD ("CML",DUZ ,CHBPFG,"C T","UNQCT" ,CHFORNFG) =$G(^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","UNQ CT",CHFORN FG))+1
  429    ........I  CHALLMAIL  S ^CHMZHO LD("CML"," FINAL",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2,CHVP) =CHNAME_"^ "_CHZIP9 
  430    ........E   S ^CHMZH OLD("CML", "FINAL",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2)=CHN AME_"^"_CH ZIP9 
  431    .......E   D  
  432    ........I  'CHALLMAI L S $P(^CH MZHOLD("CM L","FINAL" ,DUZ,CHBPF G,CHFORNFG ,CHZIP5,CH STATE,CHCI TY,CHADDR1 ,CHADDR2), "^",1)="At tention CH AMPVA Prov ider"
  433    ........S  ^CHMZHOLD ("CML",DUZ ,CHBPFG,"C T","DUPCT" ,CHFORNFG) =$G(^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","DUP CT",CHFORN FG))+1
  434    ........S  ^CHMZHOLD ("CML","DU PADDR",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2)="Att ention CHA MPVA Provi der"
  435    Q
  436    ;open ven dor output  files
  437   VFILEIO ;
  438    X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1)
  439    ;DEF01655 4 SBB 11/2 5/13  - Co nverting f rom DECNET  to FTP.
  440    ;S FILELO C="HACFS3" "
D NS      Welcome1!" "::e:[CML] "
  441    ;I UCI'=" HAC" S FIL ELOC="HACF S3""
D NS       Welcome1!" "::e:[CML] TEST_"
  442    S FILELOC ="HAC_HFS$ :[SCR.TEMP _FILES]"
  443    I UCI'="H AC" S FILE LOC="HAC_H FS$:[DSMMA NAG.CHAMPV A]TEST_"
  444    I CHALLMA IL=1 S CHF ILEVDOM=FI LELOC_DUZ_ "_CML_PROV _ALL_D.TXT ",CHFILEVF OR=FILELOC _DUZ_"_CML _PROV_ALL_ F.TXT"
  445    E  S CHFI LEVDOM=FIL ELOC_DUZ_" _CML_PROV_ ONE_D.TXT" ,CHFILEVFO R=FILELOC_ DUZ_"_CML_ PROV_ONE_F .TXT"
  446    ;DEF01655 4-11/25/13 -SBB use O PEN^%ZISH  to open fi le
  447    ;O CHFILE VDOM:"NWS" :5 Q:'$T
  448    ;O CHFILE VFOR:"NWS" :5 Q:'$T
  449    ;SBB 07/3 0/15 DEF01 6554
  450    X "D $SYS TEM.Proces s.SetZEOF( 1)"
  451    I '$$OPEN FIWR^CHTFL IB9(.CHFIL EVDOM,"CHF ILEVDOM")  X "D $SYST EM.Process .SetZEOF(0 )" Q
  452    I '$$OPEN FIWR^CHTFL IB9(.CHFIL EVFOR,"CHF ILEVFOR")  X "D $SYST EM.Process .SetZEOF(0 )" Q
  453    D PSUMMAR Y
  454    D PRTPROV
  455    ;
  456    ;C FILE,C HFILEVDOM, CHFILEVFOR ,FIO  ;TLH  9/29/09 
  457    D CLOSEF^ CHTFLIB9(F ILE,"FILE" )
  458    D CLOSEF^ CHTFLIB9(C HFILEBDOM, "CHFILEBDO M")
  459    D CLOSEF^ CHTFLIB9(C HFILEBFOR, "CHFILEBFO R")
  460    D CLOSEF^ CHTFLIB9(F IO,"FIO")
  461    ;SBB 07/3 0/15 DEF01 6554
  462    X "D $SYS TEM.Proces s.SetZEOF( 0)"
  463    D FTPFILE ^CHTFLIB9( CHFILEBDOM ," DNS     . DNS             ","/CML"," PUT")
  464    H 3
  465    D FTPFILE ^CHTFLIB9( CHFILEBFOR ," DNS     . DNS             ","/CML"," PUT")
  466    H 3
  467    D FTPFILE ^CHTFLIB9( FIO," DNS     . DNS             ","/FS3BIG ","PUT")
  468    Q
  469    ;
  470   PSUMMARY ;
  471    F CHFORNF G="D","F"  D  
  472    .S FILE=$ S(CHFORNFG ="D":CHFIL EVDOM,1:CH FILEVFOR)
  473    .D PRINTT OT
  474    Q
  475    ;
  476   PRTPROV ;
  477    F CHFORNF G="D","F"  D  
  478    .S FILE=$ S(CHFORNFG ="D":CHFIL EVDOM,1:CH FILEVFOR)
  479    .I CHALLM AIL D VALL MAIL
  480    .E  D ONE MAIL
  481    Q
  482    ;
  483   VALLMAIL ;
  484    S CHZIP5= 0 F  S CHZ IP5=$O(^CH MZHOLD("CM L","ALLMAI LING",DUZ, CHBPFG,CHF ORNFG,CHZI P5)) Q:'CH ZIP5  D
  485    .S CHSTAT E="" F  S  CHSTATE=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE)) Q:C HSTATE=""   D  
  486    ..S CHCIT Y="" F  S  CHCITY=$O( ^CHMZHOLD( "CML","ALL MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY )) Q:CHCIT Y=""  D
  487    ...S CHAD DR1="" F   S CHADDR1= $O(^CHMZHO LD("CML"," ALLMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1)) Q:CHAD DR1=""  D   
  488    ....S CHA DDR2="" S  CHADDR2=$O (^CHMZHOLD ("CML","AL LMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2))  Q:CHADDR2= ""  D  
  489    .....S CH VP=0 F  S  CHVP=$O(^C HMZHOLD("C ML","ALLMA ILING",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2,CHVP) ) Q:'CHVP   D 
  490    ......S C HNAME=$P(^ CHMZHOLD(" CML","ALLM AILING",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHVP ),"^",1)
  491    ......S C HZIP9=$P(^ CHMZHOLD(" CML","ALLM AILING",DU Z,CHBPFG,C HFORNFG,CH ZIP5,CHSTA TE,CHCITY, CHADDR1,CH ADDR2,CHVP ),"^",2)
  492    ......I C HFORNFG="F " S CHZIP9 =""
  493    ......U F ILE W !,CH NAME_T_CHA DDR1_T_$S( CHADDR2="N OADDR2":"" ,1:CHADDR2 )_T_CHCITY _T_CHSTATE _T_T_$$CNV ZIP9(CHZIP 9)
  494    Q
  495    ;
  496   ONEMAIL ;
  497    S CHZIP5= 0 F  S CHZ IP5=$O(^CH MZHOLD("CM L","ONEMAI LING",DUZ, CHBPFG,CHF ORNFG,CHZI P5)) Q:'CH ZIP5  D
  498    .S CHSTAT E="" F  S  CHSTATE=$O (^CHMZHOLD ("CML","ON EMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE)) Q:C HSTATE=""   D  
  499    ..S CHCIT Y="" F  S  CHCITY=$O( ^CHMZHOLD( "CML","ONE MAILING",D UZ,CHBPFG, CHFORNFG,C HZIP5,CHST ATE,CHCITY )) Q:CHCIT Y=""  D
  500    ...S CHAD DR1="" F   S CHADDR1= $O(^CHMZHO LD("CML"," ONEMAILING ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1)) Q:CHAD DR1=""  D   
  501    ....S CHA DDR2="" S  CHADDR2=$O (^CHMZHOLD ("CML","ON EMAILING", DUZ,CHBPFG ,CHFORNFG, CHZIP5,CHS TATE,CHCIT Y,CHADDR1, CHADDR2))  Q:CHADDR2= ""  D  
  502    .....S CH NAME="",CH NAME=$P(^C HMZHOLD("C ML","ONEMA ILING",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2),"^", 1)
  503    .....I $D (^CHMZHOLD ("CML","DU PADDR",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2)) S C HNAME=^CHM ZHOLD("CML ","DUPADDR ",DUZ,CHBP FG,CHFORNF G,CHZIP5,C HSTATE,CHC ITY,CHADDR 1,CHADDR2)    ;***
  504    .....S CH ZIP9="",CH ZIP9=$P(^C HMZHOLD("C ML","ONEMA ILING",DUZ ,CHBPFG,CH FORNFG,CHZ IP5,CHSTAT E,CHCITY,C HADDR1,CHA DDR2),"^", 2)
  505    .....I CH FORNFG="F"  S CHZIP9= ""
  506    .....U FI LE W !,CHN AME_T_CHAD DR1_T_$S(C HADDR2="NO ADDR2":"", 1:CHADDR2) _T_CHCITY_ T_CHSTATE_ T_T_$$CNVZ IP9(CHZIP9 )
  507    Q
  508    ;
  509   PRINTTOT ;
  510    I '$G(DUZ ) S DUZ=1
  511    U FILE W  !!
  512    S TITLE=" Health Adm inistratio n Center"  S TAB=((80 -$L(TITLE) )/2)
  513    D NOW^%DT C S CHDATE =$$FMTE^XL FDT(X,"5D" )
  514    U FILE W  "DUZ: ",DU Z,?TAB,TIT LE,?68,CHD ATE,! K TA B,TITLE
  515    S RPTTITL E="Communi cations "_ $S(CHBPFG= "BENE":CHP ROG,1:"")_ " "_$S(CHB PFG="BENE" :"Benefici ary",1:"Pr ovider")_"  Mailing L ist "_$S(C HFORNFG="D ":"Domesti c",1:"Fore ign")
  516    U FILE W  !,RPTTITLE
  517    U FILE W  !
  518    U FILE W  !,$S(CHBPF G="BENE":"       ",1: "          ")_"Total  "_$S(CHBPF G="BENE":" Beneficiar y",1:"Prov ider")_" C ount:  "_$ G(^CHMZHOL D("CML",DU Z,CHBPFG," CT","TOTCT ",CHFORNFG ))
  519    U FILE W  !,"   Numb er of Uniq ue Address es:  "_$G( ^CHMZHOLD( "CML",DUZ, CHBPFG,"CT ","UNQCT", CHFORNFG))
  520    U FILE W  !,"Number  of Duplica te Address es:  "_$G( ^CHMZHOLD( "CML",DUZ, CHBPFG,"CT ","DUPCT", CHFORNFG)) ,!!
  521    I CHBPFG= "BENE"&(CH ALLMAIL) U  FILE W !, "OUTPUT FO RMAT: NAME _TAB_ADDR1 _TAB_ADDR2 _TAB_ADDR3 _TAB_CITY_ TAB_STATE_ TAB_TAB_ZI P9_TAB_SBI DCDDT_TAB_ DOB_TAB_SE X_TAB_OHIT OC"
  522    E  U FILE  W !,"OUTP UT FORMAT:  NAME_TAB_ ADDR1_TAB_ ADDR2_TAB_ CITY_TAB_S TATE_TAB_T AB_ZIP9"
  523    U FILE W  !
  524    Q
  525    ;
  526   KILLVAR ;
  527    K ^CHMZHO LD("CML",D UZ),^CHMZH OLD("CML", "FINAL",DU Z),^CHMZHO LD("CML"," DUPADDR",D UZ)
  528    K ^CHMZHO LD("CML"," ALLMAILING ",DUZ),^CH MZHOLD("CM L","ONEMAI LING",DUZ) ,^CHMZHOLD ("CML","ZI P",DUZ)
  529    K Z1,Z2,Z 3,Z4,Z5,Z6 ,CHPROG,CH UNIQ,CHALL MAIL,CHCTY ,CHST,CHBE NE,X,X2,X2 ,CHJUL365, CHJUL548,C HYR,CHPDI, CHCLI
  530    K CHSTI,C HNAME,CHAD DR1,CHADDR 2,CHADDR3, CHCITY,CHS TATE,CHZIP 9,CHZIP5,C HFORNFG
  531    K CHDFN,C HBFN,CHMDF NI,CHMDFNJ ,CHMDFNK,C HCMOPEA
  532    K FILE,CH FILEVDOM,C HFILEVFOR, CHFILEBDOM ,CHFILEBFO R,CHQFLAG, CH365,CH54 8,CHCREDT, CHDONE,CHD ONEDT
  533    K CHZIPS, CHZIPFG
  534    Q
  535    ; 
  536   INIT ;
  537    S T=$C(9)   ;TAB DEL IMITER
  538    I '$D(DT)  D NOW^%DT C S DT=X   ;TLH 9/29/ 09 DEV0075 20
  539    I DT="" D  NOW^%DTC  S DT=X  ;T LH9/29/09  DEV007520
  540    S CHDATE= $$STRIP^XL FSTR($$FMT E^XLFDT(DT ,"5D"),"/" )  ;TLH 9/ 29/09 DEV0 07520
  541    X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1)
  542    S FIO="HA C_HFS$:[SC R.TEMP_FIL ES]VENDORS _WITH_ASTE RICK_IN_RE MITADD_"_C HDATE
  543    I UCI'="H AC" S FIO= "HAC_HFS$: [DSMMANAG. CHAMPVA]VE NDORS_WITH _ASTERICK_ IN_REMITAD D_"_CHDATE _"_"_UCI
  544    ;S FIO="H ACFS3""
D NS       Welcome1!" "::D:[FS3B IG]VENDORS _WITH_ASTE RICK_IN_RE MITADD_"_C HDATE    ;TLH DEV00 7520
  545    ;O FIO  ; TLH 9/29/0 9
  546    ;C FIO="D " O FIO:"N WS"  ;TLH  9/29/09  
  547    ;SBB 07/3 0/15 DEF01 6554
  548    X "D $SYS TEM.Proces s.SetZEOF( 1)"
  549    I '$$OPEN FIWR^CHTFL IB9(.FIO," FIO") X "D  $SYSTEM.P rocess.Set ZEOF(0)" Q
  550    K ^CHMZHO LD("CML",D UZ,CHBPFG) ,^CHMZHOLD ("CML","FI NAL",DUZ,C HBPFG)
  551    I CHZIPFG =1,$G(^CHM ZHOLD("CML ","ZIP",DU Z))'="" D     ;SKD,5- 29,09,DEV0 02408
  552    .S XX="", XX=^CHMZHO LD("CML"," ZIP",DUZ)
  553    .F I=1:1: $L(XX,$c(1 3,10)) D  
  554    ..S (CHZI P1,CHZIP2) =""
  555    ..S CHZIP 1=$P($P(XX ,$c(13,10) ,I),"-",1) ,CHZIP1=$$ TRIM^CHTFL IB($$LTRIM ^CHTFLIB(C HZIP1)),CH ZIP1=$E(CH ZIP1,1,5)
  556    ..S CHZIP 2=$P($P(XX ,$c(13,10) ,I),"-",2) ,CHZIP2=$$ TRIM^CHTFL IB($$LTRIM ^CHTFLIB(C HZIP2)) I  $L(CHZIP2)  S CHZIP2= $E(CHZIP2, 1,5)
  557    ..Q:'CHZI P1
  558    ..S ^CHMZ HOLD("CML" ,DUZ,"CHZI PS",CHZIP1 )=""
  559    ..F J=CHZ IP1:1:CHZI P2 S ^CHMZ HOLD("CML" ,DUZ,"CHZI PS",J)=""
  560    F CHFORNF G="D","F"  D  
  561    .S ^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","TOT CT",CHFORN FG)=0
  562    .S ^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","UNQ CT",CHFORN FG)=0
  563    .S ^CHMZH OLD("CML", DUZ,CHBPFG ,"CT","DUP CT",CHFORN FG)=0
  564    D UCI^%ZO SV S UCI=$ P(Y,",",1)
  565    I UCI="DE V" D  
  566    .D NOW^%D TC S X1=X, X2=-365 D  C^%DTC S C HJUL365=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH365=X K  X
  567    .D NOW^%D TC S X1=X, X2=-548 D  C^%DTC S C HJUL548=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH548=X K  X
  568    E  D  
  569    .D NOW^%D TC S X1=X, X2=-365 D  C^%DTC S C HJUL365=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH365=X K  X
  570    .D NOW^%D TC S X1=X, X2=-548 D  C^%DTC S C HJUL548=$$ FMJUL^CHTF LIB(X),CHY R=$$FMYR^C HTFLIB(X), CH548=X K  X
  571    Q
  572    ;
  573   QUITCHK(DN ,BN)  ;QUI T check no t to add t o the mail ing list
  574    S CHQFLAG =0
  575    S CHDN=DN ,CHBN=BN
  576    Q:(CHDN=" "!CHBN="")
  577    I '$D(^AH CHVA(CHDN, 100,CHBN,0 )) S CHQFL AG=1 Q
  578    I CHPROG= "CHAMPVA"  I $P($G(^A HCHVA(CHDN ,100,CHBN, 0)),"^",5) '="EA" S C HQFLAG=1 Q
  579    I CHPROG= "CMOP" I $ P($G(^AHCH VA(CHDN,10 0,CHBN,0)) ,"^",5)'=" EA" S CHQF LAG=1 Q
  580    S CHNM="" ,CHNM=$P($ G(^AHCHVA( CHDN,100,C HBN,0)),"^ ",1) 
  581    I CHNM=""  S CHQFLAG =1 Q
  582    I CHNM["( SN)" S CHQ FLAG=1 Q
  583    I $P($G(^ AHCHVA(CHD N,100,CHBN ,0)),"^",6 )'="" I $L ($P(^AHCHV A(CHDN,100 ,CHBN,0)," ^",6))=7 S  CHQFLAG=1  Q    ;SKD , 5-14-09,  DEV007250
  584    I $D(^AHA DIC(554804 .07,"B",CH NM)) D
  585    .S CHI=0
  586    .F  S CHI =$O(^AHADI C(554804.0 7,"B",CHNM ,CHI)) Q:' CHI  D
  587    ..S (CHDE LDN,CHDELB N)=0
  588    ..S CHDEL DN=$P($G(^ AHADIC(554 804.07,CHI ,0)),"^",3 ) Q:'CHDEL DN
  589    ..S CHDEL BN=$P($G(^ AHADIC(554 804.07,CHI ,0)),"^",4 ) Q:'CHDEL BN
  590    ..I CHDEL DN=CHDN,CH DELBN=CHBN  S CHQFLAG =1 Q
  591    Q
  592    ;
  593   CONVDT5(D)  ;convert  FileMan da te to mm/d d/yyyy 
  594    NEW D1,M1
  595    I D="" Q  ""
  596    S D=$$FMT E^XLFDT(D, "5D")
  597    S D1=$P(D ,"/",1)
  598    I D1="" Q  ""
  599    I $L(D1)= 1 S D1="0" _D1
  600    S M1=$P(D ,"/",2)
  601    I M1="" Q  ""
  602    I $L(M1)= 1 S M1="0" _M1
  603    Q D1_"/"_ M1_"/"_$P( D,"/",3)
  604    ;  
  605   OHITOC(IVA L,JVAL) ;
  606    Q:IVAL=""
  607    Q:JVAL=""
  608    I '$G(DT)  S X="NOW"  D ^%DT S  DT=Y
  609    S QFLG=0, U="^"
  610    S CHOHLOG =1
  611    S K="A"
  612    F  S K=$O (^CHMDFN(I VAL,100,JV AL,2,K),-1 ) G:'K OHI END G:QFLG  OHIEND D   
  613    .Q:'$D(^C HMDFN(IVAL ,100,JVAL, 2,K,0))
  614    .S REC=^( 0)
  615    .S (CHOHI B,CHOHIE,C HOH)=""
  616    .S CHOHIB =$P(REC,U, 1),CHOHIE= $P(REC,U,2 ),CHOH=$P( REC,U,3)
  617    .I CHOH=" " S CHOH=1
  618    .S:$D(^CH MDIC(74100 2.76,CHOH, 0)) CHOHLO G=$P(^(0), U,4)
  619    .I CHOHLO G="" S CHO HLOG=1
  620    .S:CHOHIE ="" CHOHIE =9999999
  621    .I CHOHIB '>DT,DT<CH OHIE S QFL G=1
  622   OHIEND K I VAL,JVAL,Y ,K,QFLG,CH OHIB,CHOHI E,CHOH
  623    Q CHOHLOG
  624    ;
  625   GETOHI(OHI DFN,OHIBFN ) ;
  626    S CHOH=""
  627    S CHMDFNI =0,CHMDFNI =$O(^CHMDF N("B",OHID FN,CHMDFNI ))
  628    I CHMDFNI  S CHMDFNJ =0,CHMDFNJ =$O(^CHMDF N(CHMDFNI, 100,"B",OH IBFN,CHMDF NJ))
  629    S CHOHITO C=0
  630    I CHMDFNI ,CHMDFNJ S  CHOHITOC= $$OHITOC(C HMDFNI,CHM DFNJ)
  631    I CHOHITO C D  
  632    .S:$D(^CH MDIC(74100 2.78,CHOHI TOC,0)) CH OH=$P(^CHM DIC(741002 .78,CHOHIT OC,0),"^", 1),CHOH=$E (CHOH,5,15 )
  633    Q CHOH
  634    Q