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

62.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHIVFI3.m Mon Nov 5 16:41:38 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHIVFI3.m Fri Nov 9 01:27:15 2018 UTC

62.2 Comparison summary

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

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

62.4 Active regular expressions

No regular expressions were active.

62.5 Comparison detail

  1   CHIVFI3 ;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    ;;10/4/16  DPT MTN02 6936 FY201 7 ROUTINE  IS A CLONE  OF CHIVFI 2, BYPASS  READING FR OM MAPPING  TOOL READ  AND LOAD  FROM _CHAN GE_ FILE
  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 ICDENV= $ZU(5)
  34    S:ICDENV= "HAC" IOBA SE="HAC_HF S$:[SCR.TE MP_FILES.F S3BIG.CODE UPDT.ICD10 UPDT.FY201 3]"
  35    S:ICDENV' ="HAC" IOB ASE="MISC7 $:[DSMMANA G.CHAMPVA. TEMP_FILES .FS3BIG.CO DEUPDT.ICD 10UPDT.FY2 013]"
  36    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  37    ;S EDT="1 0/1/2014"  D READ1
  38    S IO=IOBA SE_"ICD10C M_APPVD_03 _24_2014_1 2_41_14.CS V"
  39    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  40    S DATA("R T")="D"
  41    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  42    ; 
  43    ; PCS
  44    ;
  45    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  46    S IO=IOBA SE_"ICD10P CS_APPVD_0 3_24_2014_ 12_42_13.C SV"
  47    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  48    S DATA("R T")="P"
  49    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  50    Q
  51   AUTO2014(E FFDT) ;
  52    S AUTO=1
  53    W #,"Begi nning Load  of FY2014  Mapping T ool files"  H 1
  54    S AUTO=1
  55    K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y
  56    K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J
  57    S $ZE=""
  58    I $G(EFFD T)="" S EF FDT=314101 0
  59    S X1=EFFD T,X2=-1 D  C^%DTC
  60    S TERMDT= X
  61    ;
  62    K SFILES
  63    ;09/29/15  SBB DEF01 6554 fix f or decnet
  64    ;S IOBASE ="HACFS3"" DNS       HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10UP DT.FY2014] "
  65    S ICDENV= $ZU(5)
  66    S:ICDENV= "HAC" IOBA SE="HAC_HF S$:[SCR.TE MP_FILES.F S3BIG.CODE UPDT.ICD10 UPDT.FY201 4]"
  67    S:ICDENV' ="HAC" IOB ASE="MISC7 $:[DSMMANA G.CHAMPVA. TEMP_FILES .FS3BIG.CO DEUPDT.ICD 10UPDT.FY2 014]"
  68    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  69    ;S EDT="1 0/1/2014"  D READ1
  70    S IO=IOBA SE_"ICD10C M_APPVD_AU G2013_07_0 8_2014_08_ 36_21.csv"
  71    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  72    S DATA("R T")="D"
  73    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  74    ;
  75    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  76    S IO=IOBA SE_"ICD10C M_APPVD_JA N2014_07_2 3_2014_13_ 07_11.csv"
  77    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  78    S DATA("R T")="D"
  79    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  80    ;
  81    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  82    S IO=IOBA SE_"ICD10C M_APPVD_MA R2014_07_2 8_2014_12_ 10_35.csv"
  83    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  84    S DATA("R T")="D"
  85    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  86    ; 
  87    ; PCS
  88    ;
  89    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  90    S IO=IOBA SE_"ICD10P CS_APPVD_A UG2013_07_ 08_2014_08 _36_49.csv "
  91    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  92    S DATA("R T")="P"
  93    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  94    ; 
  95    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  96    S IO=IOBA SE_"ICD10P CS_APPVD_J AN2014_07_ 23_2014_13 _08_11.csv "
  97    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  98    S DATA("R T")="P"
  99    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  100    ;
  101    D INIT,HD R S DATA(" EFFDATE")= EFFDT,DATA ("TERMDATE ")=TERMDT
  102    S IO=IOBA SE_"ICD10P CS_APPVD_M AR2014_07_ 28_2014_12 _05_48.csv "
  103    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  104    S DATA("R T")="P"
  105    D OPEN:'S TOP,LOAD:' STOP,EN1:' STOP
  106    Q
  107    ; 
  108   EN ; entry  point for  ingesting  data file (s)
  109    ;
  110    K D,DA,DD ,DX,DATA,E R,F,IO,IOF ,LN,PCS,SE L,STOP,U,X ,Y
  111    K FILE,RF ILE,UFILE, MMODE,GLOB AL,FX,DUZ, DR,DIR,DIC ,DIE,TXT,I ,J
  112    S $ZE=""
  113    ;S $ZT="E OF^CHIVFI2 " ; necess ary error  trapping l ogic for p rocess to  complete
  114    ; Modules  called:
  115    ; INIT =  initialize  variables
  116    ; HDR  =  prints pro cess page  header
  117    ; READ =  gets file  type and f ile data I O string.  Also gets  Vendor nam e if a (B) ase file l oad
  118    ; OPEN =  opens the  file retur ned in the  IO string  from the  READ modul e
  119    ; LOAD =  loads file  data into  a tempora ry global  for proces sing. The  temporary  global is  defined in  the INIT  module
  120    ;
  121    D INIT,HD R,READ,HDR :'STOP,OPE N:'STOP,LO AD:'STOP
  122    ;
  123   EN1 ; cont inue proce ssing -lg
  124    ; 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
  125    ; 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
  126    ; to the  screen and  processin g will com e to a sto p and retu rn the use r to the m enu option .
  127    ; call to  parse dat a for inst allation t o Diagnosi s file (#7 41006.05)  and Servic es file (# 741006)
  128    ; Modules  called:
  129    ; 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
  130    ; PARSEM  = module i n this rou tine calle d to proce ss (M)appi ng type da ta files
  131    ;
  132    D:'STOP P ARSEM
  133    I 'STOP D   ; print  process st atistics i f processi ng complet e
  134    .S DATA(" CTM")=$$NO W^CHIUTIL( )
  135    .W !,"  T he "_$S(DA TA("LDTYP" )="B":"ICD -10",1:"") _" load pr ocess is C omplete!", ?38," : ", DATA("CTM" )
  136    .W !!,$E( LN,1,41),!
  137    .; put lo ad statist ics here * *
  138    .W !,"           Pro cessing St arted : ", DATA("STTM ")
  139    .W !,"         FileM an Load St arted : ", DATA("FMTM ")
  140    .W !,"         Proce ssing Comp leted : ", DATA("CTM" )
  141    .W !!,"    Total ICD  Diagnosis  Codes : " ,$J(DATA(" DXCNT"),7)
  142    .W !,"    Total ICD  Procedure  Codes : ", $J(DATA("P CSCNT"),7)
  143    .W !,"                   Total  Codes : ", $J(DATA("D XCNT")+DAT A("PCSCNT" ),7)
  144    .I 'MMODE ,$G(DATA(" D")) D
  145    ..W !,"       Total  D Status R ecords : " ,$J(DATA(" D"),7)
  146    ..W !,"    Subtotal  Added to F ile(s) : " ,$J((DATA( "DXCNT")+D ATA("PCSCN T"))-DATA( "D"),7)
  147    ..Q
  148    .Q
  149    W !!,$E(L N,1,41),!
  150    R:$G(AUTO )'=1 !!,"    Press <E nter> to c ontinue ", *X
  151    ; if in m aitenance  mode print  the recor d status'
  152    I 'STOP,$ G(DATA("LD TYP"))="M" ,MMODE W @ IOF,$E(LN, 1,41),!! D   Q
  153    .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
  154    ..W !,"               Total ",X ," Records  : ",$J(+$ G(DATA(X)) ,7)
  155    ..Q
  156    .W !!,$E( LN,1,41),!
  157    .R:$G(AUT O)'=1 !!,"    Press < Enter> to  continue " ,*X
  158    .Q
  159    ;
  160    K @GLOBAL   ; kill d ata in tem porary sto rage globa l
  161    Q
  162   INIT ; iti alize some  required  variables
  163    ;
  164    N MM,DD
  165    S U="^",D UZ=1,DUZ(0 )="@"                             ; *** FOR  TESTING * ** -lg
  166    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
  167    ;
  168    S GLOBAL= "^UTILITY( $J,""ICD"" )" K @GLOB AL          ; tempora ry data st orage glob al
  169    S STOP=0, $P(LN,"_", 80)=""                            ; process ing STOP f lag, line  characters
  170    S (DATA(" DXCNT"),DA TA("PCSCNT "))=0                  ; Diagnos is and Pro cedure rec ord counte rs
  171    S MMODE=1                                                                    ; MMODE =  maintenan ce mode
  172    S DATA("D ATE")=$P($ $FMDT^CHIU TIL(),".")             ; today's  date
  173    ; set eff ective yea r - effect ive and te rmination  dates alwa ys 10/01 a nd 09/30 r espectivel y
  174    ; 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
  175    S DATA("Y R")=$E(DAT A("DATE"), 1,3)-(($E( DATA("DATE "),4,5))'> 9) ; effec tive year
  176    S DATA("E FFDATE")=D ATA("YR")_ "1001"                 ; effecti ve   date  always Oct   1st
  177    S DATA("T ERMDATE")= DATA("YR") _"0930"                ; termina tion date  always Sep  30th
  178    Q
  179   OPEN ; OPE N vendor d ata file
  180    ;
  181    W !!,"  S tarting... " ; messag e to indic ate ingest  process i s starting
  182    O IO:"R": 10 ; open  load file  with a 10  second tim eout
  183    ; if unab le to open  the file  notify the  user and  set the 'S TOP' flag  to stop al l further  processing
  184    I '$T D    S STOP=1  Q
  185    .W !!,"Un able to op en "_DATA( "FILE"),!! ,"Please m ake sure t he file na me is corr ect.",!!
  186    Q
  187   READ ; pro mpt user t o select d ata file f or ingest
  188    ;
  189    ;K IN S I N=0,IN("DI R")="HACFS 3"" DNS       HACdec741! ""::D:[FS3 BIG.CODEUP DT.ICD10MA PPINGTOOL. MAINT]"
  190    ;S IN("FI LES")="*.C SV"
  191    S IO=$$ME NU^CHICDOL (.IN,.SEL, 0) I IO=""  S STOP=1  Q
  192    ;S IO=$$M ENU^CHICDO L(.IN,.SEL ,1) I IO=" " S STOP=1  Q
  193    ;S SEL("F ILETYPE")= "C" ;10/4/ 16 DPT
  194    S SEL("FI LETYPE")=" M"
  195    ; get dat a filename  and data  file type:  either (B )ase or (M )apping or  (C)hange
  196    S DATA("F ILE")=$P(I O,"]",2),D ATA("LDTYP ")="M"
  197    ; get rec ord type i n data fil e: either  Diagnosis  or Procedu re code re cords
  198    S DATA("R T")=$S(SEL ("CODETYPE ")="C":"D" ,1:"P")
  199    ; change  the date l ogic from  what origi nal was do ing to fil ename date  forwarded  to next F Y border
  200    S CHG="", CHG=$S(IO[ "CHANGE":" CHG")
  201    S EDT=$G( SEL("WNAME ")) Q:EDT= ""
  202    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:"")
  203    S EDT=$P( EDT,"_",1, 3),EDT=$P( EDT," "),E DT=$TR(EDT ,"_","/")
  204    S:$P(EDT, "/",3)?2N  $P(EDT,"/" ,3)="20"_$ P(EDT,"/", 3)
  205    ;S EDT=$P (EDT,"_",3 )-1700_$P( EDT,"_")_$ P(EDT,"_", 2)
  206    ;S DATA(" DATE")=EDT
  207    ;S DATA(" YR")=$E(DA TA("DATE") ,1,3)-(($E (DATA("DAT E"),4,5))' >9)+1 ; ef fective ye ar
  208    S OK=0 
  209   READ1 ;
  210    F  D  Q:O K'=0
  211    . S %DT(" A")="Pleas e enter th e Effectiv e Date for  this load : "
  212    . S %DT(" B")="10/01 /"_($P(EDT ,"/",3)+1)
  213    . ;E  S % DT("B")=ED T
  214    . S %DT=" AE"
  215    . I '$D(D T) D NOW^% DTC S DT=X  
  216    . ;S %DT( 0)=DT 
  217    . D ^%DT
  218    . I X="^"  S OK=-1,S TOP=1 Q
  219    . ;I Y<DT  W !!,"Ple ase select  a date th at is not  in the pas t.",! Q
  220    . ;I Y<ED T W !,"You  can't pic k the date  before th e spreadsh eet date"  Q
  221    . S EFFDT =Y
  222    . W !,"Th e Effectiv e Date for  this main tenance lo ad will be : " D DD^% DT W Y
  223    . S DATA( "EFFDATE") =EFFDT
  224    . S X1=EF FDT,X2=-1  D C^%DTC
  225    . S DATA( "TERMDATE" )=X
  226    . W !,"Ar e you sure : " S %=1  D YN^DICN 
  227    . I %=-1  S OK=-1,ST OP=1 Q
  228    . I %=1 S  OK=1
  229    I OK=-1 Q
  230    ;S DATA(" EFFDATE")= DATA("YR") _"1001"                 ; effect ive   date  always Oc t  1st
  231    ;S DATA(" TERMDATE") =DATA("YR" )_"0930"                ; termin ation date  always Se p 30th
  232    Q
  233   HDR ; do a  pagefeed  and then p rint the p rocess hea der to the  screen
  234    ;
  235    W @IOF,!, "  THE HAC  CHAMPVA I CD-10 MAIN TENANCE LO AD PROCESS ",!,$E(LN, 1,51),!
  236    Q
  237    ;
  238   LOAD ; loa d the data  file
  239    ;
  240    S DATA("S TTM")=$$NO W^CHIUTIL( ) ; start  time
  241    W !!,"  . .. *Proces sing Mappi ng Tool Up date* ..."
  242    W !!,"  P rocessing  data file. ..     ",D ATA("FILE" ),!!?20,"P rocessing  Started :  ",DATA("ST TM")
  243    W !!,"  . .. Please  be patient ",!,"  ...  wait for  processing  to comple te",!!
  244    S A=$ZUTI L(68,40,1)  K @GLOBAL
  245    U IO F Y= 1:1 R X Q: $ZEOF=-1   Q:X=""  S  @GLOBAL@(Y )=X
  246    C IO
  247    Q
  248    ;
  249    ;
  250   PARSEM ; p arse AI ma pping data  for add t o DX and P CS file
  251    ;
  252    U 0 S $ZT =""
  253    S DATA("F MTM")=$$NO W^CHIUTIL( ) ; FileMa n load sta rt time
  254    W !?18,"F ileMan Loa d Started  : ",DATA(" FMTM")
  255    W !!,"  . .. Parsing  the mappi ng tool fi le",!
  256    ; set up  DATA array  with Optu m vendor d ata (start  Y=2 to by pass heade rs)
  257    F BY=2:1  S SL=$G(@G LOBAL@(BY) ) Q:SL=""   D PARSEM1
  258    Q
  259   PARSEM1 ; 
  260    ;
  261    ; *** 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
  262    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
  263    ;
  264    I CHG="CH G" D
  265      .S DATA ("CODE")=$ P(SL,U,1)   ; DPT MTN 026936
  266      .S DATA ("STATUS") =$P(SL,U,2 ) ; DPT MT N026936
  267      .S DATA ("TERMDT") =$P(SL,U,6 ) ; DPT MT N026936
  268      .S DATA ("OLD_DESC ")=$E($P(S L,U,8),1,4 8) ; DPT M TN026936
  269      .S DATA ("NEW_DESC ")=$E($P(S L,U,9),1,4 8) ; DPT M TN026936
  270      .S DATA ("CODE_TYP E")=$P(SL, U,10) ;  D PT MTN0269 36
  271      .S DATA ("SUBDIV") ="" ; DPT  MTN026936                                     
  272    I CHG'="C HG" D
  273     .S DATA( "CODE")=$T R($P(SL,U) ,"x","X")  ; ICD code
  274     .S DATA( "NAME")=$P (SL,U,2)   ; Code Nam e
  275     .S DATA( "CVA")=+$P (SL,U,5)   ; ChampVA  AI test va lue      -  CVA is ie n #1 in fi le #741002 .94
  276     .S DATA( "SB")=+$P( SL,U,6)    ; Spina Bi fida AI te st value -  SB  is ie n #6 in fi le #741002 .94
  277     ; next t wo lines a re to chan ge CVA and  SB value  from exter nal to int ernal IEN  format
  278     ;S DATA( "CVA")=$O( ^DIC(74110 0,"B","TES T #"_DATA( "CVA"),"") )
  279     ;S DATA( "SB")=$O(^ DIC(741100 ,"B","TEST  #"_DATA(" SB"),""))
  280     ;S DATA( "DUZ")=$P( SL,U,12)   ; DUZ of u ser approv ing AI tes t mapping
  281     ;S DATA( "DT")=$P(S L,U,13)    ; date use r approved  AI test m apping
  282     ;S DATA( "STATUS")= $P(SL,U,14 ) ; Optum  status
  283    ; If it i s incomple te, don't  stamp 0, d elete the  data with  "@".  File man is def ined as 
  284    ; set of  codes 1:SU BDIVIDED C ODE; so 0  is not val id value.
  285     .S DATA( "SUBDIV")= $S($P(SL,U ,15)="I":1 ,1:"@") ;  Optum Comp lete
  286    ;
  287    ;I CHG="C HG" D
  288    ; .S IEN= +$$GETIEN^ CHIVFI($S( DATA("STAT US")'="D": $TR(DATA(" CODE"),"." ),1:DATA(" CODE")),DA TA("STATUS ")) ; modu le to matc h the code  in the CH ANGE file  with the I EN in the  live file
  289    ;I CHG'=" CHG" D
  290    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
  291    ;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
  292    ; next fe w cases ch eck 'Statu s' of reco rd
  293    ; N = NEW
  294    ; C = CHA NGE
  295    ; D = DEL ETED
  296    ; R = REI NSTATED
  297    ; U = UNO FFICIAL CH ANGE
  298    ;;W !,DAT A("STATUS" )," / ",$G (IEN)," /  ",SL
  299    S I=$I(DA TA(DATA("S TATUS")))
  300    I DATA("S TATUS")="D " D DEACT    ; set te rmination  date
  301    I DATA("S TATUS")="R " D REACT    ; see RE ACT module
  302    I DATA("S TATUS")="C "!(DATA("S TATUS")="U ") D CHANG E(IEN)
  303    I DATA("S TATUS")="N " D ADD  ;  populate  appropriat e file
  304    ; count c ode types  for stats
  305    S @$S(DAT A("RT")="D ":"DATA("" DXCNT"")=D ATA(""DXCN T"")+1",1: "DATA(""PC SCNT"")=DA TA(""PCSCN T"")+1")
  306    I $X>0 W  !,BY," ",S L,!
  307    Q
  308    ;
  309   DEACT ; co de deactiv ation
  310    ; Nothing  to deacti vate
  311    I 'IEN Q
  312    ; Set DX  terminatio n date
  313    I DATA("R T")="D" D
  314    . Q:'$D(^ CHMICDX(IE N,0))
  315    . S:$P(^C HMICDX(IEN ,0),U,23)= "" $P(^CHM ICDX(IEN,0 ),U,23)=DA TA("TERMDA TE")
  316    . ;S Y=$O (^CHMICDX( IEN,103,0) ) Q:'Y
  317    . ;S:$P(^ CHMICDX(IE N,103,Y,0) ,U,2)="" $ P(^CHMICDX (IEN,103,Y ,0),U,2)=D ATA("TERMD ATE")
  318    . Q
  319    ; PCS is  defined wi th the mos t recent h istory ent ry being a ctive
  320    I DATA("R T")="P" D
  321    . S Y=$O( ^CHMSERV(I EN,1,0)) Q :'Y
  322    . Q:$P($G (^CHMSERV( IEN,1,Y,0) ),U)'="" ;  If alread y terminat ed, we are  done
  323    . 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
  324    . Q
  325    Q
  326   REACT ; co de mainten ace reacti vation (R: reinstated )
  327    ; *** 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
  328    I DATA("R T")="D" D   Q
  329    . I 'IEN  D DXI Q  ;  add ICD c ode if ICD  code not  found in f ile
  330    . ; clear  terminati on date
  331    . D CHANG E(IEN) ; c all CHANGE  to create  history a nd save da ta
  332    . ; clear  terminati on date
  333    . S $P(^C HMICDX(IEN ,0),U,23)= ""
  334    . Q
  335    I DATA("R T")="P" D   Q
  336    . I 'IEN  D PCSI Q   ; add ICD  code if IC D code not  found in  file
  337    . ; *** 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
  338    . ;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)=""
  339    . D CHANG E(IEN) ; c all CHANGE  just in c ase there  are additi onal chang es beside  just reins tating the  code
  340    Q
  341   CHANGE(DA)  ; for cod es with a  status of  C:change U :unofficia l change R :reinstate d
  342    ;
  343    S DIE=$S( DATA("RT") ="D":"^CHM ICDX(",1:" ^CHMSERV(" )
  344    I +$G(IEN )=0 G ADD
  345    D DXIC:DA TA("RT")=" D",PCSIC:D ATA("RT")= "P"
  346    Q
  347    ;
  348   ADD 
  349    I IEN D   Q
  350    . ; There  is record  already f or some re ason
  351    . K DA S  DA=IEN D D XIC:DATA(" RT")="D",P CSIC:DATA( "RT")="P"
  352    D DXI:DAT A("RT")="D ",PCSI:DAT A("RT")="P "
  353    Q
  354    ; mapping  file inge st FileMan  call to p opulate AI  test Prog ram Indica tor multip le
  355    ;S DA=IEN ,DIE=$S(DA TA("RT")=" D":"^CHMIC DX(",1:"^C HMSERV(")
  356    ;F CT="CV A","SB" D
  357    ;. S DATA (.01)=$S(C T="CVA":1, 1:6),DATA( .02)=DATA( CT),DATA(. 03)=DATA(" DUZ")
  358    ;. S DATA (.04)=DATA ("DT")
  359    ;. I DATA ("RT")="D"  D
  360    ;. . 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)
  361    ;. . 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)"
  362    ;. I DATA ("RT")="P"  D
  363    ;. . 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)
  364    ;. . 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)"
  365    ;. S DIC= DIE,DIC(0) ="L" D ^DI E
  366    Q
  367   DXI ; make  FileMan c all to pop ulate CHAM PVA ICD DI AGNOSIS fi le (#74100 6.05)
  368    ; create  a new reco rd
  369    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
  370    S $P(^CHM ICDX(0),U, 4)=$P(^CHM ICDX(0),U, 4)+1
  371   DXIC ; mid -entry poi nt to make  changes t o existing  DX codes
  372    ; SET Fil eMan DR va riable (fi eld edit s tring)
  373    S DIE="^C HMICDX(",D IC=DIE
  374    ; create  history fo r old entr y
  375    I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D 
  376    . N DINUM ,SUB,DABK
  377    . S DABK= DA
  378    . ; 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
  379    . 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 )
  380    . S:DATA( "STATUS")' ="R" OTERM =DATA("TER MDATE")
  381    . S (DINU M,SUB)=(99 99999-OED)  
  382    . K DR S  DR="103/// ^S X=OED"
  383    . 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)
  384    . S DR(2, 741006.051 03)=".01// /^S X=OED; .02///^S X =OTERM;.03 ///^S X=ON AME;.04/// ^S X=OSUBD IV"
  385    . S DIC=D IE,DIC(0)= "L" D ^DIE
  386    . K DA S  DA=DABK
  387    . I OSUBD IV=1 S DAT A("SUBDIV" )=1 ; DPT  MTN026936
  388    I CHG="CH G" D
  389    .K DR S D R=".01//// ^S X=DATA( ""NEW_DESC "");1///^S  X=DATA("" CODE"");2/ ///D" ; DP T MTN02693 6
  390    .S DR=DR_ ";22///^S  X=DATA(""E FFDATE""); 24////1" ;  DPT MTN02 6936
  391    .S DIC=DI E,DIC(0)=" L" D ^DIE  Q ; DPT MT N026936
  392    I CHG'="C HG"
  393     .S DATA( "CAT")=$L( $TR(DATA(" NAME"),"." )),DATA("C AT")=$S(DA TA("CAT")= 3:1,DATA(" CAT")=4:2, DATA("CAT" )=5:3,1:4)  ;define c ategory fi eld#3 ;ICD -10 RCS Bu g 36
  394    .K DR S D R=".01//// ^S X=DATA( ""NAME""); 1///^S X=D ATA(""CODE "");2////D "
  395    .S DR=DR_ ";3////^S  X=DATA(""C AT"");15// /^S X=DATA (""SUBDIV" ");24////1 "
  396    .S DR=DR_ ";22///^S  X=DATA(""E FFDATE"")"
  397    .S DIC=DI E,DIC(0)=" L" D ^DIE  I $X>0 S G LAZBR=1
  398    I CHG'="C HG" D MFI    ; DPT MT N026936
  399    Q
  400   PCSI ; mak e FileMan  call to po pulate CHA MPVA SERVI CES file ( #741006)
  401    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
  402    S $P(^CHM SERV(0),U, 4)=$P(^CHM SERV(0),U, 4)+1
  403   PCSIC ; mi d-entry po int to mak e changes  to existin g PCS code s
  404    S DIE="^C HMSERV(",D IC=DIE
  405    S OLDR=$G (^CHMSERV( DA,0))
  406    S DATA("O SUBDIV")=$ P(OLDR,U,9 )
  407    I DATA("S TATUS")="C "!(DATA("S TATUS")="U ")!(DATA(" STATUS")=" R") D 
  408    . ; termi nate curre nt PCS cod e descript ion before  applying  change ***  -lg 3/7/1 2
  409    . ; for P CS change  must first  terminate  existing  descriptio n *** -lg  3/7/12
  410    . ; 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
  411    . S Y=$O( ^CHMSERV(D A,1,0)) I  Y D  Q
  412    . . I Y=( 9999999-DA TA("EFFDAT E")) K ^CH MSERV(DA,1 ,Y) Q
  413    . . 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")
  414    . . I DAT A("OSUBDIV ")=1 S DAT A("SUBDIV" )=1  ; DPT  MTN026936
  415    ; update  main recor d
  416    K DR S DR =".01///"_ $TR(DATA(" CODE"),"." )_";.05/// ^S X=""ICD -10"";.09/ //^S X=DAT A(""SUBDIV "")"
  417    S DIC=DIE ,DIC(0)="L " D ^DIE
  418    ; update  the 
  419    N DINUM,S UB
  420    S (DINUM, SUB)=(9999 999-DATA(" EFFDATE"))       ; DI NUM to set  uncoventi onal 'END  DATE' mult iple struc ture 
  421    ; 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
  422    K DR S DR ="1///^S X =DATA(""EF FDATE"")"
  423    I CHG="CH G" D
  424       .I DAT A("STATUS" )="N" S DR (2,741006. 01)=".09// /^S X=DATA (""EFFDATE "");30.01/ //^S X=DAT A(""NEW_DE SC"");.1// /^S X=DATA (""SUBDIV" ")" Q ; DP T MTN02693 6
  425      .S DR(2 ,741006.01 )=".01///^ S X=DATA(" "EFFDATE"" );.09///^S  X=DATA("" EFFDATE"") ;30.01///^ S X=DATA(" "NEW_DESC" ");.1///^S  X=DATA("" SUBDIV"")"  ; DPT MTN 026936
  426    I CHG'="C HG" D
  427     .S DR(2, 741006.01) =".01///^S  X=DATA("" EFFDATE"") ;.09///^S  X=DATA(""E FFDATE""); 30.01///^S  X=DATA("" NAME"");.1 ///^S X=DA TA(""SUBDI V"")"
  428    ; if it i s already  there, kil l it, we a re setting  it again
  429    K ^CHMSER V(DA,1,DIN UM)
  430    S DIC=DIE ,DIC(0)="L " D ^DIE
  431    S $P(^CHM SERV(DA(1) ,1,SUB,0), U)=""            ; se t uncovent ional 'END  DATE' mul tiple .01  field equa l to ""
  432    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
  433     I CHG'=" CHG" D MFI  ; DPT MTN 026936
  434    Q
  435   MFI ;
  436    ; mapping  file inge st FileMan  call to p opulate AI  test Prog ram Indica tor multip le
  437    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
  438    K DA S DA =IEN,DIE=$ S(DATA("RT ")="D":"^C HMICDX(",1 :"^CHMSERV (")
  439    S TG=$E(D IE,1,*-1)
  440    ;F PI="CV A","SB" D
  441    . ;S DATA ("PI")=$S( PI="CVA":1 ,1:6),DATA ("AI")=DAT A(PI),DA(1 )=DATA("PI ")
  442    . ;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)
  443    . ;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"")"
  444    . ;S DIC= DIE,DIC(0) ="L" D ^DI E
  445    I DATA("C VA")'="" D
  446    . I $D(@T G@(IEN,102 ,1,0))
  447    . . S HN= $O(@TG@(IE N,102,1,10 1,"A"),-1) +1
  448    . . I DAT A("CVA")=$ P(@TG@(IEN ,102,1,0), "^",2) Q
  449    . . S @TG @(IEN,102, 1,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN
  450    . . S @TG @(IEN,102, 1,101,HN,0 )=@TG@(IEN ,102,1,0)
  451    . . S @TG @(IEN,102, 1,101,"B", 1,HN)=""
  452    . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT")
  453    . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,1 ,0)),"^",3 )
  454    . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,1,0 )),"^",4)
  455    . S @TG@( IEN,102,1, 0)="1^"_DA TA("CVA")_ "^"_DDUZ_" ^"_DDT
  456    . S @TG@( IEN,102,"B ",1,1)=""
  457    I DATA("S B")'="" D
  458    . I $D(@T G@(IEN,102 ,6,0))
  459    . . S HN= $O(@TG@(IE N,102,6,10 1,"A"),-1) +1
  460    . . I DAT A("SB")=$P (@TG@(IEN, 102,6,0)," ^",2) Q
  461    . . S @TG @(IEN,102, 6,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN
  462    . . S @TG @(IEN,102, 6,101,HN,0 )=@TG@(IEN ,102,6,0)
  463    . . S @TG @(IEN,102, 6,101,"B", 1,HN)=""
  464    . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT")
  465    . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,6 ,0)),"^",3 )
  466    . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,6,0 )),"^",4)
  467    . S @TG@( IEN,102,6, 0)="6^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT
  468    . S @TG@( IEN,102,"B ",6,6)=""
  469    I DATA("S B")'="" D
  470    . I $D(@T G@(IEN,102 ,7,0))
  471    . . S HN= $O(@TG@(IE N,102,7,10 1,"A"),-1) +1
  472    . . I DAT A("SB")=$P (@TG@(IEN, 102,7,0)," ^",2) Q
  473    . . S @TG @(IEN,102, 7,101,0)=" ^"_$S(DATA ("RT")="D" :741006.05 102101,1:7 41006.1021 01)_"^"_HN _"^"_HN
  474    . . S @TG @(IEN,102, 7,101,HN,0 )=@TG@(IEN ,102,7,0)
  475    . . S @TG @(IEN,102, 7,101,"B", 1,HN)=""
  476    . S DDUZ= DATA("DUZ" ),DDT=DATA ("DT")
  477    . I DDUZ= "" S DDUZ= $P($G(@TG@ (IEN,102,7 ,0)),"^",3 )
  478    . I DDT=" " S DDT=$P ($G(@TG@(I EN,102,7,0 )),"^",4)
  479    . S @TG@( IEN,102,7, 0)="7^"_DA TA("SB")_" ^"_DDUZ_"^ "_DDT
  480    . S @TG@( IEN,102,"B ",7,7)=""
  481    I DATA("C VA")+DATA( "SB") D
  482    . S X=0 F  I=0:1 S X =$O(@TG@(I EN,102,X))  Q:'X
  483    . S @TG@( IEN,102,0) ="^741006. 0"_$S(DATA ("RT")="D" :5102,1:10 2)_"^"_$O( @TG@(IEN,1 02,"A"),-1 )_"^"_I
  484    Q
  485    ;
  486   EOF ; come  here on e nd of file  error; OR  ANY OTHER  error -lg
  487    ;
  488    S ER=$ZE
  489    I IO'=""  C IO U 0
  490    I ER["<EN DOFFILE>"  D  G EN1   ; continue  on with l oad @EN1
  491    .W !,"  . .. End of  File reach ed ...",!! ,"  ... St arting Fil eMan file  load ... " ,!
  492    .S DATA(" FMTM")=$$N OW^CHIUTIL () ; FileM an load st art time
  493    .W !?18," FileMan Lo ad Started  : ",DATA( "FMTM")
  494    .Q
  495    I ER'=""  W !!," ***  A System  error has  occurred!  ***",!!?4, ER,!!
  496    W $E(LN,1 ,39),!
  497    R !!,"    Press <Ent er> to con tinue ",*X
  498    Q
  499   TERMINATE  ;
  500    F  R !,CO DE D
  501    . S IEN=0
  502    . I CODE? 1"S42".E D   Q
  503    . . S IEN =$$GETIEN^ CHIVFI(COD E,"D")
  504    . . 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
  505    . I CODE' ["-" D  Q
  506    . . S IEN =$$GETIEN^ CHIVFI(COD E,"P") W ! ,"*",CODE, " ",IEN
  507    . . 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
  508    . S CODE= $TR(CODE,"  "),SCODE= $P(CODE,"- ") 
  509    . F  D  Q :SCODE>$P( CODE,"-",2 )
  510    . . S IEN =$$GETIEN^ CHIVFI(SCO DE,"P") W  !,"**",SCO DE," ",IEN
  511    . . 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
  512    . . S SCO DE=$O(^CHM SERV("B",S CODE))
  513    . Q
  514    Q