87. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/9/2018 12:33:52 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

87.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMCOB25.m Mon Nov 5 16:44:35 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMCOB25.m Fri Nov 9 02:20:51 2018 UTC

87.2 Comparison summary

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

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

87.4 Active regular expressions

No regular expressions were active.

87.5 Comparison detail

  1   CHMCOB25 ; HRL/dlb;E0 1 MEDICARE  CROSSOVER  QUALIFICA TION;05/20 /2010 2:08  PM
  2    ;;1.0;CHA MPVA SYSTE M;;JULY 4,  1990;Buil d 11
  3    ;;1;E01 M EDICARE CR OSSOVER QU ALIFICATIO N;;MAY 20, 2010;Build  1
  4    ;;DEV0028 41-02;MEDI CARE CROSS OVER QUALI FICATION F UNCTIONS;
  5    ;;HR-COB- Medicare-A /B-Begin-C R9372
  6    ;;DEF0138 64 - JSE 1 2/8/11 FIX  UNDEFINED  ERROR DIS CREPANTE02 +15
  7    ;;DEV0138 16-02 - YJ K 2/2/2012  Error rec eived duri ng process ing of ERF  02 file  
  8    ;; GEF -  CPE USER S TORY 012 R EPLACE HIC N W/MBI 07 /03/2017
  9    ;;MBI Upd ate - SBB  06/18/2018  MBI Valid ation chec k fix
  10    Q
  11       
  12       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  13       ; JAVA ->CACHE DE VELOPMENT  Connection  data as o f Today: 7 /29/2010                      
  14       ;   ja va file:   driver:      jdbc:Cac he                                     
  15                         Host name:     IP                                           
  16       ;                 Port:        1974                                        
  17       ;                 database:    DEV2                                        
  18       ;                 username:    MEDXOVER                                    
  19       ;                 password:    Containe d in the J ava Proper ties file            
  20       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  21       
  22       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  23       ; JAVA ->CACHE TE ST Connect ion data a s of Today : 9/3/2010                           
  24       ;   ja va file:   driver:      jdbc:Cac he                                     
  25                         Host name:     IP                                           
  26       ;                 Port:        1973                                        
  27       ;                 database:    TEST                                        
  28       ;                 username:    MEDXOVER                                    
  29       ;                 password:    Containe d in the J ava Proper ties file            
  30       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  31       
  32       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  33       ; JAVA ->CACHE TE ST Connect ion data a s of Today : 9/3/2010                           
  34       ;   ja va file:   driver:      jdbc:Cac he                                     
  35                         Host name:     IP                                           
  36       ;                 Port:        1977                                        
  37       ;                 database:    DEVHR                                       
  38       ;                 username:    MEDXOVER                                    
  39       ;                 password:    Containe d in the J ava Proper ties file            
  40       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  41    
  42       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  43       ;   DI SCREPANT   Function c alled from  the ELIGE 01 Cache C lass to se t the Disc repant       
  44       ;                 status for  the Benef iciary. Th is functio n is the " work" for  the     
  45       ;                 SetDiscrep ant() EDI  call.  The  Cache Cla ss is the  bridge bet ween EDI     
  46       ;                 and Cache.  No Cache  programmin g logic is  contained  in the ED I.ELIG  
  47       ;                 Class.                                              
  48       ;                 ALL ERF re cords are  added to t he TRACKIN G Global,  including  the "01"     
  49       ;                 Status, wh ich is NOT  an ERROR  STATUS.                         
  50       ;                 E01: CWF D ISPOSITION  CODES "01 ","50","52 "=ACCEPTED ;ALL Other s=DISC  
  51       ;                 E02: CWF D ISPOSITION  CODES "01 ","02"=ACC EPTED; All  Others=DI SC      
  52       ; CHDA TA: The co mplete ERF  record is  passed to  provide t racking Ca pabilitiy               
  53       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  54       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (2-25-2011 )DLB
  55           
  56   DISCREPANT E01(CHDATA )
  57       ;   CH DATA  ERF  REPORT Dat a to be wr itten to T racking Gl obal
  58       ;RETUR N     Stri ng contain ing the DF N/BFN Indi ces if Suc cessful, o therwise " NOT FOUND"  
  59       ;S $ZT ="ERFERR^C HMCOB25"                                    ;Error tra ps catches  anything  within thi s function  and below
  60       D SETU P^CHMCOBL2 1
  61       N CHTI ,CHTJ,CHDF N,CHBFN,CH TK,CHMAXK, CHFIELDS,C HSUPPID,DU PLICATE,CH RESULT,ERF DATA,CHIDX ,FAIL
  62       N SNDD ATE,FLDCNT
  63       S (CHT I,CHTJ,DUP LICATE,FAI L)=0,(CHTK ,CHRESULT) ="FAILED"      ; DUPL ICATE ERF  Records NO T UPDATED
  64       S FLDC NT=$L(CHDA TA,"^") I  FLDCNT'=19  Q "INVALI D STRING"
  65       S SNDD ATE=$P(CHD ATA,"~",2)  I SNDDATE ="" Q "NO  SEND DATE"
  66       I $P(C HDATA,"^", 8)'?9N Q " INVALID SS N"                        ; Bene ficiary SS N from ERF  Record
  67       S CHID X=$$GETCFG IDX^CHMCOB D21("E01")                       ; Set the  Index vals  for E01/E 02
  68       ; GEF  - CPE USER  STORY 012  REPLACE C orrected H ICN W/ Cor rected MBI  07/03/201 7 field .0 7 ->.12
  69       ;S CHF IELDS=".01 ^.02^.03^. 04^.05^.06 ^.07^.08^. 09"         ; ^CHMCOB  ERF Field  descripto rs
  70    S CHFIELD S=".01^.02 ^.03^.04^. 05^.06^.07 ^.08^.09^. 10^.11^.12 "        ;  ^CHMCOB E RF Field d escriptors
  71       S CHSU PPID=$P(CH DATA,"^",8 )                                ; Benefici ary SSN fr om ERF Rec ord
  72       ;I '$$ GETTRKIJ(C HSUPPID,.C HTI,.CHTJ, .CHDFN,.CH BFN) D RPT ERR("GETTR KIJ") Q "S SN NOT FOU ND" ; Get  SP/BENE In dexes        ;DEV0138 16-02 - YJ K 2/8/2012
  73       I '$$G ETTRKIJ(CH SUPPID,CHI DX,.CHTI,. CHTJ,.CHDF N,.CHBFN)  D RPTERR(" GETTRKIJ")  Q "SSN NO T FOUND" ;  Get SP/BE NE Indexes   ;DEV0138 16-02 - YJ K 2/8/2012
  74       I CHSU PPID'=$P($ G(^CHMCOB( CHTI,100,C HTJ,CHIDX) ),"^",9) Q  "SSN NOT  FOUND"     ; Compare  vs Trackin g SSN Valu e
  75       S ERFD ATA=$$GETD ATA(CHDATA ,CHIDX)                          ; Extract  Incoming D ATA for TR ACKING
  76       S CHMA XK=$$GETKI NDEX(CHTI, CHTJ,CHIDX )            ; Get th e last K i ndex used
  77       FOR CH TK=1:1 Q:( CHTK>CHMAX K)!(DUPLIC ATE)  D                       ;  Check for  Duplicate  E02 ERF Re cord
  78       .I (($ P(CHDATA," ^",10)-170 00000)=$P( ^CHMCOB(CH TI,100,CHT J,100,CHTK ,0),"^",1) ) S DUPLIC ATE=1 ; Di sposition  Date
  79       I DUPL ICATE Q "D UPLICATE:" _CHDFN_"/" _CHBFN
  80       S CHRE SULT="TRAC KING UPDAT E FAILED"                        ; Set Up t he Fail Re sult
  81       I '$$A DDERF^CHMC OBL21(CHTI ,CHTJ,.CHT K,CHIDX,ER FDATA,CHFI ELDS) S FA IL=1 D RPT ERR("E01_A DDERF") 
  82       E  I ( ($P(CHDATA ,"^",9)'=" 01")&($P(C HDATA,"^", 9)'="50")& ($P(CHDATA ,"^",9)'=" 52")) D 
  83       .I '$$ UPDDISC^CH MCOBL21(CH TI,CHTJ,CH IDX,"Y") S  FAIL=1 D  RPTERR("E0 1_UPDDISC" )   ;"01", "50","52"= OK, Else D ISC   
  84       I 'FAI L S CHRESU LT="INSERT ED:"_CHDFN _"/"_CHBFN  
  85       Q CHRE SULT
  86       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (2 -25-2011)D LB 
  87    
  88       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  89       ; RESO LUTION     Function c alled from  the ELIGE 01 Cache C lass to se t the reso lution of    
  90       ;                 the Discre pant statu s for the  Beneficiar y.  This f unction is  the "work
  91       ;                 for the Se tResolved( ) EDI call .  The Cac he Class i s the brid ge           
  92       ;                 between ED I and Cach e. No Cach e programm ing logic  is contain ed in the    
  93       ;                 EDI.ELIG C lass.                                         
  94       ; RESD ATA: "DFN/ BFN^RESOLU TION DATE^ RESOLUTION  PERSON"                
  95       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  96       ; OCT  6, 2010    DLB Modifi ed functio n to suppo rt E01/E02  ERF Resol ution Proc ess          
  97       ;  1)  Added swit ch to sele ct E01 or  E02 ERF Pr ocessing                             
  98       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;   
  99    
  100   RESOLUTION E01(RESDAT A)
  101       ;   RE SDATA      String con taining an y pertinen t ERF Reso lution Dat a
  102       ;RETUR N          Boolean
  103       S $ZT= "ERFERR^CH MCOB25"                   ;Error  traps cat ches anyth ing within  this func tion and b elow 
  104       D SETU P^CHMCOBL2 1
  105       N IDXS TR,CHRESUL T,CHTI,CHD FN,CHTJ,CH BFN,CHTK,C HFIELDS,CH IDX,CWFDAT E,CHDATA,F AIL,CNT,KI DX
  106       S (CHT I,CHTJ,CHT K)="",(FAI L,CNT)=0
  107       S CHID X=$$GETCFG IDX^CHMCOB D21("E01")                           ; E01  Resolution
  108       S IDXS TR=$P(RESD ATA,"^",1)                                      ; DFN/ BFN INDEX
  109       S CHRE SULT="NOT  FOUND"_IDX STR                                  ; Set  Up Result  String for  Failure
  110       S CHDF N=$P(IDXST R,"/",1),C HBFN=$P(ID XSTR,"/",2 )              ; Extr act DFN/BF N from Inc oming
  111       I '$$G ETTRACK(CH DFN,CHBFN, .CHTI,.CHT J) D RPTER R("GETTRAC K") Q CHRE SULT       ; Retrieve  I,J, Fail ->Quit
  112       S CHTK =999999999
  113       F  S C HTK=$O(^CH MCOB(CHTI, 100,CHTJ,1 00,CHTK),- 1) Q:'CHTK   D     ;  REVERSE OR DER Entrie s
  114       .I $P( ^CHMCOB(CH TI,100,CHT J,100,CHTK ,0),"^",10 )="" S CNT =CNT+1  D
  115       ..S CH FIELDS=".1 0^.11",CHD ATA=($P(RE SDATA,"^", 2)-1700000 0)_"^"_$P( RESDATA,"^ ",3)         ; E01 Fi elds to Up date
  116       ..S CH RESULT="NO T UPDATED: "_IDXSTR                                 ;  Set New Fa ilure Stri ng 
  117       ..I '$ $UPDERF^CH MCOBL21(CH TI,CHTJ,CH TK,CHIDX,C HDATA,CHFI ELDS) S FA IL=1 D RPT ERR("UPDER F") ; Set  E01 Res Da te & Name
  118       ..I '$ $UPDDISC^C HMCOBL21(C HTI,CHTJ,C HIDX,"N")  S FAIL=1 D  RPTERR("U PDDISC")           ;  If Update  OK,Clear D ISC Flag
  119       I 'FAI L S CHRESU LT="RESOLV ED: "_CNT               ; IF DIS C OK, Set  SUCCESS RE SULT
  120       Q CHRE SULT                                                       ; Retu rn RESULT
  121       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (2 -25-2011)D LB 
  122    
  123       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  124       ;   DI SCREPANT02     Functi on called  from the E LIG.ERF Ca che Class  to set the  Discrepan t         
  125       ;                 status for  the E02 B eneficiary . This fun ction is t he "work"  for the      
  126       ;                 SetDiscrep antERF02()  EDI call.   The Cach e Class is  the bridg e between  EDI   
  127       ;                 and Cache.  No Cache  programmin g logic is  contained  in the ED I.ELIG  
  128       ;                 Class.                                              
  129       ;                 ALL ERF re cords are  added to t he TRACKIN G Global,  including  the "01"     
  130       ;                 Status, wh ich is NOT  an ERROR  STATUS.                         
  131       ;                 E01: CWF D ISPOSITION  CODES "01 ","50","52 "=ACCEPTED ;ALL Other s=DISC  
  132       ;                 E02: CWF D ISPOSITION  CODES "01 ","02"=ACC EPTED; All  Others=DI SC      
  133       ; CHDA TA: The co mplete ERF  record is  passed to  provide t racking Ca pability                
  134       ; CHDA TA="E02 SE NT DATE^E0 2 FILE UPD ATE INDICA TOR^E02 BE NEFICIARY  SURNAME \\
  135       ;          ^E02 B ENEFICIARY  FIRST NAM E^E02 BENE FICIARY MI DDLE INITI AL \\
  136       ;         ^E02 BE NEFICIARY  BIRTH DATE ^E02 BENEF ICIARY SEX  CODE^E02  BENEFICIAR Y HIC NUMB ER
  137       ;         ^E02 BE NEFICIARY  SUPP ID NU MBER^E02 B ENEFICIARY  RELATIONS HIP"
  138       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  139       ; OCT  6,2010     DLB Modifi ed to supp ort E01/E0 2 ERF Proc ess                  
  140       ;  1)  Added Init ialization  for the E 01/E02 typ e based on  the ERF D ata receiv ed      
  141       ;  2)  Added swit ch logic t o set Disc repant sta tus based  on E01/E02  type              
  142       ;  3)  CHIDX,E1E2  variables  set up to  access E0 1 or E02 N odes                      
  143       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;   
  144    
  145       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (2-25-2011 )DLB  
  146   DISCREPANT E02(CHDATA )
  147       ;   CH DATA  ERF  REPORT Dat a to be wr itten to T racking Gl obal
  148       ;RETUR N     Stri ng contain ing the DF N/BFN Indi ces if Suc cessful, o therwise " NOT FOUND"
  149       S $ZT= "ERFERR^CH MCOB25"                                     ;Error tra ps catches  anything  within thi s function  and below
  150       D SETU P^CHMCOBL2 1
  151       N CHTI ,CHTJ,CHDF N,CHBFN,CH TK,CHMAXK, CHFIELDS,C HSUPPID,DU PLICATE,CH RESULT,ERF DATA,CHIDX ,FAIL
  152       N SNDD ATE,FLDCNT
  153       S FLDC NT=$L(CHDA TA,"^") I  FLDCNT'=35  Q "INVALI D STRING"
  154       S SNDD ATE=$P(CHD ATA,"~",2)  I SNDDATE ="" Q "NO  SEND DATE"
  155       I $P(C HDATA,"^", 7)'?9N Q " INVALID SS N"                    ; Benefici ary SSN fr om ERF Rec ord   
  156       S (CHT I,CHTJ,DUP LICATE,FAI L)=0,(CHTK ,CHRESULT) =""        ; DUPLICAT E ERF Reco rds NOT UP DATED
  157       S CHID X=$$GETCFG IDX^CHMCOB D21("E02")  ; Set the  Index val s for E01/ E02
  158       ; GEF  - CPE USER  STORY 012  REPLACE C orrected H ICN W/ Cor rected MBI  07/03/201 7 field .0 7 ->.12
  159       ;S CHF IELDS=".01 ^.02^.03^. 04^.05^.06 ^.07^.08^. 09"         ; ^CHMCOB  ERF Field  descripto rs
  160    S CHFIELD S=".01^.02 ^.03^.04^. 05^.06^.07 ^.08^.09^. 10^.11^.12 "        ;  ^CHMCOB E RF Field d escriptors
  161       S CHSU PPID=$P(CH DATA,"^",7 )                                ; Benefici ary SSN fr om ERF Rec ord
  162       ;I '$$ GETTRKIJ(C HSUPPID,.C HTI,.CHTJ, .CHDFN,.CH BFN) D RPT ERR("GETTR KIJ") Q "S SN NOT FOU ND" ; Get  SP/BENE In dexes        ;DEV0138 16-02 - YJ K 2/8/2012
  163       I '$$G ETTRKIJ(CH SUPPID,CHI DX,.CHTI,. CHTJ,.CHDF N,.CHBFN)  D RPTERR(" GETTRKIJ")  Q "SSN NO T FOUND" ;  Get SP/BE NE Indexes   ;DEV0138 16-02 - YJ K 2/8/2012  
  164       ;DEF01 3864 - JSE  12/8/11 F IX UNDEFIN ED ERROR D ISCREPANTE 02+15
  165       ;I CHS UPPID'=$P( ^CHMCOB(CH TI,100,CHT J,CHIDX)," ^",9) Q "S SN NOT FOU ND"    ; C ompare vs  Tracking S SN Value
  166       I CHSU PPID'=$P($ G(^CHMCOB( CHTI,100,C HTJ,CHIDX) ),"^",9) Q  "SSN NOT  FOUND"     ; Compare  vs Trackin g SSN Valu e
  167       S CHMA XK=$$GETKI NDEX(CHTI, CHTJ,CHIDX )            ; Get th e last K i ndex used
  168       FOR CH TK=1:1 Q:( CHTK>CHMAX K)!(DUPLIC ATE)  D               ; Check fo r Duplicat e E02 ERF  Record
  169       .I (($ P(CHDATA," ^",17)-170 00000)=$P( ^CHMCOB(CH TI,100,CHT J,200,CHTK ,0),"^",1) ) S DUPLIC ATE=1 ; Di sposition  Date
  170       I DUPL ICATE Q "D UPLICATE:" _CHDFN_"/" _CHBFN
  171       S ERFD ATA=$$GETD ATA(CHDATA ,CHIDX)                          ; Extract  Incoming D ATA for TR ACKING
  172       S CHRE SULT="TRAC KING UPDAT E FAILED"                        ; Set Up t he Fail Re sult
  173       I '$$A DDERF^CHMC OBL21(CHTI ,CHTJ,CHTK ,CHIDX,ERF DATA,CHFIE LDS) S FAI L=1 D RPTE RR("E02_AD DERF") 
  174       E  I ( ($P(CHDATA ,"^",18)'= "01")&($P( CHDATA,"^" ,18)'="02" )) D    ;  Idx 18 is  E02 CWF Di sposition
  175       .I '$$ UPDDISC^CH MCOBL21(CH TI,CHTJ,CH IDX,"Y") S  FAIL=1 D  RPTERR("E0 2_UPDDISC" ) ;"01","0 2"=OK Else  DISC
  176       I 'FAI L S CHRESU LT="INSERT ED:"_CHDFN _"/"_CHBFN  
  177       Q CHRE SULT
  178       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (2 -25-2011)D LB 
  179    
  180       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  181       ; RESO LUTION02   Function c alled from  the ELIGE 01 Cache C lass to se t the reso lution of    
  182       ;                 the Discre pant statu s for the  Beneficiar y.  This f unction is  the "work
  183       ;                 for the Se tResolved( ) EDI call .  The Cac he Class i s the brid ge           
  184       ;                 between ED I and Cach e. No Cach e programm ing logic  is contain ed in the    
  185       ;                 EDI.ELIG C lass.                                         
  186       ; RESD ATA: "DFN/ BFN^RESOLU TION DATE^ RESOLUTION  PERSON"                
  187       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  188    
  189       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (2-25-2011 )DLB  
  190   RESOLUTION E02(RESDAT A)
  191       ;   RE SDATA      String con taining an y pertinen t ERF Reso lution Dat a
  192       ;RETUR N          Boolean
  193       S $ZT= "ERFERR^CH MCOB25"                   ;Error  traps cat ches anyth ing within  this func tion and b elow 
  194       D SETU P^CHMCOBL2 1
  195       N IDXS TR,CHRESUL T,CHTI,CHD FN,CHTJ,CH BFN,CHTK,C HFIELDS,CH IDX,CWFDAT E,CHDATA,F AIL,CNT,KI DX
  196       S (CHT I,CHTJ,CHT K)="",(FAI L,CNT)=0
  197       S CHID X=$$GETCFG IDX^CHMCOB D21("E02")                           ; E01  Resolution
  198       S IDXS TR=$P(RESD ATA,"^",1)                                      ; DFN/ BFN INDEX
  199       S CHRE SULT="NOT  FOUND @"_I DXSTR                                ; Set  Up Result  String for  Failure
  200       S CHDF N=$P(IDXST R,"/",1),C HBFN=$P(ID XSTR,"/",2 )              ; Extr act DFN/BF N from Inc oming
  201       I '$$G ETTRACK(CH DFN,CHBFN, .CHTI,.CHT J) D RPTER R("GETTRAC K") Q CHRE SULT       ; Retrieve  I,J, Fail ->Quit
  202       S CHTK =999999999
  203       F  S C HTK=$O(^CH MCOB(CHTI, 100,CHTJ,2 00,CHTK),- 1) Q:'CHTK   D     ;  REVERSE OR DER Entrie s
  204       .I $P( ^CHMCOB(CH TI,100,CHT J,200,CHTK ,0),"^",10 )="" S CNT =CNT+1  D
  205       ..S CH FIELDS=".1 0^.11",CHD ATA=($P(RE SDATA,"^", 2)-1700000 0)_"^"_$P( RESDATA,"^ ",3)         ; E01 Fi elds to Up date
  206       ..S CH RESULT="NO T UPDATED: "_IDXSTR                                 ;  Set New Fa ilure Stri ng 
  207       ..I '$ $UPDERF^CH MCOBL21(CH TI,CHTJ,CH TK,CHIDX,C HDATA,CHFI ELDS) S FA IL=1 D RPT ERR("UPDER F") ; Set  E01 Res Da te & Name
  208       ..I '$ $UPDDISC^C HMCOBL21(C HTI,CHTJ,C HIDX,"N")  S FAIL=1 D  RPTERR("U PDDISC")           ;  If Update  OK,Clear D ISC Flag
  209       I 'FAI L S CHRESU LT="RESOLV ED: "_CNT                                ;  IF DISC OK , Set SUCC ESS RESULT
  210       Q CHRE SULT                                                       ; Retu rn RESULT
  211       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (2 -25-2011)D LB 
  212       
  213       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  214       ; SETT YPE uses t he first f ield of th e ERF data  to determ ine if the  ERF is E0 1 or E02.        
  215       ;   Th e E02 ERF  contains t he E02 COB A ID in th e first fi eld, the E 01 contain s the Pati ent   
  216       ;   HI CN in the  first fiel d. If the  E02 Coba I D matches  the COBA I D value in  the    
  217       ;   ^C HMDIC(7410 02.72 Conf iguration  File, the  ERF type i s assigned  to E02.                             
  218       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  219    
  220       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (2-25-2011 )DLB  
  221   SETTYPE(CH FIELD1)        ; Esta blish the  ERF type b ased on Fi eld1 of ER F File
  222       ;   CH FIELD1 def inition: E 01=Bene HI CN, E02=CO BA ID
  223       I CHFI ELD1=$P($G (^CHMDIC(7 41002.72,2 ,0)),"^",3 ) D            ; If F ield1=COBA  ID
  224       .S CHT YPE=$$SETF TYPE^CHMCO BD21("E02" )                         ; Type =E02  
  225       E  S C HTYPE=$$SE TFTYPE^CHM COBD21("E0 1")                       ; Else  Type=E01
  226       Q CHTY PE                                       
  227       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (2 -25-2011)D LB 
  228           
  229       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  230       ; DATE MATCH perf orms the c omparison  of the inc oming date  with exis ting date  in the Tra cking 
  231       ; glob al.                                                                 
  232       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  233       
  234       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (2-25-2011 )DLB  
  235   DATEMATCH( CHTI,CHTJ, CHIDX,INDA TE)
  236       ; INDA TE  The da te from th e incoming  ERF
  237       ;   RE TURN: TRUE  (1) if da te match f ound, else  FALSE (0)
  238       N CHMA XK,CHTK,MA TCH
  239       S MATC H=""
  240       S CHMA XK=$$GETKI NDEX(CHTI, CHTJ,CHIDX )                ; Us e the func tion to Ge t last K I ndex
  241       F CHTK =1:1  Q:(C HTK>CHMAXK )!(MATCH)   D                    ; Get the  Max K valu e for the  E02 Node
  242       .I IND ATE=$P(^CH MCOB(CHTI, 100,CHTJ,( CHIDX*100) ,CHTK,0)," ^",1) S MA TCH=CHTK ;  MATCHED t he CWF Dat e
  243       Q MATC H
  244       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (2 -25-2011)D LB 
  245       
  246           
  247       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  248       ; RESE TERF  Perf orms a "KI LL" of the  ERF Nodes  for Benef iciary spe cified by  DFN/BFN fo r the 
  249       ; Java  Class. Ad ded this c apability  for EDI te am to faci litate tes ting.                                                                                                      ;
  250       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  251       ; OCT  6,2010     DLB Modifi ed Functio n to Suppo rt E01/E02  ERF Proce ss                 
  252       ;  1)  Added Swit ch to sele ct the E01 /E02 Nodes  for Reset  of ERF No de                      
  253       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  254    
  255       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (2-25-2011 )DLB 
  256   RESETERF(C HTYPE,RESD ATA)
  257       N IDXS TR,CHDFN,C HBFN,CHTI, CHTJ,CHRES ULT,CHIDX
  258       I (CHT YPE'="E01" )&(CHTYPE' ="E02") Q: "INVALID T YPE"_CHTYP E
  259       S CHID X=$$GETCFG IDX^CHMCOB D21(CHTYPE )                     ; E01/E02  Resolution
  260       S CHDF N=$P(RESDA TA,"/",1), CHBFN=$P(R ESDATA,"/" ,2)        ; Extract  DFN/BFN va lues
  261       S CHRE SULT=$$GET TRACK(CHDF N,CHBFN,.C HTI,.CHTJ)            ; Retrieve  I,J from  DFN/BFN XR EFS
  262       I CHRE SULT'=1 D  RPTERR("GE TTRACK") Q  "NOT RESE T: "_RESDA TA
  263       K ^CHM COB(CHTI,1 00,CHTJ,(C HIDX*100))                       ; Kill the  ERF for B ene CHTI,C HTJ
  264       Q "RES ET: "_RESD ATA
  265       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (2 -25-2011)D LB 
  266    
  267       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  268       ; GET  TRK I,J se ts the CHT I and CHTJ  values fo r the Supp lemental I D (SSN) va lue provid ed    
  269       ; Use  the ^AHCHV A Suppleme ntal ID Cr oss-refere nce(CHDFN  and CHBFN  are parame ters retur ned)
  270       ; to r etrieve th e I and J  values in  the Tracki ng Global  ^CHMCOB.                      
  271       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  272     
  273   GETTRKIJ(S UPPID,CHID X,CHTI,CHT J,CHDFN,CH BFN)
  274       ; CHTI   Internal  Index for  Sponsor ( I)
  275       ; CHTJ   Internal  Index for  Beneficia ry (J)
  276       ; CHID X 1:E01, 2 :E02     ; DEV013816- 02 - YJK 2 /8/2012 
  277       ;RETUR N  Modifie d values f or the CHT I and CHTJ  variables
  278       N CHTM P
  279       N FOUN D,DONE                                                         ;D EV013816-0 2 - YJK 2/ 8/2012 
  280       S (DON EI,DONEJ,F OUND)=0                                                     ;DEV0 13816-02 -  YJK 2/8/2 012 
  281       S (CHB FN,CHDFN,C HTI,CHTJ)= ""
  282       S CHDF N=$O(^AHCH VA("G",SUP PID,CHDFN) ) I CHDFN= ""  Q 0            ;  Supplement al ID Cros sreference
  283       S CHBF N=$O(^AHCH VA("G",SUP PID,CHDFN, CHBFN)) I  CHBFN=""   Q 0     ;  to retriev e CHDFN,CH BFN
  284       ;W !," DFN=",CHDF N,"  BFN=  ",CHBFN
  285       S (CHT I,CHTJ)=""
  286       I '$D( ^CHMCOB("B ",CHDFN))  Q 0
  287       ;S CHT I=$O(^CHMC OB("B",CHD FN,"")) I  CHTI="" Q  0                   ;  CHDFN use d to retri eve CHTI    ;DEV01381 6-02 - YJK  2/8/2012 
  288       ;I '$D (^CHMCOB(C HTI,100,"B ",CHBFN))  Q 0                                                                ;DEV01381 6-02 - YJK  2/8/2012 
  289       ;S CHT J=$O(^CHMC OB(CHTI,10 0,"B",CHBF N,"")) I C HTJ="" Q 0          ;  CHTI & CH BFN retrie ve CHTJ     ;DEV01381 6-02 - YJK  2/8/2012
  290       ;Q 1                                                                                                       ;DEV01381 6-02 - YJK  2/8/2012 
  291     
  292       ;DEV01 3816-02 -  YJK 2/8/20 12: 
  293       WHILE  'DONEI
  294       {
  295    S DONEJ=0     
  296           S  CHTI=$O(^C HMCOB("B", CHDFN,CHTI )) I CHTI= "" S DONEI =1                   
  297           I  '$D(^CHMCO B(CHTI,100 ,"B",CHBFN )) S DONEI =1
  298           WH ILE 'DONEJ
  299           {
  300               S CHTJ=$O (^CHMCOB(C HTI,100,"B ",CHBFN,CH TJ)) I CHT J="" S DON EJ=1
  301                   I $D( ^CHMCOB(CH TI,100,CHB FN,CHIDX))  S (DONEI, DONEJ,FOUN D)=1
  302           }
  303       }
  304       I FOUN D Q 1
  305       Q 0
  306    
  307       
  308       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  309       ; GET  K INDEX  r eturns the  last "K"  index for  the Tracki ng Global  Node for E RF trackin g.        
  310       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  311       ; OCT  6,2010     DLB Modifi ed functio n to suppo rt E01/E02  ERF Proce ss                 
  312       ;  1)  Added swit ch to sele ct the E01 /E02 Nodes  for the " K" value                           
  313       ;  2)  E1E2 varia ble is use d to acces s the 100/ 200 Node o f Tracking  Global                 
  314       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  315    
  316   GETKINDEX( CHTI,CHTJ, CHIDX)
  317       N CHTK
  318       I '$D( ^CHMCOB(CH TI,100,CHT J,(CHIDX*1 00),0)) Q  0                           ; Is  there ERF  DATA Node  for I,J
  319       S CHTK =$P(^CHMCO B(CHTI,100 ,CHTJ,(CHI DX*100),0) ,"^",3) I  CHTK="" Q  0     ; Nu mber of En tries from  Node 0
  320       Q CHTK   
  321    
  322    
  323       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  324       ; GETT RACK(CHDFN ,CHBFN,.CH TI,.CHTJ)                                     
  325       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  326       ; GET  TRACK INDE X function  SETS the  Internal I ndex value s CHTI and  CHTJ from  the    
  327       ; user  provided  CHDFN,CHBF N values                                      
  328       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  329       
  330   GETTRACK(C HDFN,CHBFN ,CHTI,CHTJ )
  331       ; CHDF N SPONSOR  INDEX FOR  AHCHVA
  332       ; CHBF N BENEFICI ARY INDEX  FOR AHCHVA
  333       ; CHTI   Internal  Index for  Sponsor ( I)
  334       ; CHTJ   Internal  Index for  Beneficia ry (J)
  335       ;RETUR N  Modifie d values f or the CHT I and CHTJ  variables
  336       S CHTI ="",CHTJ=" "
  337       I '$D( ^CHMCOB("B ",CHDFN))  Q 0
  338       S CHTI =$O(^CHMCO B("B",CHDF N,""))             ;  Use CHDFN  to retriev e CHTI
  339       I '$D( ^CHMCOB(CH TI,100,"B" ,CHBFN)) Q  0 
  340       S CHTJ =$O(^CHMCO B(CHTI,100 ,"B",CHBFN ,""))   ;  Use CHTI,C HBFN to re tireve CHT J
  341       I (CHT I="")!(CHT J="") Q 0
  342       ;W !," I= ",CHTI, "  J= ",CH TJ
  343       Q 1
  344    
  345       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  346       ; GETD ATA extrac ts the dat a from the  Incoming  string for  the SETDI SCREPANT m ethod   
  347       ; Read  the data  in from th e EDI stri ng and put  non-null  values int o the ERF  node    
  348       ; in a  ^ delimit ed string.   TRKFLDS  is the loc ation id f or the EDI  string, u sed 
  349       ; to p lace the d ata in the  proper or der for th e ERF stri ng.                  
  350       ;E01:  "HICN^LNAM E^FNAME^DO B^SEX^FROM  DATE^TO D ATE^SSN^CW F CODE^CWF  DATE^BO-1 ^BO-2^  
  351       ;  BO- 3^BO-4^TP  HICN^FUI^F ILL^IN DAT E"                                 
  352       ;E02:  COBA ID^LN AME^FNAME^ DOB^SEX^SS N^HICN^FRO M DATE^TO  DATE^PLAN  DCN^FUI^NP LANID^  
  353       ;  INS  TYPE CODE ^COBC DCN^ PERSON COD E^CWF DATE ^CWF CODE^ ERR-1^ERR- 2^ERR-3^ER R-4^    
  354       ;  Dat e of Death ^MCA SDate ^MCA EDATE ^MCB SDATE ^MCB EDATE ^HMO SDATE ^HMO EDATE ^       
  355       ;  MC  CTRCTR PDP #^MC PDP S DATE^MC PD P EDATE^^^ NBI^CCI^FI LL^INDATE"           
  356       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;    
  357    
  358       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (10-07-201 0)DLB     
  359   GETDATA(ER FFIELDS,CH IDX)
  360       N TRKF LDS,CHTMP, CHFIELD,FL DIDX,ERFDA TA,SNDDATE
  361       S ERFD ATA=""
  362       ; GEF  - REPLACE  HICN W/MBI  7/25/17:    E02 = 8t h piece (M BI replace s HICN) an d
  363       ; E01  = 1st piec e + 18th p iece (new  CORRECTED  MBI), 15th  is still  Corrected  HICN
  364       I CHID X=1 S TRKF LDS="10,9, 11,12,13,1 4,15,16"              ; Fields f rom Incomi ng E01 Str ing
  365       E  S T RKFLDS="17 ,18,19,20, 21,22,8,12 "                ; Fi elds from  Incoming E 02 String
  366       F FLDI DX=1:1  Q: FLDIDX>$L( TRKFLDS,", ")  D
  367       .S:ERF DATA'="" E RFDATA=ERF DATA_"^"                    ; Ad d "^" deli miter betw een fields
  368       .S CHF IELD=$P(TR KFLDS,",", FLDIDX)                     ; Ge t the Fiel d value
  369       .S CHT MP=$P(ERFF IELDS,"^", CHFIELD)                    ; Re trieve the  Field Dat a
  370       .S CHT MP=$TR(CHT MP," ","")                             ; Ki ll Spaces
  371       .I CHI DX=1 I (CH FIELD=10)! (CHFIELD=1 8) S CHTMP =CHTMP-170 00000   ;  E01 Dates  to FM Form at
  372       .E  I  (CHFIELD=1 7)!(CHFIEL D=38) S CH TMP=CHTMP- 17000000   ; E02 Date s to FM Fo rmat
  373       .I CHT MP="null"  S CHTMP=""                             ; On ly place N ON-NULL va lues
  374       .S ERF DATA=ERFDA TA_CHTMP                               ; Co ncatenate  values int o string
  375       S SNDD ATE=$P(ERF FIELDS,"~" ,2)-170000 00               ; GE T THE INBO UND ERF DA TE
  376       S ERFD ATA=ERFDAT A_"^"_SNDD ATE                         ; PU T THE DATE  INTO THE  ERF DATA A RRAY
  377       ; GEF  - CPE USER  STORY 012  REPLACE C orrected H ICN W/ Cor rected MBI  07/03/201 7 field .0 7 ->.12 fo r E02, new  field for  E01
  378    S:CHIDX=1  $P(ERFDAT A,"^",12)= $P(ERFFIEL DS,"^",18)
  379       ; For  E02, if it  is an MBI  and not a  HICN, mak e sure the  new MBI f ield is up dated with  the data  and not th e old HICN  field
  380       I CHID X'=1 S $P( ERFDATA,"^ ",12)="" I  $$VLDMBI( $P(ERFDATA ,"^",7),CH IDX) S $P( ERFDATA,"^ ",12)=$P(E RFDATA,"^" ,7),$P(ERF DATA,"^",7 )=""
  381       Q ERFD ATA
  382       ;HR-ME DCOB-Medic are-A/B-En d-XXE02 (1 0-07-2010) DLB 
  383       
  384   TRIM(TXT)  ;TRIMS TRA ILING SPAC ES FROM ST RING
  385       N N,TT XT
  386       I '$D( TXT) S TTX T="" Q TTX T
  387       F N=$L (TXT):-1 Q :$E(TXT,N, N)'=" "!(N <1)
  388       S TTXT =$E(TXT,1, N)
  389       Q TTXT
  390    
  391       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  392       ; CHKE RF    ERF  ENTRIES IN  THE TRACK ING GLOBAL  ARE ONLY  PRESENT IF  THE BENEF ICIARY  ;
  393       ;            HAS  BEEN "DISC REPANT". I F AN ENTRY  EXISTS, I T MAY BE N ECESSARY T O RESEND;
  394       ; Chec k the stat us of the  ERF entrie s to deter mine if th e E01 reco rd last   
  395       ; sent  should be  resent. R esending o f the prev ious recor d is warra nted based  on:    
  396       ;   1)  There is  E01 Data i n TRACKING  AND there  is an ind ex (K inde x) for the  ERF but 
  397       ;       no ERF St atus in th e Tracking  Global 
  398       ;   2)  The previ ous CWF Di sposition  Code was N OT "01"                     
  399       ;   3)  The E01 R ecord "Sen t Date" is  more rece nt than th e "ERF Inb ound Date"     
  400       ;       Assumptio n: The E01  qualifica tion is ru n on a sch eduled bas is (i.e. M onthly)
  401       ;       If the ER F file has  not been  received f or the las t E01 when  doing a Q ual run
  402       ;       re-send t he trackin g informat ion for qu alified be neficiarie s.             
  403       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  404       ; OCT  6,2010     DLB Modifi ed to supp ort E01/E0 2 ERF Proc esses                
  405       ;   1)  Added swi tch to sel ect the E0 1/E02 Node s for retr ieving CWF  Date and  Codes   
  406       ;   2)  Added var iable E1E2  to contai n the 100/ 200 Node V alues for  E01/E02 ER F   
  407       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  408       
  409       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (10-06-201 0)DLB
  410   CHKERF(CHT I,CHTJ,CHI DX)
  411       ;   CH TI         Sponsor In dex for Tr acking Glo bal
  412       ;   CH TJ         Beneficiar y Index fo r Tracking  Global
  413       ;   CH IDX        Differenti ates betwe en E01/E02  ACCESSES  INTO TRACK ING GLOBAL  (^CHMCOB)
  414       ;RETUR N     0=DO NT'T SEND    1=SEND
  415       N CHTK ,CHKSENT,E RFIN,RESUL T,CWFCD,CW FDT,CHDIFF ,TODAY,E1E 2
  416       S CHTK =$$GETKIND EX(CHTI,CH TJ,CHIDX)                        ; Get K in dex value
  417       I 'CHT K Q 0                                                  ; NO ERF E ntry; Quit
  418       S CHKS ENT=($P($G (^CHMCOB(C HTI,100,CH TJ,CHIDX)) ,"^",1))       ; Get  E01 Sent D ate
  419       S CWFC D=$P($G(^C HMCOB(CHTI ,100,CHTJ, (CHIDX*100 ),CHTK,0)) ,"^",2)      ; Get ER F CWF CODE
  420       S CWFD T=+$P($G(^ CHMCOB(CHT I,100,CHTJ ,(CHIDX*10 0),CHTK,0) ),"^",1)     ; Get ER F CWF DATE
  421       I 'CWF DT  Q 1                                                ; IF No CW FDATE Quit /Send
  422       I CWFD T'<CHKSENT  D                                          ; IF CWFDA TE More Re cent than  Sent Date
  423       .I CWF CD="01"  S  RESULT=0                                   ; IF CWF C ode = "SUC CESS", Qui t
  424       .E  S  RESULT=1                                               ; Else Set  Up for Qu it/SEND
  425       E  D  
  426       .S TOD AY=$$FMDAT E^CHMCOBD2 1("NOW")                         ; Get Toda y's Date i n FM Forma t
  427       .S CHD IFF=$$FMDI FF^XLFDT(T ODAY,CHKSE NT,1)                 ; Get diff erence:Tod ay to Last  Sent
  428       .I CHD IFF>60 S R ESULT=1                                     ; If More  than 60 Da ys, Quit/S END
  429       .E  S  RESULT=0                                               ; < 60 DAY S, DON'T S END
  430       Q RESU LT
  431       ;HR-ME DCOB-Medic are-A/B-Be gin-XXE02  (10-06-201 0)DLB                                                                   
  432    
  433       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  434       ; ERFE RR    ERRO R TRAP fun ction to g ather the  ERROR Data  to be rep orted.                  
  435       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  436       
  437   ERFERR ; E rror trap  for the we b sevice 
  438       D ^%ZT ER
  439       Q "NOT  FOUND"        
  440       ;N Err
  441       I $G(% objlasterr or)]"" D D ecomposeSt atus^%apiO BJ(%objlas terror,.Er r)   ; ext ract the e rror messa ge
  442       S CHER FERR="Erro r on PDI:  "_CHAVSPDI _" - "_$ZE
  443       S:$D(E rr) CHERFE RR=CHERFER R_" : "_$G (Err(Err))
  444       D RPTE RR("TRAP E RF ERR")
  445       Q "NOT  FOUND"                              ; this  indicates  issues wi th the web  service
  446       
  447       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  448       ; RPTE RR    Func tion to Re port the E rror to Re sponsible  Parties                       
  449       ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  450       
  451   RPTERR(FUN CNAME) ; M ails out W EB service  error
  452       Q
  453       K ^UTI LITY($J,"E RF-ERR")
  454       S ^UTI LITY($J,"E RF-ERR",1, 1,0)="E01  Response F ile Web Se rvice Erro r:"
  455       S ^UTI LITY($J,"E RF-ERR",1, 2,0)=" "
  456       S ^UTI LITY($J,"E RF-ERR",1, 3,0)=CHWEB ERR
  457       S ^UTI LITY($J,"E RF-ERR",1, 4,0)="Erro r Encounte red @ "_FU NCNAME
  458       S XMDU Z=.5,XMSUB ="Cache -  ERF Web se rvice ERRO R"
  459       S XMTE XT="^UTILI TY($J,""ER F-ERR"",1, "
  460         ;S XMY(" PII                    ")=""
  461         S XMY("
P II             ")=""
  462         ;S XMY(" PII                      ")=""
  463         ;S XMY(" PII                   ")=""
  464       S U="^ " D ^XMD
  465       Q
  466    
  467   TEST
  468       N CHDA TA,RESULT
  469       ;S CHD ATA="29820 0459A^BATE S^CORNELIA ^19570224^ F^19930211 ^20220223^ 402085737^ BO^2010070 6^BO01^^^^ ^A^~201007 30"
  470       ;S CHD ATA="29820 0459A^BATE S^CORNELIA ^Hi Dave^F ^19930211^ 20220223^1 85508078^B O^20100706 ^BO01^^^^^ A^~2010073 0"
  471       ;S CHD ATA="23148 2782A  ^WA TKINS^THEL MA^1939053 0^F^200405 01^2059053 0^23148278 2^BO^20110 509^BO01^^ ^^^A^~2010 0730"
  472       S E01C HDATA="101 300886C^WI LLERT^ROY^ 19670424^M ^20090701^ 20101231^0 90544495^0 1^20110517 ^^^^^10130 0886C^A^^^ ~20110519"
  473       S E01C HDATA2="3M 11MM1MM11^ WILLERT^RO Y^19670424 ^M^2009070 1^20101231 ^090544495 ^01^201105 18^^^^^3M1 1MM1MM11^A ^^^~201105 19"
  474       S E02C HDATA="000 0080214^WI LLERT^ROY^ ^19670424^ M^09054449 5^10130088 6C^2009070 1^20101231 ^11^A^13^O ^15^C^2011 0517^01^^^ ^^^^^^^^^^ ^^^^~20110 519"        
  475       S E02C HDATA2="00 00080214^W ILLERT^ROY ^^19670424 ^M^0905444 95^3M11MM1 MM11^20090 701^201012 31^11^A^13 ^O^15^C^20 110518^01^ ^^^^^^^^^^ ^^^^^^~201 10519"        
  476       S E02C HDATA3="00 00080214^L UPIEN^CARO L^J^194407 02^F^53142 6899^55425 3560A^2009 0701^20640 702^PLANDO CCTRL0002^ A^^O^COBCD OCCTRL0002 ^S^2011051 3^SP^B005^ ^^^^^^^^^^ ^^^^^~2011 0524"
  477       S E02C HDATA4="00 00080214^L UPIEN^CARO L^J^194407 02^F^53142 6899^55425 3560A^2009 0701^20640 702^PLANDO CCTRL0002^ A^^O^COBCD OCCTRL0002 ^S^2011051 3^SP^B005^ ^^^^^^^^^^ ^^^^^~2011 0524"
  478       S E02C HDATA5="00 00080214^C ARTER^MAGG IE^L^19440 702^F^2452 21112^5542 53560A^200 90701^2064 0702^PLAND OCCTRL0002 ^A^^O^COBC DOCCTRL000 2^S^201105 13^SP^B005 ^^^^^^^^^^ ^^^^^^~201 10524"
  479       S E02C HDATA6="00 00080214^G OULD^MARIE ^L^1944070 2^F^365247 778^554253 560A^20090 701^206407 02^PLANDOC CTRL0002^A ^^O^COBCDO CCTRL0002^ S^20110513 ^SP^B005^^ ^^^^^^^^^^ ^^^^~20110 524"
  480       S E02C HDATA7="00 00080214^H OFFMAN^WIL MA^L^19440 702^F^2454 28699^5M11 MM1MM11^20 090701^206 40702^PLAN DOCCTRL000 2^A^^O^COB CDOCCTRL00 02^S^20110 513^SP^B00 5^^^^^^^^^ ^^^^^^^~20 110524"
  481       S E02C HDATA8="00 00080214^A LLISON^IDA ^B^1944070 2^F^464629 880^554253 560A^20090 701^206407 02^PLANDOC CTRL0002^A ^^O^COBCDO CCTRL0002^ S^20110513 ^SP^B005^^ ^^^^^^^^^^ ^^^^~20110 524"
  482       S E02C HDATA9="00 00080214^T ROWBRIDGE^ CAROLINE^J ^19440702^ F^35628345 7^55425356 0A^2009070 1^20640702 ^PLANDOCCT RL0002^A^^ O^COBCDOCC TRL0002^S^ 20110513^S P^B005^^^^ ^^^^^^^^^^ ^^~2011052 4"
  483       S E02C HDATA10="0 000080214^ RHOADS^ZEL A^M^194407 02^F^43240 5701^4M11M M1MM11^200 90701^2064 0702^PLAND OCCTRL0002 ^A^^O^COBC DOCCTRL000 2^S^201105 13^SP^B005 ^^^^^^^^^^ ^^^^^^~201 10524"
  484       S E01R DATA="1/2^ 20110520^R ICHARD BER G"
  485       S E02R DATA="1/2^ 20110520^R ICHARD BER G"
  486       S E02R DATA1="1/2 ^20110520^ RICHARD BE RG"
  487       S E02R DATA2="146 5/1^201105 20^RICHARD  BERG"
  488       D RESE TERF("E01" ,"1/2") W  !,"RESET E 01 RECORDS  FOR 1/2"
  489       D RESE TERF("E02" ,"1/2") W  !,"RESET E 02 RECORDS  FOR 1/2"
  490       D RESE TERF("E02" ,"1465/1")  W !,"RESE T E02 RECO RDS FOR 14 65/1"
  491       D RESE TERF("E02" ,"6571/1")  W !,"RESE T E02 RECO RDS FOR 65 71/1"
  492       D RESE TERF("E02" ,"6827/1")  W !,"RESE T E02 RECO RDS FOR 68 27/1"
  493       D RESE TERF("E02" ,"14928/1" ) W !,"RES ET E02 REC ORDS FOR 1 4928/1"
  494       D RESE TERF("E02" ,"15634/1" ) W !,"RES ET E02 REC ORDS FOR 1 5634/1"
  495       D RESE TERF("E02" ,"17738/2" ) W !,"RES ET E02 REC ORDS FOR 1 7738/2"
  496       D RESE TERF("E02" ,"18155/1" ) W !,"RES ET E02 REC ORDS FOR 1 8155/1"
  497       S RESU LT=$$DISCR EPANTE01(E 01CHDATA) 
  498       ;W !," E01 SETDIS CREPANT =  ",RESULT
  499       ;S RES ULT=$$DISC REPANTE01( E01CHDATA2
  500       ;W !," E01 SETDIS CREPANT =  ",RESULT
  501       ;S RES ULT=$$RESO LUTIONE01( E01RDATA)
  502       ;W !," E01 RESOLU TION= ",RE SULT
  503       ;S RES ULT=$$DISC REPANTE02( E02CHDATA)  
  504       ;W !," E02 SETDIS CREPANT(0)  = ",RESUL T
  505       ;S RES ULT=$$DISC REPANTE02( E02CHDATA2
  506       ;W !," E02 SETDIS CREPANT(2)  = ",RESUL T
  507       ;S RES ULT=$$RESO LUTIONE02( E02RDATA)
  508       ;W !," E02 RESOLU TION(0)= " ,RESULT
  509       ;S RES ULT=$$RESO LUTIONE02( E02RDATA1)
  510       ;W !," E02 RESOLU TION(1)= " ,RESULT
  511       ;S RES ULT=$$DISC REPANTE02( E02CHDATA3
  512       ;W !," E02 SETDIS CREPANT(3)  = ",RESUL T
  513       ;S RES ULT=$$DISC REPANTE02( E02CHDATA4
  514       ;W !," E02 SETDIS CREPANT(4)  = ",RESUL T
  515       ;S RES ULT=$$DISC REPANTE02( E02CHDATA5
  516       ;W !," E02 SETDIS CREPANT(5)  = ",RESUL T
  517       ;S RES ULT=$$DISC REPANTE02( E02CHDATA6
  518       ;W !," E02 SETDIS CREPANT(6)  = ",RESUL T
  519       ;S RES ULT=$$DISC REPANTE02( E02CHDATA7
  520       ;W !," E02 SETDIS CREPANT(7)  = ",RESUL T
  521       ;S RES ULT=$$DISC REPANTE02( E02CHDATA8
  522       ;W !," E02 SETDIS CREPANT(8)  = ",RESUL T
  523       ;S RES ULT=$$DISC REPANTE02( E02CHDATA9
  524       ;W !," E02 SETDIS CREPANT(9)  = ",RESUL T
  525       ;S RES ULT=$$DISC REPANTE02( E02CHDATA1 0) 
  526       ;W !," E02 SETDIS CREPANT(10 ) = ",RESU LT
  527       ;S RES ULT=$$RESO LUTIONE02( E02RDATA2)
  528       ;W !," E02 RESOLU TION= ",RE SULT
  529       Q
  530    
  531   ERFTST
  532       N CHDA TA,RESULT
  533       ;S CHD ATA="00000 80214^NIEM I^MYRTLE^J ^19260515^ 2^22628459 9^B8518941 914^200407 28^2046051 5^^A^^O^^S ^20110525^ SP^SP16^RX 07^^^^1991 0501^^1991 0501^^^^^^ ^^^~201106 13" 
  534       ;S CHD ATA="00000 80214^BONN ER^SHIRLEY ^A^1952031 0^2^461945 837^461945 837A^20110 107^207203 10^^A^^O^^ S^20110525 ^SP^SP16^R X07^^^^199 10501^^199 10501^^^^^ ^^^^~20120 213" 
  535    S CHDATA= "000008021 4^BONNER^S HIRLEY^A^1 9520310^2^ 461945837^ 9M11MM1MM1 1^20110107 ^20720310^ ^A^^O^^S^2 0150525^SP ^SP16^RX07 ^^^^199105 01^^199105 01^^^^^^^^ ^~20170213
  536       S RESU LT=$$DISCR EPANTE02(C HDATA)
  537       W !,"E RFTEST RES ULT = ",RE SULT 
  538       Q
  539       ;
  540   VLDMBI(CHM BI,CHIDX)
  541    ; Validat e MBI form at
  542    ; MBI For mat:  MBI  is 11 char acters.  T he 1st cha racter is  a number 1  -9,  2nd  character  is 
  543    ; Alpha ; (Excluding  (S, L, O,  I, B, Z),   3rd char acter is a lpha-numer ic,  4th i s numeric  0 - 9, 
  544    ; 5th is  alpha (sam e exclusio ns), 6th i s alpha-nu meric,  7  is numeric , 8th & 9t h are  alp ha, 10 
  545    ; & 11 ar e ;numeric   ***NOTE:  ;Alphabet ic charact ers are Up per Case O NLY, all a lpha and 
  546    ; alpha-n umerics ex clude S, L , O, I, B,  Z.  All ; numerics a re 0 - 9 ; except the  1st chara cter 
  547    ; in the  MBI cannot  be a zero .
  548    ; CHIDX =  1 for E01  file, 2 f or E02 fil e
  549    ; RETURNS  1 if pass es format  checks, 0  if not for matted cor rectly or  is a HICN
  550    ;
  551    S:$G(CHID X)="" CHID X=1
  552    ; if we a re past th e transiti on period,  CMS is on ly sending  MBI's so  no need to  check
  553    ;SBB 06/1 8/18 We ne ed the che ck.
  554    ;Q:DT>($P ($G(^CHMDI C(741002.7 2,CHIDX,0) ),"^",21)- 1) 1
  555    N ALPHA
  556    S ALPHA=" SLOIBZ"
  557    ; 1st cha racter of  an MBI mus t be numer ic 1 throu gh 9
  558    Q:+CHMBI= 0 0
  559    ; B, I, L , O, S & Z  are not a llowed in  an MBI
  560    Q:$TR(CHM BI,ALPHA)' =CHMBI 0
  561    ; Only nu mbers in p ositions 1 ,4,7,10 &  11, only U ppercase A lpha in 2, 5,8 & 9. 
  562    Q:CHMBI'? 1N1U1UN1N1 U1UN1N2U2N  0
  563    Q 1
  564