168. EPMO Open Source Coordination Office Redaction File Detail Report

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

168.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMLCDRV.m Mon Nov 5 16:41:25 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMLCDRV.m Fri Nov 9 03:07:22 2018 UTC

168.2 Comparison summary

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

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

168.4 Active regular expressions

No regular expressions were active.

168.5 Comparison detail

  1   CHMLCDRV ; CVA/JEH; C ODE TX FIL E DRIVER ; 09/22/07   2:39 PM
  2    ;
  3    ;THIS RTN  USES THE  FOLLOWING  VMS COM FI LE: HAC_HF S$:[DSMMAN AG.CHAMPVA ]TX_CODE_U PDT.COM
  4    ;                                    W/ PA RAM=DEV-TR N-LIVE
  5    ;
  6    ;D ENVRMT   ;SET ENV IRONMENT
  7    ;Q:ENVIR= "LIVE"      ;ONLY RUN  IN DEV,TR N
  8    Q
  9   TXSTR ;STA RT TRANSFE R OF DATA
  10    Q:$$ENVRM T="TRAIN"    ;<------ ---------- --REMOVE L INE AFTER  TESTING
  11    Q:$$ENVRM T="LIVE"    ;<------- ---------- -REMOVE LI NE AFTER Q A TESTING
  12    Q:$$ENVRM T="DEV"    ;<-------- ---------- REMOVE LIN E AFTER QA  TESTING
  13    Q:$$ENVRM T="TRAIN"    ;<------ ---------- --REMOVE L INE AFTER  QA TESTING
  14    Q      ;< ---------- --------RE MOVE LINE  AFTER QA T ESTING
  15    S:'$D(DUZ ) DUZ=1,DU Z(0)=""
  16    K ^CHMZHO LD("CHFILE TX")
  17    ;I '$D(DT ) S %DT="" ,X="T" D ^ %DT S DT=Y
  18    D OFILE(" R")
  19    I FEXST=0  D  G END2
  20    .D CFILE
  21    .;S CHMSG ="NO UPDAT E - FILE N OT AVAILAB LE"
  22    .;D MMMSG    ;NOTIFY  USER (PMP AY) NO UPD ATE - FILE  NOT AVAIL ABLE
  23    .S MSGFL= 1    ;Desc ription: " NO UPDATE  - FILE NOT  AVAILABLE "
  24    .D SNDMMM SG   ;NOTI FY USER (P MPAY) NO U PDATE - FI LE NOT AVA ILABLE
  25    D RFILE    ;READ INP UT FILE
  26    D CFILE    ;CLOSE IN PUT FILE
  27    D:'$T!($T =0) END
  28    S CTR=0 F   S CTR=$O (^CHMZHOLD ("CHFILETX ",CTR)) Q: 'CTRYP  D
  29    .S PRTYP= $P(^CHMZHO LD("CHFILE TX",CTR)," ^",4)  ;GE TTING CODE  TYPE - HC PCS, CPT,  ICD-9
  30    .S PRTYP= $S(PRTYP=" CPT":"CPT" ,PRTYP="HC PCS":"HCP" ,PRTYP="IC D9 PX":"IC D",PRTYP=" ICD9 DX":" ICD",1:"")
  31    .Q:PRTYP= ""
  32    .S CHPRTY P="PR"_PRT YP D @CHPR TYP
  33    ;S CHMSG= $$ENVRMT_"  has compl eted updat e. Please  check code s."
  34    ;D MMMSG
  35    S MSGFL=2     ;Descr iption: $$ ENVRMT_" h as complet ed update.  Please ch eck codes. "
  36    D SNDMMMS G   ;NOTIF Y USER (PM PAY) NO UP DATE - FIL E NOT AVAI LABLE
  37    ;S PRTYP= "" F  S PR TYP=$O(^CH MZHOLD("CH FILETX",PR TYP)) Q:PR TYP=""  D
  38    ;.S CHPRT YP="PR"_PR TYP D @CHP RTYP
  39    ;.S CHMSG =$$ENVRMT_ " has comp leted upda te. Please  check cod es."
  40    ;.D MMMSG
  41    Q
  42   RFILE ;REA D FILE
  43    S CTR=0
  44    S $ZE="", $ZT="ENDOF ^CHMLCDRV"
  45    F  U CHFI O R REC D
  46    .S CTR=CT R+1
  47    .;S CHCTY P=$P(REC," ^",4)
  48    .;S:'$D(C TR(CHCTYP) ) CTR(CHCT YP)=0
  49    .;S CTR(C HCTYP)=CTR (CHCTYP)+1
  50    .;S ^CHMZ HOLD("CHFI LETX",CHCT YP,CTR(CHC TYP))=REC
  51    .S ^CHMZH OLD("CHFIL ETX",CTR)= REC
  52    ;  TXQUIT  ;    ;USE  IF 'QUIT'  DOES NOT  WORK
  53    Q
  54   WFILE ;WRI TE FILE
  55    U 0 W !," *** Writin g Records  to ",CHFIO
  56    D OFILE(" W")
  57    I FEXST=1  D  Q
  58    .W !!,"Tr ansfer cod e file loa d problem  - It may e xist. Plea se contact  HAC Helpd esk.",!!
  59    .D CFILE
  60    .S QUITX= "Q"
  61    D NOW^%DT C S CHDTFL =%    ;DAT E TX FILE  WAS CREATE D
  62    S ^CHMZHO LD("CHFILE TX",0)=DUZ _"^"_CHDTF L
  63    U CHFIO W  ^CHMZHOLD ("CHFILETX ",0),!
  64    S RCENV=0                                                          ;******* * PROBLEM  AREA ***** *****    D ELETE AFTE R UNIT TES ING
  65    S CTR=0 F   S CTR=$O (^CHMZHOLD ("CHFILETX ",CTR)) Q: 'CTR  D
  66    .S RCDUZ= $P(^CHMZHO LD("CHFILE TX",CTR)," ^",1)       ;GETTING  RECORD DUZ        ADD /DELETE PI ECES HERE  - DEPENDAN T ON RECOR D
  67    .S RCDTFL =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",2)      ;GETTING  RECORD FIL E DATE LOA D
  68    .S RCENVR =ENVR                                        ;GETTING  RECORD ENV IRONMENT T O UPDATE
  69    .;S ENVRE C(RCENV)=E NVREC(RCEN V)+1                   ;SETTING  ARRAY OF E NVIRONMENT S TO UPDAT E   - NOT  PART OF ^C HMZHOLD GB L
  70    .S RCCTYP =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",4)      ;GETTING  RECORD COD E TYPE  (i e. CPT,HCP CS,ICD)
  71    .S RCSTAT =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",5)      ;GETTING  RECORD STA TUS
  72    .S RCCODE =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",6)      ;GETTING  RECORD COD E
  73    .S RCDESC =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",7)      ;GETTING  RECORD DES CRIPTION
  74    .S RCDSC2 =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",8)      ;GETTING  RECORD DES CRIPTION # 2
  75    .S RCEFDT =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",9)      ;GETTING  RECORD EFF ECTIVE DAT E
  76    .S RCTMDT =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",10)     ;GETTING  RECORD TER MINATION D ATE
  77    .S RCCHAI =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",11)     ;GETTING  RECORD CHV  AI TEST
  78    .S RCSBAI =$P(^CHMZH OLD("CHFIL ETX",CTR), "^",12)     ;GETTING  RECORD SB  AI TEST
  79    .S RCRVUE DT=$P(^CHM ZHOLD("CHF ILETX",CTR ),"^",13)   ;GETTING  RVU EFFECT IVE DATE
  80    .S RCRVU= $P(^CHMZHO LD("CHFILE TX",CTR)," ^",14)      ;GETTING  RVU RATE
  81    .S RCRVUT DT=$P(^CHM ZHOLD("CHF ILETX",CTR ),"^",15)   ;GETTING  RVU TERMIN ATION DATE
  82    .S REC=RC DUZ_"^"_RC DTFL_"^"_R CENVR_"^"_ RCCTYP_"^" _RCSTAT_"^ "_RCCODE_" ^"_RCDESC_ "^"_RCDSC2 _"^"_RCEFD T_"^"_RCTM DT_"^"_RCC HAI_"^"_RC SBAI_"^"_R CRVUEDT_"^ "_RCRVU_"^ "_RCRVUTDT      ;FILE  FORMAT
  83    .U CHFIO  W REC,!
  84    D CFILE
  85    U 0 W !
  86    F EN="DEV ","TRAIN", "LIVE" I E NVR[EN D
  87    .U 0 W !, "SENDING ' COM' FILE  TO UPDATE  ENVIRONMEN T ",EN
  88    .;D COMFL
  89    .U 0 W !
  90    .;S CHMSG ="TRANSFER  FILE HAS  BEEN SENT  TO "_EN
  91    .;D MMMSG    ;NOTIFY  USER TRAN SFER FILE  HAS BEEN S ENT
  92    .S MSGFL= 3    ;Desc ription: T RANSFER FI LE HAS BEE N SENT TO  "_EN"
  93    .D SNDMMM SG   ;NOTI FY USER (P MPAY) NO U PDATE - FI LE NOT AVA ILABLE
  94    Q
  95    ;
  96   PRCPT ;PRO CESS CPT C ODES                                           ;*** DO NE ***
  97    Q:$P(^CHM ZHOLD("CHF ILETX",IVA L),"^",3)' ="CPT"
  98    S CTR=0 F   S CTR=$O (^CHMZHOLD ("CHFILETX ",CTR)) Q: 'CTR  D
  99    .K ^CHMZH OLD("CPT") ,^UTILITY( "CPT")
  100    .S $P(^CH MZHOLD("CP T",I),"^", 1)=$P(^CHM ZHOLD("CHF ILETX",IVA L),"^",5)    ;CPT Cod e
  101    .S CODE=$ P(^CHMZHOL D("CHFILET X",IVAL)," ^",5)   ;C PT Code
  102    .S $P(^CH MZHOLD("CP T",I),"^", 2)=$P(^CHM ZHOLD("CHF ILETX",IVA L),"^",6)    ;DESCRIP TION
  103    .S EFFDAT E=$P(^CHMZ HOLD("CHFI LETX",IVAL ),"^",8)
  104    .S TERMDA TE=$P(^CHM ZHOLD("CHF ILETX",IVA L),"^",9)
  105    .D ^CHMLC PT3
  106    .D ^CHMLC PT4
  107    .S AITSTC =$P(^CHMZH OLD("CHFIL ETX",IVAL) ,"^",11)    ;CHV AI T EST
  108    .I AITSTC '="" D
  109    ..S TEST= AITSTC
  110    ..I TEST? .N S TEST= "TEST #"_A ITSTC    ;  CVA AI TE ST
  111    ..S CHPGP T=1
  112    ..D AUPDT M^CHMLAI3           ; JEH <----- ---------- ---------- ---------- ----------  NEED TO U PDATE
  113    .S AITSTS =$P(^CHMZH OLD("CHFIL ETX",IVAL) ,"^",12)    ;SB AI TE ST
  114    .I AITSTS '="" D
  115    ..S TEST= AITSTS
  116    ..I TEST? .N S TEST= "TEST #"_A ITSTS
  117    ..S CHPGP T=6
  118    ..D AUPDT M^CHMLAI3           ; JEH <----- ---------- ---------- ---------- ----------  NEED TO U PDATE
  119    Q
  120    ;
  121   PRHCP ;PRO CESS HCPCS  CODES
  122    ;Q:$P(^CH MZHOLD("CH FILETX",IV AL,JVAL)," ^",1)'="HC P"  ;***** *RE-EVALUA TE THIS LI NE ******
  123    S (EFFDT, TERMDT)=""   ;******* ADD OTHER  VARIABLES  TO CLEANUP *******
  124    S IVAL=0  F  S IVAL= $O(^CHMZHO LD("CHFILE TX",IVAL))  Q:'IVAL   D
  125    .K ^UTILI TY("HCUP")
  126    .S TP(1)= $P(^CHMZHO LD("CHFILE TX",IVAL), "^",6)          ;HCPC S Code
  127    .S CODE=$ P(^CHMZHOL D("CHFILET X",IVAL)," ^",6)
  128    .S TP(2)= $P(^CHMZHO LD("CHFILE TX",IVAL), "^",7)          ;DESC RIPTION 35 -CHAR
  129    .S TP(3)= $P(^CHMZHO LD("CHFILE TX",IVAL), "^",7)          ;DESC RIPTION 48 -CHAR
  130    .S TP(4)= $P(^CHMZHO LD("CHFILE TX",IVAL), "^",8)          ;DESC RIPTION FU LL 1 HALF       ;***  CHECK ON D ESCPTION L OCATION ** *
  131    .S TP(5)= $P(^CHMZHO LD("CHFILE TX",IVAL), "^",8)          ;DESC RIPTION FU LL 2 HALF
  132    .S TP(6)= $P(^CHMZHO LD("CHFILE TX",IVAL), "^",5)          ;STAT US
  133    .S:TP(6)= "N" TP(6)= "A"                                   ;FOR  HCPCS CODE S N(ew) TO  A(dd)
  134    .S TP(8)= 0                                                ;PREV  REC ID CO DE - NOT U SED
  135    .S EFDT=$ P(^CHMZHOL D("CHFILET X",IVAL)," ^",9)           ;EFFE CTIVE DATE  YYYMMDD
  136    .S EFFDAT E=$$FMYR^C HTFLIB($E( EFDT,1,3)) _$E(EFDT,4 ,7)  ;CCYY MMDD
  137    .S TERMDA TE=$P(^CHM ZHOLD("CHF ILETX",IVA L),"^",10)       ;TER MINATION D ATE             ;***  CHECK FORM AT AGAINST  CHMLHCP3
  138    .;
  139    .S DA=0
  140    .S DA=999 9999-EFDT      ;($$YR 8FMYR^CHTF LIB(EFFDT) )                                  ;;*** CH ECK FORMAT  AGAINST C HMLHCP3
  141    .S J=1
  142    .D XX9+1^ CHMLHCP3
  143    .D ^CHMLH CP4
  144    .S AITSTC =$P(^CHMZH OLD("CHFIL ETX",IVAL) ,"^",11)    ;CHV AI T EST
  145    .I AITSTC '="" D
  146    ..S TEST= AITSTC
  147    ..I TEST? .N S TEST= "TEST #"_A ITSTC
  148    ..S CHPGP T=1
  149    ..D AIUPD T^CHMLAI2
  150    .S AITSTS =$P(^CHMZH OLD("CHFIL ETX",IVAL) ,"^",12)    ;SB AI TE ST
  151    .I AITSTS '="" D
  152    ..S TEST= AITSTS
  153    ..I TEST? .N S TEST= "TEST #"_A ITSTS
  154    ..S CHPGP T=6
  155    ..D AIUPD T^CHMLAI2
  156    Q
  157    ;
  158   PRADA ;PRO CESS ADA C ODES
  159    ;*** CURR ENTLY NOT  USED - FOR  FUTURE US E ***
  160    Q
  161    ;
  162   PRICD ;PRO CESS ICD9  CODES
  163    S J=1,K=1
  164    S I=0 F   S I=$O(^CH MZHOLD("CH FILETX",I) ) Q:'I  D
  165    .F CTR=1: 1:16 S X(C TR)="" ;CL EAR ARRAY
  166    .S X=^(I)
  167    .S CDTYPE =$P(X,"^", 4)   ; DIA GNOSIS OR  PROCEDURE  RECORD TYP E  D OR O
  168    .S CDTYPE =$S(CDTYPE ="ICD9 PX" :"O",CDTYP E="ICD9 PX ":"D",1:"" ) Q:CDTYPE =""
  169    .S X(3)=C DTYPE
  170    .S EFFDT= $P(X,"^",9 )    ; EFF ECTIVE DAT E
  171    .S X(1)=$ P(X,"^",6)      ; ICD -9-CM CODE
  172    .S CODE=$ P(X,"^",6)
  173    .S X(2)=$ P(X,"^",7)      ; DES CRIPTION
  174    .I X(3)=" D" D DIAG^ CHMLICD33
  175    .I X(3)=" O" D PROC^ CHMLICD33
  176    .S CTR=0
  177    .S CTR=J- 1,^CHMZHOL D("PROC",0 )="ICD9 PR OCEDURES^" _CTR_"^"_C TR
  178    .S CTR=K- 1,^CHMZHOL D("DX",0)= "CHAMPVA I CD9 DIAGNO SIS^741006 .05^"_CTR_ "^"_CTR
  179    .D ^CHMLI CD4   ;UPD ATE ICD-9  SERVICE FI LE
  180    .D ^CHMLI CD5   ;UPD ATE ICD-9  DX FILE
  181    .;AI TEST  UPDATE
  182    .S CODE=$ P(X,"^",5)      ; ICD -9-CM CODE
  183    .I CDTYPE ="O" D           ;PRO CEDURE
  184    ..S AITST C=$P(X,"^" ,11)    ;  CVA AI TES T
  185    ..I AITST C'="" D
  186    ...S TEST =AITSTC
  187    ...I TEST ?.N S TEST ="TEST #"_ AITSTC
  188    ...S CHPG PT=1
  189    ...D AIUP DT^CHMLAI1
  190    ..S AITST S=$P(X,"^" ,12)    ;  SB AI TEST
  191    ..I AITST S'="" D
  192    ...S TEST =AITSTS
  193    ...I TEST ?.N S TEST ="TEST #"_ AITSTS
  194    ...S CHPG PT=6
  195    ...D AIUP DT^CHMLAI1
  196    .I CDTYPE ="D" D           ;DIA GNOSIS
  197    ..S AITST C=$P(X,"^" ,11)    ;  CVA AI TES T
  198    ..I AITST C'="" D
  199    ...S TEST =AITSTC
  200    ...I TEST ?.N S TEST ="TEST #"_ AITSTC
  201    ...S CHPG PT=1
  202    ...D AIUP DT^CHMLAI4
  203    ..S AITST S=$P(X,"^" ,12)    ;  SB AI TEST
  204    ..I AITST S'="" D
  205    ...S TEST =AITSTS
  206    ...I TEST ?.N S TEST ="TEST #"_ AITSTS
  207    ...S CHPG PT=6
  208    ...D AIUP DT^CHMLAI4
  209    D END^CHM LICD33
  210    Q
  211    ;
  212   END ;
  213    C CHFIO
  214    ;S CHMSG= "CODE UPDA TE DONE -  PLEASE CHE CK "_ENVR_ "'s"
  215    ;D MMMSG
  216    S MSGFL=4     ;Descr iption: CO DE UPDATE  DONE - PLE ASE CHECK  "_ENVR_"'s "
  217    D SNDMMMS G   ;NOTIF Y USER (PM PAY) NO UP DATE - FIL E NOT AVAI LABLE
  218    K ^CHMZHO LD("CHFILE TX",CHDTTM )
  219    K IO,CHFI O,REC
  220    Q
  221   END1 ;
  222    Q
  223   END2 ;THIS  END IF FO R TXSTR
  224    K DUZ,DUZ (0),FEXST, IVAL,JVAL, RECTYP,AYG SYS,ENVI
  225    Q
  226    ;
  227   SNDMMMSG ; To send MM  message
  228    S ENVR="M SG"_MSGFL
  229    D COMFL
  230    Q
  231   CHMSG1 ;
  232    S CHMSG=" NO UPDATE  - FILE NOT  AVAILABLE "
  233    G MMMSG
  234   CHMSG2 ;
  235    S CHMSG=$ $ENVRMT_"  has comple ted update . Please c heck codes ."
  236    G MMMSG
  237   CHMSG3 ;
  238    S CHMSG=" TRANSFER F ILE HAS BE EN SENT TO  "_EN
  239    G MMMSG
  240   CHMSG4 ;
  241    S CHMSG=" CODE UPDAT E DONE - P LEASE CHEC K "_ENVR_" 's"
  242    G MMMSG
  243    ;GENERIC  MESSAGE
  244    S CHMSG=" Code trans fer proble m. Please  contact He lpdesk for  PSR refer ral."
  245   MMMSG ;MES SAGE ALERT ING FILE I S PROCESSE D
  246    S CNT=1,^ TMP($J,"TX -DRVR-RTN" ,CNT)="",C NT=CNT+1
  247    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "********* ********** ********** ******",CN T=CNT+1
  248    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "**        TRANSFER D RIVER          **",CN T=CNT+1
  249    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "***                                ***",CN T=CNT+1
  250    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "****    H AS BEEN PR OCESSED      ****",CN T=CNT+1
  251    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "***                                ***",CN T=CNT+1
  252    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "**            MESSAG E              **",CN T=CNT+1
  253    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "********* ********** ********** ******",CN T=CNT+1
  254    S ^TMP($J ,"TX-DRVR- RTN",CNT)= "",CNT=CNT +1
  255    S ^TMP($J ,"TX-DRVR- RTN",CNT)= CHMSG,CNT= CNT+1
  256    S ^TMP($J ,"TX-DRVR- RTN",CNT)= ""
  257    S XMTEXT= "^TMP($J," "TX-DRVR-R TN"","
  258    S XMDUZ=. 5
  259    S XMY(DUZ )=""
  260    S XMY(" PII                   ")=""          ;<-------- ---------- ---------- ----DELETE  AFTER TES TING
  261    ;S XMY("
P II                ")=""     ;<-------- ---------- --------UN COMMENT AF TER TESTIN G
  262    S XMSUB=" TX DRVR RT N" D ^XMD
  263    Q 
  264    ;
  265   ENVRMT() ; SET ENVIRO NMENT
  266    I '$D(XQV OL) D
  267     .S ENVIR =^DD("SITE ")
  268       .S ENVIR=$ S(ENVIR="D NS  ":"DEV",EN VIR="
D NS  ":"TEST",E NVIR="
D NS  ":"TRAIN", ENVIR="Hea lth Admini stration C enter":"LI VE")
  269    E  D
  270    .S AYGSYS =XQVOL
  271    .S ENVIR= $S(AYGSYS= "ROU":"LIV E",AYGSYS= "XOU":"TRA IN",AYGSYS ="TOU":"TE ST",AYGSYS ="DOU":"DE V")
  272    Q ENVIR
  273   ENVUPDT ;A UTO UPDATE  DEV/TRN/H AC ENVIRON MENTS         ;ADDED  BY JEH
  274    K DIR   ; PROMPT USE R FOR ENVI RONMENTS T O UPDATE
  275    S CTRA=1
  276    S DIR("B" )=4
  277    S DIR("A" ,CTRA)="", CTRA=CTRA+ 1
  278    S DIR("A" ,CTRA)="Se lect Envir onment(s)  You Want t o Update:" ,CTRA=CTRA +1
  279    S DIR("A" ,CTRA)="", CTRA=CTRA+ 1
  280    S DIR("A" ,CTRA)="    1 - DEVEL OPMENT",CT RA=CTRA+1
  281    S DIR("A" ,CTRA)="    2 - TRAIN ",CTRA=CTR A+1
  282    S DIR("A" ,CTRA)="    3 - LIVE" ,CTRA=CTRA +1
  283    S DIR("A" ,CTRA)="", CTRA=CTRA+ 1
  284    S DIR("A" ,CTRA)="    4 - ALL E NVIRONMENT S",CTRA=CT RA+1
  285    S DIR("A" ,CTRA)="", CTRA=CTRA+ 1
  286    S DIR("A" )="Select"
  287    S DIR(0)= "L^1:4" D  ^DIR K DIR ,CTRA
  288    I ($D(DIR UT))!($D(D IROUT)) Q
  289    F EN=1:1: $L(Y) I $E (Y,EN)'=", " D
  290    .S ENS=$S ($E(Y,EN)= 1:"DEV",$E (Y,EN)=2:" TRAIN",$E( Y,EN)=3:"L IVE",$E(Y, EN)=4:"ALL ")
  291    .S:EN=1 E NVR=ENS
  292    .S:EN'=1  ENVR=ENVR_ "-"_ENS
  293    S:ENVR["A LL" ENVR=" DEV-TRAIN- LIVE"
  294    Q
  295   ENDF ;END  FILE UPDAT E        ; ADDED BY J EH
  296    C CHFIO
  297    Q
  298   UPTX() ;Fu nction ask ing to add /update co de in Test  or to tra nsfer code  date
  299    Q
  300    S QUITX=" A"  ;QUIT  FLAG TO TX  DATA
  301    N FESXT
  302    ;
  303    ;PUT THE  FOLLOWING  CODE IN TH E BEGINING  OF ^CHMLC ODE -  Q:$ $UPTX^CHML CDRV="T"
  304    ;
  305    ;I '$D(DT ) S %DT="" ,X="T" D ^ %DT S DT=Y
  306    ;S:'$D(^C HMZHOLD("C HFILETX",0 )) ^CHMZHO LD("CHFILE TX",0)=DUZ _"^"_DT
  307    ;
  308    ;I $$ENVR MT'="TEST"  W !!,"Can  only Add/ Update cod es or Tran sfer data  in TEST.", !! Q "Q"    ;CHECK IF  RUNNING I N TEST
  309    I $$ENVRM T'="DEV" W  !!,"Can o nly Add/Up date codes  or Transf er data in  DEV.",!!  Q "Q"   ;< ------ DEL ETE LINE W HEN DONE T ESTING IN  DEV
  310    I '$D(DUZ ) W !!,"DU Z is not v alid. Plea se see HAC  Helpdesk. ",!! Q "Q"    ;STOP I F DUZ IS M ISSING
  311   LT1 ;LINE  TAG 1
  312    S DIR(0)= "SXO^A: Ad d/Update T est codes; T: Transfe r to DEV/T RN/LIVE"
  313    S DIR("A" )="Select"
  314    S DIR("B" )="A"
  315    D ^DIR K  DIR
  316    Q:$D(DIRU T) "Q"
  317    Q:$D(DIRO UT) "Q"
  318    I Y="A"&( $D(^CHMZHO LD("CHFILE TX"))) W ! !,"Codes h ave been a dded. Plea se transfe r codes.", ! G LT1 
  319    Q:Y="A" Y
  320    I '$D(^CH MZHOLD("CH FILETX"))  W !!,"Ther e is no co de data to  transfer.  Please Ad d/Update c odes.",!!  G LT1       ;<---- UN COMMENT WH EN ^CHMZHO LD(CHFILET X GBL IS W ORKING
  321    I '$D(^CH MZHOLD("CH FILETX",0) ) W !!,"Mi ssing ZERO  node. Una ble to tra nsfer data . Please c ontact the  Help Desk  for PST r eferral.", !! G LT1      ;*** AS K TAMMY AB OUT THIS * **
  322    I $P(^CHM ZHOLD("CHF ILETX",0), "^",1)=DUZ  W !!,"You r not auth orized to  update cod e in DEV/T RAIN/LIVE. ",!! G LT1    ;PREVEN TS SAME US ER FROM UP DATING ALL  ENVIRONME NTS
  323    D OFILE(" R") 
  324    D CFILE
  325    I FEXST=1  D  Q "T"
  326    .W !!,"Tr ansfer cod e file exi sts. Pleas e contact  HAC Helpde sk.",!!
  327    D ENVUPDT
  328    I ($D(DIR UT))!($D(D IROUT)) G  UPTX+1   ; START FUNC TION OVER
  329    ;Q QUITX
  330    ;UPTX2()  ;Function  to transfe r files -  after user  has popul ated chmzh old global
  331    ;S QUITX= "Q"
  332    D DSPLYTX
  333    I REC=""  S QUITX="Q " Q QUITX
  334    S DIR("A" )="OK to t ransfer"
  335    S DIR(0)= "Y",DIR("B ")="No" D  ^DIR K DIR
  336    S:$D(DIRU T)!($D(DIR OUT)) QUIT X="Q"
  337    I Y=1 D
  338    .D WFILE
  339    .S QUITX= "T"
  340    E  S QUIT X="Q"
  341    Q QUITX
  342   COMFL ;VMS  '.COM' fi le is here
  343    .;S X=$ZF (-1,"SUBMI T HAC_HFS$ :[DSMMANAG .CHAMPVA]T X_CODE_UPD T.COM/LOG= DHCP$CHAMP VA/PARAM=" _ENVR)
  344    .;H 3      ;CAN REMO VE TO INCR EASE UPDAT E TIME
  345    Q
  346   OFILE(RDWR T) ;Functi on to open  file
  347    ; 1 - exi sts, 0 - d oes not ex ist
  348    ; RDWRT -  indicates  options t o open fil e with
  349    S FEXST=0
  350    S CHFIO=" 741T01::HA C_HFS$:[DS MMANAG]CH_ TXDRV_CODE _UPDT.TXT"     ;<----  TEMP MAYB E PERM   
  351    ;S CHFIO= "741T01::H AC_HFS$:[D SMMANAG.CH AMPVA]CH_T XDRV_CODE_ UPDT.TXT"               ;<------ ---- PROBL EM WITH DI RECTORY FI LE IS IN . ..... SEE  BOB
  352    ;I RDWRT= "R" S $ZE= "",$ZT="EN D^CHMLCDRV " O CHFIO: "R":5             ;    :"RD":5 -  TO DELETE  FILE ONCE  CLOSED
  353    I RDWRT=" R" S $ZE=" ",$ZT="END OF^CHMLCDR V" O CHFIO :"R":5            ;    :"RD":5 -  TO DELETE  FILE ONCE  CLOSED
  354    ;I RDWRT= "W" S $ZE= "",$ZT="TX QUIT^CHMLC DRV" O CHF IO:"NWS":5        ;    :"RD":5 -  TO DELETE  FILE ONCE  CLOSED
  355    E  I RDWR T="W" S $Z E="",$ZT=" " O CHFIO: "NWS":5        ;   :" RD":5 - TO  DELETE FI LE ONCE CL OSED
  356    I $T&(RDW RT="R") S  FEXST=1
  357    Q $T
  358   ENDOF ;QUI T WHEN DON E READING  FILE
  359    Q
  360   CFILE ;CLO SE Tx FILE
  361    C CHFIO
  362    Q
  363   CDFILE ;CL OSE Tx FIL E AND DELE TE
  364    C CHFIO:" D"
  365    Q
  366   DSPLYTX ;D ISPLAY DAT A TO TRANS FER
  367    W !!,"Upd ating the  following  environmen t(s): ",EN VR
  368    W !,$P(^V A(200,+^CH MZHOLD("CH FILETX",0) ,0),"^",1) ," has loa ded the fo llowing co des into T est:",!
  369    S REC=""
  370    S CTR=0 F   S CTR=$O (^CHMZHOLD ("CHFILETX ",CTR)) Q: 'CTR  D
  371    .S REC=EN VR_"^"_^CH MZHOLD("CH FILETX",CT R)
  372    .W !,REC
  373    W !!
  374    I REC=""  W !,"Nothi ng loaded  into Test"
  375    Q