61. EPMO Open Source Coordination Office Redaction File Detail Report

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

61.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHIVFI2.m Mon Nov 5 16:41:01 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHIVFI2.m Fri Nov 9 01:26:39 2018 UTC

61.2 Comparison summary

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

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

61.4 Active regular expressions

No regular expressions were active.

61.5 Comparison detail

  1   CHIVFI2 ;l g/yg/HARRI S;ICD-10 V ENDOR FILE  INGEST
  2    ;;V1.0;Ja n 2012;HAR RIS TEAM
  3    ;;09/29/1 5 SBB DEF0 16554 fix  for decnet
  4    ;;
  5    ;; This r outine rep laces the  logic foun d in the H AC CHMLICD 2 routine
  6    ;; CHMLIC D2 ;JLR/DE N;ICD-9 CO DES TAPE R EAD IN;09/ 30/98  2:5 2 PM
  7    ;; and al so replace s the logi c in routi nes - CHML ICD3, CHML ICD4, and  CHMLICD5
  8    ;; CHMLIC D3 ;MCR/DE N;ICD-9 UP DATE CODES  TO FILEMA N FORMAT;1 0/13/92  3 :28 PM
  9    ;; CHMLIC D4 ;MCR/DE N;UPDATE I CD-9 SERVI CE FILE;10 /15/98  4: 21 PM
  10    ;; CHMLIC D5 ;MCR/DE N;UPDATE I CD-9 DX FI LE;10/01/9 8  8:27 AM
  11    ;; 
  12    Q
  13    ;
  14   AUTO(EFFDT ) ;
  15    D AUTO201 3(EFFDT)
  16    D AUTO201 4(EFFDT)
  17    W !!,"*** ********** ********** ********** ********** ********** ****"
  18    W !!," CO NGRATULATI ONS! THE H AC CHAMPVA  ICD-10 AU TO-MAINTEN ANCE LOAD  PROCESS CO MPLETED SU CCESSFULLY !"
  19    Q
  20   AUTO2013(E FFDT) ;
  21    S AUTO=1
  22    W !!,"Beg inning Loa d of FY201 3 Mapping  Tool files " H 1
  23    K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y
  24    K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J
  25    S $ZE=""
  26    I $G(EFFD T)="" S EF FDT=313101 0
  27    S X1=EFFD T,X2=-1 D  C^%DTC
  28    S TERMDT= X
  29    ;
  30    K SFILES
  31    ;09/29/15  SBB DEF01 6554 fix f or decnet
  32    ;S IOBASE ="HACFS3"" DNS       HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10UP DT.FY2013] "
  33    S IOBASE= "HAC_HFS$: [SCR.TEMP_ FILES.FS3B IG.CODEUPD T.ICD10UPD T.FY2013]"
  34    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  35    ;S EDT="1 0/1/2014"  D READ1
  36    S IO=IOBA SE_"ICD10C M_APPVD_03 _24_2014_1 2_41_14.CS V"
  37    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  38    S DATA("R T")="D"
  39    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  40    ; 
  41    ; PCS
  42    ;
  43    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  44    S IO=IOBA SE_"ICD10P CS_APPVD_0 3_24_2014_ 12_42_13.C SV"
  45    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  46    S DATA("R T")="P"
  47    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  48    Q
  49   AUTO2014(E FFDT) ;
  50    S AUTO=1
  51    W #,"Begi nning Load  of FY2014  Mapping T ool files"  H 1
  52    S AUTO=1
  53    K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y
  54    K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J
  55    S $ZE=""
  56    I $G(EFFD T)="" S EF FDT=314101 0
  57    S X1=EFFD T,X2=-1 D  C^%DTC
  58    S TERMDT= X
  59    ;
  60    K SFILES
  61    ;09/29/15  SBB DEF01 6554 fix f or decnet
  62    ;S IOBASE ="HACFS3"" DNS       HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10UP DT.FY2014] "
  63    S IOBASE= "HAC_HFS$: [SCR.TEMP_ FILES.FS3B IG.CODEUPD T.ICD10UPD T.FY2014]"
  64    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  65    ;S EDT="1 0/1/2014"  D READ1
  66    S IO=IOBA SE_"ICD10C M_APPVD_AU G2013_07_0 8_2014_08_ 36_21.csv"
  67    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  68    S DATA("R T")="D"
  69    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  70    ;
  71    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  72    S IO=IOBA SE_"ICD10C M_APPVD_JA N2014_07_2 3_2014_13_ 07_11.csv"
  73    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  74    S DATA("R T")="D"
  75    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  76    ;
  77    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  78    S IO=IOBA SE_"ICD10C M_APPVD_MA R2014_07_2 8_2014_12_ 10_35.csv"
  79    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  80    S DATA("R T")="D"
  81    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  82    ; 
  83    ; PCS
  84    ;
  85    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  86    S IO=IOBA SE_"ICD10P CS_APPVD_A UG2013_07_ 08_2014_08 _36_49.csv "
  87    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  88    S DATA("R T")="P"
  89    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  90    ; 
  91    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  92    S IO=IOBA SE_"ICD10P CS_APPVD_J AN2014_07_ 23_2014_13 _08_11.csv "
  93    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  94    S DATA("R T")="P"
  95    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  96    ;
  97    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  98    S IO=IOBA SE_"ICD10P CS_APPVD_M AR2014_07_ 28_2014_12 _05_48.csv "
  99    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  100    S DATA("R T")="P"
  101    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  102    Q
  103    ; 
  104   EN ; entry  point for  ingesting  data file (s)
  105    ;
  106    K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y
  107    K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J
  108    S $ZE=""
  109    ;S $ZT="E OF^CHIVFI2 " ; necess ary error  trapping l ogic for p rocess to  complete
  110    ; Modules  called:
  111    ; INIT =  initialize  variables
  112    ; HDR  =  prints pro cess page  header
  113    ; READ =  gets file  type and f ile data I O string.  Also gets  Vendor nam e if a (B) ase file l oad
  114    ; OPEN =  opens the  file retur ned in the  IO string  from the  READ modul e
  115    ; LOAD =  loads file  data into  a tempora ry global  for proces sing. The  temporary  global is  defined in  the INIT  module
  116    ;
  117    D INIT,HD R,READ,HDR :'STOP,OPE N:'STOP,LO AD:'STOP
  118    ;
  119   EN1 ; cont inue proce ssing -lg
  120    ; when th e '<END OF  FILE>' er ror occurs  during th e data fil e load, pr ocessing c omes to, a nd continu es here
  121    ; after b eing trapp ed @EOF su broutine.  If an erro r other th an 'end of  file' occ urs the er ror will b e posted
  122    ; to the  screen and  processin g will com e to a sto p and retu rn the use r to the m enu option .
  123    ; call to  parse dat a for inst allation t o Diagnosi s file (#7 41006.05)  and Servic es file (# 741006)
  124    ; Modules  called:
  125    ; PARSE   = module i n this rou tine calle d to proce ss (B)ase  type data  files for  baseline a nd mainten ance code  set load
  126    ; PARSEM  = module i n this rou tine calle d to proce ss (M)appi ng type da ta files
  127    ;
  128    D:'STOP P ARSEM
  129    I 'STOP D   ; print  process st atistics i f processi ng complet e
  130    .S DATA(" CTM")=$$NO W^CHIUTIL( )
  131    .W !,"  T he "_$S(DA TA("LDTYP" )="B":"ICD -10",1:"") _" load pr ocess is C omplete!", ?38," : ", DATA("CTM" )
  132    .W !!,$E( LN,1,41),!
  133    .; put lo ad statist ics here * *
  134    .W !,"           Pro cessing St arted : ", DATA("STTM ")
  135    .W !,"         FileM an Load St arted : ", DATA("FMTM ")
  136    .W !,"         Proce ssing Comp leted : ", DATA("CTM" )
  137    .W !!,"    Total ICD  Diagnosis  Codes : " ,$J(DATA(" DXCNT"),7)
  138    .W !,"    Total ICD  Procedure  Codes : ", $J(DATA("P CSCNT"),7)
  139    .W !,"                   Total  Codes : ", $J(DATA("D XCNT")+DAT A("PCSCNT" ),7)
  140    .I 'MMODE ,$G(DATA(" D")) D
  141    ..W !,"       Total  D Status R ecords : " ,$J(DATA(" D"),7)
  142    ..W !,"    Subtotal  Added to F ile(s) : " ,$J((DATA( "DXCNT")+D ATA("PCSCN T"))-DATA( "D"),7)
  143    ..Q
  144    .Q
  145    W !!,$E(L N,1,41),!
  146    R:$G(AUTO )'=1 !!,"    Press <E nter> to c ontinue ", *X
  147    ; if in m aitenance  mode print  the recor d status'
  148    I 'STOP,$ G(DATA("LD TYP"))="M" ,MMODE W @ IOF,$E(LN, 1,41),!! D   Q
  149    .F X="N", "C","D","R ","U" W !, $S(X="N":" New",X="C" :"Changed" ,X="D":"De leted",X=" R":"Reinst ated",1:"U nofficial  Change") D
  150    ..W !,"               Total ",X ," Records  : ",$J(+$ G(DATA(X)) ,7)
  151    ..Q
  152    .W !!,$E( LN,1,41),!
  153    .R:$G(AUT O)'=1 !!,"    Press < Enter> to  continue " ,*X
  154    .Q
  155    ;
  156    K @GLOBAL   ; kill d ata in tem porary sto rage globa l
  157    Q
  158   INIT ; iti alize some  required  variables
  159    ;
  160    N MM,DD
  161    S U="^",D UZ=1,DUZ(0 )="@"                             ; *** FOR  TESTING * ** -lg
  162    I '$D(IOF ) S IOF="# ,$C(27,91, 50,74,27,9 1,72)"      ; if the  pagefeed v ariable is  undefined , define i t -lg
  163    ;
  164    S GLOBAL= "^UTILITY( $J,""ICD"" )" K @GLOB AL          ; tempora ry data st orage glob al
  165    S STOP=0, $P(LN,"_", 80)=""                            ; process ing STOP f lag, line  characters
  166    S (DATA(" DXCNT"),DA TA("PCSCNT "))=0                  ; Diagnos is and Pro cedure rec ord counte rs
  167    S MMODE=1                                                                    ; MMODE =  maintenan ce mode
  168    S DATA("D ATE")=$P($ $FMDT^CHIU TIL(),".")             ; today's  date
  169    ; set eff ective yea r - effect ive and te rmination  dates alwa ys 10/01 a nd 09/30 r espectivel y
  170    ; if mont h is Oct ( 10), Nov ( 11), or De c (12), ef fective an d terminat ion dates  are this y ear, other wise previ ous year
  171    S DATA("Y R")=$E(DAT A("DATE"), 1,3)-(($E( DATA("DATE "),4,5))'> 9) ; effec tive year
  172    S DATA("E FFDATE")=D ATA("YR")_ "1001"                 ; effecti ve   date  always Oct   1st
  173    S DATA("T ERMDATE")= DATA("YR") _"0930"                ; termina tion date  always Sep  30th
  174    Q
  175   OPEN ; OPE N vendor d ata file
  176    ;
  177    W !!,"  S tarting... " ; messag e to indic ate ingest  process i s starting
  178    O IO:"R": 10 ; open  load file  with a 10  second tim eout
  179    ; if unab le to open  the file  notify the  user and  set the 'S TOP' flag  to stop al l further  processing
  180    I '$T D    S STOP=1  Q
  181    .W !!,"Un able to op en "_DATA( "FILE"),!! ,"Please m ake sure t he file na me is corr ect.",!!
  182    Q
  183   READ ; pro mpt user t o select d ata file f or ingest
  184    ;
  185    ;K IN S I N=0,IN("DI R")="HACFS 3"" DNS       HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10MA PPINGTOOL. MAINT]"
  186    ;S IN("FI LES")="*.C SV"
  187    K IN S IN ="M"
  188    S IO=$$ME NU^CHICDOL (.IN,.SEL, 1) I IO=""  S STOP=1  Q
  189    S SEL("FI LETYPE")=" M"
  190    ; get dat a filename  and data  file type:  either (B )ase or (M )apping
  191    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  192    ; get rec ord type i n data fil e: either  Diagnosis  or Procedu re code re cords
  193    S DATA("R T")=$S(SEL ("CODETYPE ")="C":"D" ,1:"P")
  194    ; change  the date l ogic from  what origi nal was do ing to fil ename date  forwarded  to next F Y border
  195    S EDT=$G( SEL("WNAME ")) Q:EDT= ""
  196    S EDT=$S( EDT["MAINT ":$P(EDT," MAINT",2), EDT["aint" :$P(EDT,"a int",2),$D (SEL("FY") ):"__"_$E( SEL("FY"), 3,9),1:"")
  197    S EDT=$P( EDT,"_",1, 3),EDT=$P( EDT," "),E DT=$TR(EDT ,"_","/")
  198    S:$P(EDT, "/",3)?2N  $P(EDT,"/" ,3)="20"_$ P(EDT,"/", 3)
  199    ;S EDT=$P (EDT,"_",3 )-1700_$P( EDT,"_")_$ P(EDT,"_", 2)
  200    ;S DATA(" DATE")=EDT
  201    ;S DATA(" YR")=$E(DA TA("DATE") ,1,3)-(($E (DATA("DAT E"),4,5))' >9)+1 ; ef fective ye ar
  202    S OK=0 
  203   READ1 ;
  204    F  D  Q:O K'=0
  205    . S %DT(" A")="Pleas e enter th e Effectiv e Date for  this load : "
  206    . S %DT(" B")="10/01 /"_($P(EDT ,"/",3)+1)
  207    . ;E  S % DT("B")=ED T
  208    . S %DT=" AE"
  209    . I '$D(D T) D NOW^% DTC S DT=X  
  210    . ;S %DT( 0)=DT 
  211    . D ^%DT
  212    . I X="^"  S OK=-1,S TOP=1 Q
  213    . I Y<DT  W !!,"Plea se select  a date tha t is not i n the past .",! Q
  214    . ;I Y<ED T W !,"You  can't pic k the date  before th e spreadsh eet date"  Q
  215    . S EFFDT =Y
  216    . W !,"Th e Effectiv e Date for  this main tenance lo ad will be : " D DD^% DT W Y
  217    . S DATA( "EFFDATE") =EFFDT
  218    . S X1=EF FDT,X2=-1  D C^%DTC
  219    . S DATA( "TERMDATE" )=X
  220    . W !,"Ar e you sure : " S %=1  D YN^DICN 
  221    . I %=-1  S OK=-1,ST OP=1 Q
  222    . I %=1 S  OK=1
  223    I OK=-1 Q
  224    ;S DATA(" EFFDATE")= DATA("YR") _"1001"                 ; effect ive   date  always Oc t  1st
  225    ;S DATA(" TERMDATE") =DATA("YR" )_"0930"                ; termin ation date  always Se p 30th
  226    Q
  227   HDR ; do a  pagefeed  and then p rint the p rocess hea der to the  screen
  228    ;
  229    W @IOF,!, "  THE HAC  CHAMPVA I CD-10 MAIN TENANCE LO AD PROCESS ",!,$E(LN, 1,51),!
  230    Q
  231    ;
  232   LOAD ; loa d the data  file
  233    ;
  234    S DATA("S TTM")=$$NO W^CHIUTIL( ) ; start  time
  235    W !!,"  . .. *Proces sing Mappi ng Tool Up date* ..."
  236    W !!,"  P rocessing  data file. ..     ",D ATA("FILE" ),!!?20,"P rocessing  Started :  ",DATA("ST TM")
  237    W !!,"  . .. Please  be patient ",!,"  ...  wait for  processing  to comple te",!!
  238    S A=$ZUTI L(68,40,1)  K @GLOBAL
  239    U IO F Y= 1:1 R X Q: $ZEOF=-1   Q:X=""  S  @GLOBAL@(Y )=X
  240    C IO
  241    Q
  242    ;
  243    ;
  244   PARSEM ; p arse AI ma pping data  for add t o DX and P CS file
  245    ;
  246    U 0 S $ZT =""
  247    S DATA("F MTM")=$$NO W^CHIUTIL( ) ; FileMa n load sta rt time
  248    W !?18,"F ileMan Loa d Started  : ",DATA(" FMTM")
  249    W !!,"  . .. Parsing  the mappi ng tool fi le",!
  250    ; set up  DATA array  with Optu m vendor d ata (start  Y=2 to by pass heade rs)
  251    F BY=2:1  S SL=$G(@G LOBAL@(BY) ) Q:SL=""   D PARSEM1
  252    Q
  253   PARSEM1 ; 
  254    ;
  255    ; *** nex t line nec essary at  this point  to format  mapping t ool files  *** Glaz d eveloped f unction ca ll -lg 3/8 /12
  256    S SL=$S(D ATA("RT")= "D":$$MTFI XCM^CHICDO L(SL),1:$$ MTFIXPCS^C HICDOL(SL) )  ; *** f unction to  realign s preadsheet  colums ** * -lg 3/8/ 12
  257    ;
  258    S DATA("C ODE")=$TR( $P(SL,U)," x","X") ;  ICD code
  259    S DATA("N AME")=$P(S L,U,2)  ;  Code Name
  260    S DATA("C VA")=+$P(S L,U,5)  ;  ChampVA AI  test valu e      - C VA is ien  #1 in file  #741002.9 4
  261    S DATA("S B")=+$P(SL ,U,6)   ;  Spina Bifi da AI test  value - S B  is ien  #6 in file  #741002.9 4
  262    ; next tw o lines ar e to chang e CVA and  SB value f rom extern al to inte rnal IEN f ormat
  263    S DATA("C VA")=$O(^D IC(741100, "B","TEST  #"_DATA("C VA"),""))
  264    S DATA("S B")=$O(^DI C(741100," B","TEST # "_DATA("SB "),""))
  265    S DATA("D UZ")=$P(SL ,U,12)  ;  DUZ of use r approvin g AI test  mapping
  266    S DATA("D T")=$P(SL, U,13)   ;  date user  approved A I test map ping
  267    S DATA("S TATUS")=$P (SL,U,14)    ; Optum  status
  268    ; If it i s incomple te, don't  stamp 0, d elete the  data with  "@".  File man is def ined as 
  269    ; set of  codes 1:SU BDIVIDED C ODE; so 0  is not val id value.
  270    S DATA("S UBDIV")=$S ($P(SL,U,1 5)="I":1,1 :"@")   ;  Optum Comp lete
  271    ;
  272    S IEN=+$$ GETIEN^CHI VFI($S(DAT A("RT")'=" D":$TR(DAT A("CODE"), "."),1:DAT A("CODE")) ,DATA("RT" )) ; modul e to match  the code  in the map ping file  with the I EN in the  live file
  273    ;I 'IEN S  @GLOBAL@( "NO IEN FO UND",DATA( "CODE"))=" " Q  ; qui t if IEN n ot found * ** do we w ant to sto re if we d on't find  and IEN? * ** -lg 2/1 7/12
  274    ; next fe w cases ch eck 'Statu s' of reco rd
  275    ; N = NEW
  276    ; C = CHA NGE
  277    ; D = DEL ETED
  278    ; R = REI NSTATED
  279    ; U = UNO FFICIAL CH ANGE
  280    ;;W !,DAT A("STATUS" )," / ",$G (IEN)," /  ",SL
  281    S I=$I(DA TA(DATA("S TATUS")))
  282    I DATA("S TATUS")="D " D DEACT    ; set te rmination  date
  283    I DATA("S TATUS")="R " D REACT    ; see RE ACT module
  284    I DATA("S TATUS")="C "!(DATA("S TATUS")="U ") D CHANG E(IEN)
  285    I DATA("S TATUS")="N " D ADD  ;  populate  appropriat e file
  286    ; count c ode types  for stats
  287    S @$S(DAT A("RT")="D ":"DATA("" DXCNT"")=D ATA(""DXCN T"")+1",1: "DATA(""PC SCNT"")=DA TA(""PCSCN T"")+1")
  288    I $X>0 W  !,BY," ",S L,!
  289    Q
  290    ;
  291   DEACT ; co de deactiv ation
  292    ; Nothing  to deacti vate
  293    I 'IEN Q
  294    ; Set DX  terminatio n date
  295    I DATA("R T")="D" D
  296    . Q:'$D(^ CHMICDX(IE N,0))
  297    . S:$P(^C HMICDX(IEN ,0),U,23)= "" $P(^CHM ICDX(IEN,0 ),U,23)=DA TA("TERMDA TE")
  298    . ;S Y=$O (^CHMICDX( IEN,103,0) ) Q:'Y
  299    . ;S:$P(^ CHMICDX(IE N,103,Y,0) ,U,2)="" $ P(^CHMICDX (IEN,103,Y ,0),U,2)=D ATA("TERMD ATE")
  300    . Q
  301    ; PCS is  defined wi th the mos t recent h istory ent ry being a ctive
  302    I DATA("R T")="P" D
  303    . S Y=$O( ^CHMSERV(I EN,1,0)) Q :'Y
  304    . Q:$P($G (^CHMSERV( IEN,1,Y,0) ),U)'="" ;  If alread y terminat ed, we are  done
  305    . S $P(^C HMSERV(IEN ,1,Y,0),U) =DATA("TER MDATE") ;  not settin g B xref s ince uncov entional u se multipl e
  306    . Q
  307    Q
  308   REACT ; co de mainten ace reacti vation (R: reinstated )
  309    ; *** the re could b e addition al changes  when rein stating a  code ? cal l CHANGE m odule just  in case * ** -lg 3/1 5/12
  310    I DATA("R T")="D" D   Q
  311    . I 'IEN  D DXI Q  ;  add ICD c ode if ICD  code not  found in f ile
  312    . ; clear  terminati on date
  313    . D CHANG E(IEN) ; c all CHANGE  to create  history a nd save da ta
  314    . ; clear  terminati on date
  315    . S $P(^C HMICDX(IEN ,0),U,23)= ""
  316    . Q
  317    I DATA("R T")="P" D   Q
  318    . I 'IEN  D PCSI Q   ; add ICD  code if IC D code not  found in  file
  319    . ; *** 3 /15/12 cal l to CHANG E implemen ted in cas e addition l changes  during rei nstate nex t line not  needed? * ** -lg
  320    . ;I $D(^ CHMSERV(IE N,0)) S Y= $O(^CHMSER V(IEN,1,0) ) I Y,$P($ G(^CHMSERV (IEN,1,Y,0 )),U) S $P (^CHMSERV( IEN,1,Y,0) ,U)=""
  321    . D CHANG E(IEN) ; c all CHANGE  just in c ase there  are additi onal chang es beside  just reins tating the  code
  322    Q
  323   CHANGE(DA)  ; for cod es with a  status of  C:change U :unofficia l change R :reinstate d
  324    ;
  325    S DIE=$S( DATA("RT") ="D":"^CHM ICDX(",1:" ^CHMSERV(" )
  326    I +$G(IEN )=0 G ADD
  327    D DXIC:DA TA("RT")=" D",PCSIC:D ATA("RT")= "P"
  328    Q
  329    ;
  330   ADD 
  331    I IEN D   Q
  332    . ; There  is record  already f or some re ason
  333    . K DA S  DA=IEN D D XIC:DATA(" RT")="D",P CSIC:DATA( "RT")="P"
  334    D DXI:DAT A("RT")="D ",PCSI:DAT A("RT")="P "
  335    Q
  336    ; mapping  file inge st FileMan  call to p opulate AI  test Prog ram Indica tor multip le
  337    ;S DA=IEN ,DIE=$S(DA TA("RT")=" D":"^CHMIC DX(",1:"^C HMSERV(")
  338    ;F CT="CV A","SB" D
  339    ;. S DATA (.01)=$S(C T="CVA":1, 1:6),DATA( .02)=DATA( CT),DATA(. 03)=DATA(" DUZ")
  340    ;. S DATA (.04)=DATA ("DT")
  341    ;. I DATA ("RT")="D"  D
  342    ;. . S DR ="102///^S  X=DATA(.0 1)" ; this  is the Pr ogram Indi cator mult iple that  holds AI t est inform ation for  various pr ograms (fr om mapping  data)
  343    ;. . S DR (2,741006. 05102)=".0 1////^S X= DATA(.01); .02////^S  X=DATA(.02 );.03////^ S X=DATA(. 03);.04/// /^S X=DATA (.04)"
  344    ;. I DATA ("RT")="P"  D
  345    ;. . S DR ="102////^ S X=DATA(. 01)" ; thi s is the P rogram Ind icator mul tiple that  holds AI  test infor mation for  various p rograms (f rom mappin g data)
  346    ;. . S DR (2,741006. 0102)=".01 ////^S X=D ATA(.01);. 02////^S X =DATA(.02) ;.03////^S  X=DATA(.0 3);.04//// ^S X=DATA( .04)"
  347    ;. S DIC= DIE,DIC(0) ="L" D ^DI E
  348    Q
  349   DXI ; make  FileMan c all to pop ulate CHAM PVA ICD DI AGNOSIS fi le (#74100 6.05)
  350    ; create  a new reco rd
  351    F  S DA=$ P(^CHMICDX (0),U,3)+1  I '$D(^CH MICDX(DA))  S $P(^CHM ICDX(0),U, 3)=DA,IEN= DA Q
  352    S $P(^CHM ICDX(0),U, 4)=$P(^CHM ICDX(0),U, 4)+1
  353   DXIC ; mid -entry poi nt to make  changes t o existing  DX codes
  354    ; SET Fil eMan DR va riable (fi eld edit s tring)
  355    S DIE="^C HMICDX(",D IC=DIE
  356    ; create  history fo r old entr y
  357    I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D 
  358    . N DINUM ,SUB,DABK
  359    . S DABK= DA
  360    . ; using  DINUM via  FileMan t o set the  END DATE m ultiple fi eld (#1) t hen settin g .01 fiel d (END DAT E) NULL in  module PC SI
  361    . S OED=$ P(^CHMICDX (DA,0),U,2 2),ONAME=$ P(^CHMICDX (DA,0),U), OTERM=$P(^ CHMICDX(DA ,0),U,23), OSUBDIV=$P (^CHMICDX( DA,0),U,16 )
  362    . S:DATA( "STATUS")' ="R" OTERM =DATA("TER MDATE")
  363    . S (DINU M,SUB)=(99 99999-OED)  
  364    . K DR S  DR="103/// ^S X=OED"
  365    . I $D(^C HMICDX(DA, 103,DINUM, 0)) K ^CHM ICDX(DA,10 3,"B",+^CH MICDX(DA,1 03,DINUM,0 )),^CHMICD X(DA,103,D INUM,0)
  366    . S DR(2, 741006.051 03)=".01// /^S X=OED; .02///^S X =OTERM;.03 ///^S X=ON AME;.04/// ^S X=OSUBD IV"
  367    . S DIC=D IE,DIC(0)= "L" D ^DIE
  368    . K DA S  DA=DABK
  369    S DATA("C AT")=$L($T R(DATA("NA ME"),".")) ,DATA("CAT ")=$S(DATA ("CAT")=3: 1,DATA("CA T")=4:2,DA TA("CAT")= 5:3,1:4) ; define cat egory fiel d#3 ;ICD-1 0 RCS Bug  36
  370    K DR S DR =".01////^ S X=DATA(" "NAME"");1 ///^S X=DA TA(""CODE" ");2////D"
  371    S DR=DR_" ;3////^S X =DATA(""CA T"");15/// ^S X=DATA( ""SUBDIV"" );24////1"
  372    S DR=DR_" ;22///^S X =DATA(""EF FDATE"")"
  373    S DIC=DIE ,DIC(0)="L " D ^DIE I  $X>0 S GL AZBR=1
  374    D MFI
  375    Q
  376   PCSI ; mak e FileMan  call to po pulate CHA MPVA SERVI CES file ( #741006)
  377    K DA F  S  DA=$P(^CH MSERV(0),U ,3)+1 I '$ D(^CHMSERV (DA)) S $P (^CHMSERV( 0),U,3)=DA ,IEN=DA Q
  378    S $P(^CHM SERV(0),U, 4)=$P(^CHM SERV(0),U, 4)+1
  379   PCSIC ; mi d-entry po int to mak e changes  to existin g PCS code s
  380    S DIE="^C HMSERV(",D IC=DIE
  381    S OLDR=$G (^CHMSERV( DA,0))
  382    S DATA("O SUBDIV")=$ P(OLDR,U,9 )
  383    I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D 
  384    . ; termi nate curre nt PCS cod e descript ion before  applying  change ***  -lg 3/7/1 2
  385    . ; for P CS change  must first  terminate  existing  descriptio n *** -lg  3/7/12
  386    . ; if th e current  effective  date is sa me as the  last effec tive date  clear the  node to ad d the desc ription ch ange
  387    . S Y=$O( ^CHMSERV(D A,1,0)) I  Y D  Q
  388    . . I Y=( 9999999-DA TA("EFFDAT E")) K ^CH MSERV(DA,1 ,Y) Q
  389    . . I $D( ^CHMSERV(D A,1,Y,0)), '$P(^CHMSE RV(DA,1,Y, 0),U) S $P (^(0),U)=D ATA("TERMD ATE"),$P(^ (0),U,10)= DATA("OSUB DIV")
  390    ; update  main recor d
  391    K DR S DR =".01///"_ $TR(DATA(" CODE"),"." )_";.05/// ^S X=""ICD -10"";.09/ //^S X=DAT A(""SUBDIV "")"
  392    S DIC=DIE ,DIC(0)="L " D ^DIE
  393    ; update  the 
  394    N DINUM,S UB
  395    S (DINUM, SUB)=(9999 999-DATA(" EFFDATE"))       ; DI NUM to set  uncoventi onal 'END  DATE' mult iple struc ture 
  396    ; using D INUM via F ileMan to  set the EN D DATE mul tiple fiel d (#1) the n setting  .01 field  (END DATE)  NULL in m odule PCSI
  397    K DR S DR ="1///^S X =DATA(""EF FDATE"")"
  398    S DR(2,74 1006.01)=" .01///^S X =DATA(""EF FDATE"");. 09///^S X= DATA(""EFF DATE"");30 .01///^S X =DATA(""NA ME"");.1// /^S X=DATA (""SUBDIV" ")"
  399    ; if it i s already  there, kil l it, we a re setting  it again
  400    K ^CHMSER V(DA,1,DIN UM)
  401    S DIC=DIE ,DIC(0)="L " D ^DIE
  402    S $P(^CHM SERV(DA(1) ,1,SUB,0), U)=""            ; se t uncovent ional 'END  DATE' mul tiple .01  field equa l to ""
  403    K ^CHMSER V(DA(1),1, "B",DATA(" EFFDATE"), SUB)  ; no w kill the  B-xref on  the uncov entional s etting of  the 'END D ATE' .01 f ield
  404    D MFI
  405    Q
  406   MFI ;
  407    ; mapping  file inge st FileMan  call to p opulate AI  test Prog ram Indica tor multip le
  408    N DA,DR,I ,X,Y ; new  DA,DR to  get pertin ent DA,DR  for DIAGNO SIS entrie s without  affecting  data for V endor Data  file #741 033
  409    K DA S DA =IEN,DIE=$ S(DATA("RT ")="D":"^C HMICDX(",1 :"^CHMSERV (")
  410    S TG=$E(D IE,1,*-1)
  411    ;F PI="CV A","SB" D
  412    . ;S DATA ("PI")=$S( PI="CVA":1 ,1:6),DATA ("AI")=DAT A(PI),DA(1 )=DATA("PI ")
  413    . ;K DR S  DR="102// /^S X=DATA (""PI"")"  ; this is  the Progra m Indicato r multiple  that hold s AI test  informatio n for vari ous progra ms (from m apping dat a)
  414    . ;S DR(2 ,$S(DATA(" RT")="D":7 41006.0510 2,1:741006 .0102))=". 01////^S X =DATA(""PI "");.02/// /^S X=DATA (""AI"");. 03////^S X =DATA(""DU Z"");.04// //^S X=DAT A(""DT"")"
  415    . ;S DIC= DIE,DIC(0) ="L" D ^DI E
  416    I DATA("C VA")'="" D
  417    . I $D(@T G@(IEN,102 ,1,0))
  418    . . S HN= $O(@TG@(IE N,102,1,10 1,"A"),-1) +1
  419    . . I DAT A("CVA")=$ P(@TG@(IEN ,102,1,0), "^",2) Q
  420    . . S @TG @(IEN,102, 1,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN
  421    . . S @TG @(IEN,102, 1,101,HN,0 )=@TG@(IEN ,102,1,0)
  422    . . S @TG @(IEN,102, 1,101,"B", 1,HN)=""
  423    . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT")
  424    . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,1 ,0)),"^",3 )
  425    . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,1,0 )),"^",4)
  426    . S @TG@( IEN,102,1, 0)="1^"_DA TA("CVA")_ "^"_DDUZ_" ^"_DDT
  427    . S @TG@( IEN,102,"B ",1,1)=""
  428    I DATA("S B")'="" D
  429    . I $D(@T G@(IEN,102 ,6,0))
  430    . . S HN= $O(@TG@(IE N,102,6,10 1,"A"),-1) +1
  431    . . I DAT A("SB")=$P (@TG@(IEN, 102,6,0)," ^",2) Q
  432    . . S @TG @(IEN,102, 6,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN
  433    . . S @TG @(IEN,102, 6,101,HN,0 )=@TG@(IEN ,102,6,0)
  434    . . S @TG @(IEN,102, 6,101,"B", 1,HN)=""
  435    . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT")
  436    . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,6 ,0)),"^",3 )
  437    . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,6,0 )),"^",4)
  438    . S @TG@( IEN,102,6, 0)="6^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT
  439    . S @TG@( IEN,102,"B ",6,6)=""
  440    I DATA("S B")'="" D
  441    . I $D(@T G@(IEN,102 ,7,0))
  442    . . S HN= $O(@TG@(IE N,102,7,10 1,"A"),-1) +1
  443    . . I DAT A("SB")=$P (@TG@(IEN, 102,7,0)," ^",2) Q
  444    . . S @TG @(IEN,102, 7,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN
  445    . . S @TG @(IEN,102, 7,101,HN,0 )=@TG@(IEN ,102,7,0)
  446    . . S @TG @(IEN,102, 7,101,"B", 1,HN)=""
  447    . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT")
  448    . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,7 ,0)),"^",3 )
  449    . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,7,0 )),"^",4)
  450    . S @TG@( IEN,102,7, 0)="7^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT
  451    . S @TG@( IEN,102,"B ",7,7)=""
  452    I DATA("C VA")+DATA( "SB") D
  453    . S X=0 F  I=0:1 S X =$O(@TG@(I EN,102,X))  Q:'X
  454    . S @TG@( IEN,102,0) ="^741006. 0"_$S(DATA ("RT")="D" :5102,1:10 2)_"^"_$O( @TG@(IEN,1 02,"A"),-1 )_"^"_I
  455    Q
  456    ;
  457   EOF ; come  here on e nd of file  error; OR  ANY OTHER  error -lg
  458    ;
  459    S ER=$ZE
  460    I IO'=""  C IO U 0
  461    I ER["<EN DOFFILE>"  D  G EN1   ; continue  on with l oad @EN1
  462    .W !,"  . .. End of  File reach ed ...",!! ,"  ... St arting Fil eMan file  load ... " ,!
  463    .S DATA(" FMTM")=$$N OW^CHIUTIL () ; FileM an load st art time
  464    .W !?18," FileMan Lo ad Started  : ",DATA( "FMTM")
  465    .Q
  466    I ER'=""  W !!," ***  A System  error has  occurred!  ***",!!?4, ER,!!
  467    W $E(LN,1 ,39),!
  468    R !!,"    Press <Ent er> to con tinue ",*X
  469    Q
  470   TERMINATE  ;
  471    F  R !,CO DE D
  472    . S IEN=0
  473    . I CODE? 1"S42".E D   Q
  474    . . S IEN =$$GETIEN^ CHIVFI(COD E,"D")
  475    . . I IEN ,$D(^CHMIC DX(IEN,0)) ,'$P(^CHMI CDX(IEN,0) ,U,23) S $ P(^CHMICDX (IEN,0),U, 23)=311093 0 W " ",IE N," done"  Q
  476    . I CODE' ["-" D  Q
  477    . . S IEN =$$GETIEN^ CHIVFI(COD E,"P") W ! ,"*",CODE, " ",IEN
  478    . . I IEN  S Y=$O(^C HMSERV(IEN ,1,0)) I Y '="",'$P($ G(^CHMSERV (IEN,1,Y,0 )),U) S $P (^CHMSERV( IEN,1,Y,0) ,U)=311093 0 W " done ",! ZW ^CH MSERV(IEN, 1) W ! Q
  479    . S CODE= $TR(CODE,"  "),SCODE= $P(CODE,"- ") 
  480    . F  D  Q :SCODE>$P( CODE,"-",2 )
  481    . . S IEN =$$GETIEN^ CHIVFI(SCO DE,"P") W  !,"**",SCO DE," ",IEN
  482    . . I IEN  S Y=$O(^C HMSERV(IEN ,1,0)) I Y ,'$P($G(^C HMSERV(IEN ,1,Y,0)),U ) S $P(^CH MSERV(IEN, 1,Y,0),U)= 3110930 W  !,SCODE,"  done",! ZW  ^CHMSERV( IEN,1) W !  Q
  483    . . S SCO DE=$O(^CHM SERV("B",S CODE))
  484    . Q
  485    Q