1. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 2/15/2018 2:12:05 PM Eastern 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.

1.1 Files compared

# Location File Last Modified
1 CPEE_Build_6_Sprint_9 and 11.zip\CPE001-010 Inactivate Existing Duplicate Vendor Records CPE Teams 1-3 Developer Form - CPE001-010.docx Tue Feb 6 17:50:58 2018 UTC
2 CPEE_Build_6_Sprint_9 and 11.zip\CPE001-010 Inactivate Existing Duplicate Vendor Records CPE Teams 1-3 Developer Form - CPE001-010.docx Wed Feb 14 21:55:46 2018 UTC

1.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 148
Changed 1 2
Inserted 0 0
Removed 0 0

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

1.4 Active regular expressions

No regular expressions were active.

1.5 Comparison detail

  1   Routine Na me:  __N/A __________ ________
  2   Developer  Name(s):   _Dennis Br icker__,   Nina Chau  Dang______ __________ __
  3   Associated  User Stor y/Stories:     ___CPE 001-010___ __________ ____
  4  
  5  
  6   Original R outines
  7  
  8  
  9   CHGVQ529 ; CVA/PEJ; V F SELECT -  MAIN SCRE EN;05/20/9 9 10:07 AM  ;;1.0;CHA MPVA SYSTE M;;DECEMBE R 08, 2010 ; ;CPTS #1 0846* - PE J 8/15/96  ;CPTS #111 58* - PEJ  10/30/96 ; CPTS #1129 4* - PEJ 1 2/5/96, #1 6483* (RLC ) ;jsg;DEV 002841-02; 05/12/09;A uto Vendor  Selection  Process;  ;DEV007991  10/08/201 0 JAK --VE NDOR LOOKU P utilizin g NPI ;BUG 007991-07  DRW - Adde d comment  on the Fil eman searc h index 12 /15/10 ;BU G007991-07 -03 DRW -  Added K DI C to NPI l ine tag to  clear out  the work  area befor e engaging  in NPI se arch. 12/1 6/10 ;HM 0 6/30/17 CP E001-001-T 3-522242 M odify code  to use ve ndor resul t if only  one is ret urned. ;BD B 01/25/18  CPE001-01 0 Add labe l LU2LU1 ; ; lookup b ased on Ta x Identifi cation Num ber ;DEV00 7991 10/08 /2010 JAK  D RNGECLR^ CHSCH1(SCR LTOP,SCRLB OT,XY,CHEO L) ;;D RNG ECLR^CHSCH 1(4,22,XY, CHEOL) ;SK D  S CHLID =CHXTID S: '$D(CHXPI)  CHXPI=""  S:'$D(CHXN PI) CHXNPI =""  ;AEB  9/18/2007  S:'$D(CHXP RN) CHXPRN =""  ;AEB  9/18/2007  S CHXPI=$P (CHXPI,U,2 ) ;I $L(CH LID)>13 G  LU2^CHGVQ3 70 ;DEV007 991 10/08/ 2010 JAK - commented  out ; S CH LID1=CHLID  K ^UTILIT Y($J,"CHLU OUT")  ;js g;5/14/09; DEV002841; If AVS, pu ll list of  vendors f rom ^CHMIM AGE(PDI,10 0) AVS ind ex: ; IF $ D(CHMFPDI) ,$D(ASVFLG ),$D(^CHMI MAGE(CHMFP DI,100,0)) ,$P(^(0),U ,3)>1 {       D MULTI ASV^CHMXV0 05(CHMFPDI ,0) K ASVF LG } ELSE  { D FIND^D IC(741001, ,,"",CHLID 1,,"H",,," ^UTILITY($ J,""CHLUOU T"")") } I  '$D(^UTIL ITY($J,"CH LUOUT")) Q  I $P(^UTI LITY($J,"C HLUOUT","D ILIST",0), U,1)<1 Q D  RESORTF^C HGVQ535 ;D EV007991 1 0/08/2010  JAK QNPI ; ; lookup b ased on Na tional Pro vider Iden tifier (NP I) ;DEV007 991 10/08/ 2010 JAK r eplaced ph ysical loc ation name  lookup D  RNGECLR^CH SCH1(SCRLT OP,SCRLBOT ,XY,CHEOL)  S CHLID=C HXNPI,CHLI D1=CHXNPI  S:'$D(CHXP I) CHXPI=" " S:'$D(CH XPRN) CHXP RN=""  ;AE B 9/18/200 7 S CHXPI= $P(CHXPI,U ,2) ; K ^U TILITY($J, "CHLUOUT") ,DIC            ;;BUG 7991-07-03  Added DIC  field in  order clea r the fiel d before a  new searc h - 12/16/ 10. D FIND ^DIC(74100 1,,,"Q",CH LID1,,"M", ,,"^UTILIT Y($J,""CHL UOUT"")")  ;;BUG7991- 07 DRW - c hange "Q"  to "M" for  Quick-sea rch on ind ex rather  than Multi  search -  12/08/10.  I '$D(^UTI LITY($J,"C HLUOUT"))  Q I $P(^UT ILITY($J," CHLUOUT"," DILIST",0) ,U,1)<1 Q   ;; IF NO  NPI MATCHE S FOUND TH EN QUIT I  '$D(^UTILI TY($J,"CHL UOUT")) Q  QLOOK2 ; l ookup base d on remit -to name ; DEV007991  10/08/2010  JAK D RNG ECLR^CHSCH 1(SCRLTOP, SCRLBOT,XY ,CHEOL) S  CHLID=CHXP RN S:'$D(C HXPI) CHXP I="" S CHX PI=$P(CHXP I,U,2) ; S  CHLID1=CH LID K ^UTI LITY($J,"C HLUOUT") D  FIND^DIC( 741001,,," M",CHLID1, ,"B",,,"^U TILITY($J, ""CHLUOUT" ")") I '$D (^UTILITY( $J,"CHLUOU T")) Q I $ P(^UTILITY ($J,"CHLUO UT","DILIS T",0),U,1) <1 Q D RES ORTF^CHGVQ 535 ; ;S C HLUPTR=0 S :'$D(CHTZI P) CHTZIP= "" ;AEB 4/ 9/2008 DEF 004723 DEF INED CHTZI P IF MISSI NG ;F S CH LUPTR=$O(^ UTILITY($J ,"CHLUOUT" ,"DILIST", 2,CHLUPTR) ) Q:'CHLUP TR D ;.S C HLPTR=^UTI LITY($J,"C HLUOUT","D ILIST",2,C HLUPTR) ;. Q:'$D(^CHM VEN(CHLPTR ,0)) ;.S C HACIM="" S :$D(^CHMVE N(CHLPTR,1 4)) CHACIM =$P(^CHMVE N(CHLPTR,1 4),U,1) ;;  DETERMINE  AUSTIN MO DIFIER ;DE V007991 10 /08/2010 J AK ;.I CHX IM'="" Q:C HACIM'=CHX IM ;; AUST IN MODIFIE R: QUIT IF  '= A.M. P ROVIDED ;D EV007991 1 0/08/2010  JAK ;.S CH STAT=$P(^C HMVEN(CHLP TR,0),U,8)  ;; DETERM INE STATUS  ;DEV00799 1 10/08/20 10 JAK ;.I  $D(CHXACT ) I CHXACT '="Y" Q:(( CHSTAT=1)! (CHSTAT=2) ) ;; DETER MINE TO DI SPLAY ACTI VE OR ACTI VE/INACTIV E ;DEV0079 91 10/08/2 010 JAK ;. I CHXPI'=" " D CHKPI^ CHGVQ370 Q :CHPIFLG=0  ;; DETERM INE PROGRA M INDICATO R ;DEV0079 91 10/08/2 010 JAK ;. S:$D(^CHMV EN(CHLPTR, 2)) CHTZIP =$P(^CHMVE N(CHLPTR,2 ),U,5) ;.I  CHXZIP'=" " Q:$E(CHT ZIP,1,$L(C HXZIP))'=C HXZIP ;; P ROVIDER ZI P: QUIT IF  '= PL ZIP  PROVIDED  ;DEV007991  10/08/201 0 JAK ;.S: $D(^CHMVEN (CHLPTR,1) ) CHTRZIP= $P(^CHMVEN (CHLPTR,1) ,U,5) ;.I  CHXRZIP'=" " Q:$E(CHT RZIP,1,$L( CHXRZIP))' =CHXRZIP ; ; REMIT-TO  ZIP: QUIT  IF '= RT  ZIP PROVID ED ;DEV007 991 10/08/ 2010 JAK ; .I CHSTATE >0 Q:'$D(^ CHMVEN(CHL PTR,2)) Q: $P(^CHMVEN (CHLPTR,2) ,U,4)'=CHS TATE ;AEB  8/16/2007  CHANGE FRO M REMIT TO  PHY ADDRE SS ;.D ADD LIST^CHGVQ 528 QRN0 ;  ; lookup  based on p hysical lo cation nam e D RNGECL R^CHSCH1(S CRLTOP,SCR LBOT,XY,CH EOL) S CHL ID=CHXPLN  S:'$D(CHXP I) CHXPI=" " S CHXPI= $P(CHXPI,U ,2) S CHLI D1=CHLID K  ^UTILITY( $J,"CHLUOU T") D FIND ^DIC(74100 1,,,"M",CH LID1,,"J", ,,"^UTILIT Y($J,""CHL UOUT"")")  I '$D(^UTI LITY($J,"C HLUOUT"))  Q I $P(^UT ILITY($J," CHLUOUT"," DILIST",0) ,U,1)<1 Q  D RESORTF^ CHGVQ535 ; S CHLUPTR= 0 ;F S CHL UPTR=$O(^U TILITY($J, "CHLUOUT", "DILIST",2 ,CHLUPTR))  Q:'CHLUPT R D ;.S CH LPTR=^UTIL ITY($J,"CH LUOUT","DI LIST",2,CH LUPTR) ;.Q :'$D(^CHMV EN(CHLPTR, 0)) ;.S CH STAT=$P(^C HMVEN(CHLP TR,0),U,8)  ;.I $D(CH XACT) I CH XACT'="Y"  Q:((CHSTAT =1)!(CHSTA T=2)) ;.I  $D(CHXPI)  I CHXPI'=" " D CHKPI^ CHGVQ370 Q :CHPIFLG=0  ;.S CHTZI P=$P(^CHMV EN(CHLPTR, 2),U,5) ;. I $D(CHXZI P) I CHXZI P'="" Q:$E (CHTZIP,1, $L(CHXZIP) )'=CHXZIP  ;.I CHSTAT E>0 Q:$P(^ CHMVEN(CHL PTR,2),U,4 )'=CHSTATE  ;.I $D(CH XPLN) I CH XPLN'="" D  Q:TMPPRID '=CHXPLN ; PROV LOC Q UALIFIER ; ..S:'$D(^C HMVEN(CHLP TR,2)) ^CH MVEN(CHLPT R,2)="" ;. .S TMPPRID =$P(^CHMVE N(CHLPTR,2 ),U,8) ;.. S TMPPRID= $E(TMPPRID ,1,$L(CHXP LN)) ;.D A DDLIST^CHG VQ528 Q SN 0 ; D RNGE CLR^CHSCH1 (SCRLTOP,S CRLBOT,XY, CHEOL) S D Y=SCRLTOP+ 2,DX=0 S $ X=$G(DX),$ Y=$G(DY) X  XY W "THI S LIST WIL L TAKE A V ERY LONG T IME. DO YO U WANT TO  CONTINUE?  " D CSBRS^ CHSC2 I $E (Y,1)'="Y"  Q K ^TMP( "DILIST",$ J) D LIST^ DIC(741001 ,,,,,,,,"I  $P(^CHMVE N(Y,0),U,8 )<1") I '$ D(^TMP("DI LIST",$J))  Q I $P(^T MP("DILIST ",$J,0),U, 1)<1 Q D R ESORT1^CHG VQ535 ; S  CHLUPTR=0  F  S CHLUP TR=$O(^TMP ("DILIST", $J,2,CHLUP TR)) Q:'CH LUPTR  D . S CHLPTR=^ TMP("DILIS T",$J,2,CH LUPTR) Q:' $D(^CHMVEN (CHLPTR,0) ) .S CHSTA T=$P(^CHMV EN(CHLPTR, 0),U,8) Q: ((CHSTAT=1 )!(CHSTAT= 2)) ;; DET ERMINE TO  DISPLAY AC TIVE OR AC TIVE/INACT IVE .D ADD LIST^CHGVQ 528 Q ; ;* *******SET  UP SCREEN  PARAMETER S********* ********** ********** *********S CSET ;S SC RLEN=14 N  CHFUNC S D SPLEN=SCRL EN+1 ;S DT M=4 ;TOP M ARGIN +1 ; S DBM=19 ; BOTTOM MAR GIN S DTM= 5 ;SKD S D BM=20 ;SKD  S CHFUNC= "VLKUP" S  CHZONE=0 S  ^UTILITY( $J,"CHSCRN ",CHFUNC,C HZONE,"BEG ")=1 D ^CH SC3 ;SCREE N SETUP (I NSTEAD OF  ^CHMFSET)  ;D RNGECLR ^CHSCH1(SC RLTOP,SCRL BOT,XY,CHE OL) D RNGE CLR^CHSCH1 (3,19,XY,C HEOL) X CH MAR D DSPH DR^CHGVQ37 0 Q ;ADDLI ST ;HM 7/1 1/2017 CAL L LOCAL LA BEL TO POP ULATE ^UTI LITY GLOBA L TO GET C ORRECT COU NTS S CA=0 ,CLLEN=0,L LEN=0 S:'$ D(CHTZIP)  CHTZIP=""  S:'$D(CHTR ZIP) CHTRZ IP="" F  S  CA=$O(^UT ILITY($J," CHLUOUT"," DILIST",2, CA)) Q:'CA   D   .S C HL=^UTILIT Y($J,"CHLU OUT","DILI ST",2,CA)  Q:'$D(^CHM VEN(CHL,0) )  .S CHST AT=$P(^CHM VEN(CHL,0) ,U,8) ;; S ET VENDOR  STATUS ;DE V007991 10 /08/2010 J AK  .I CHS TAT="" S C HSTAT=0 .S  CHXACT=$S (CHSTAT=0: "Y",CHSTAT =1:"N",1:0 ) .I CHSTA T'=0 Q .;. K ^UTILITY ($J,"CHLUO UT","DILIS T",2,CA),^ UTILITY($J ,"CHLUOUT" ,"DILIST", 1,CA)  .;. S CHMVTOT= $P($G(^UTI LITY($J,"C HLUOUT","D ILIST",0)) ,"^",1),CH MVTOT=CHMV TOT-1,$P(^ UTILITY($J ,"CHLUOUT" ,"DILIST", 0),"^",1)= CHMVTOT .I  $D(CHXACT ) I CHXACT '="Y" Q:(( CHSTAT=1)! (CHSTAT=2) ) ;; DETER MINE TO DI SPLAY ACTI VE OR ACTI VE/INACTIV E ;DEV0079 91 10/08/2 010 JAK .I  CHXPI'=""  D CHKPI^C HGVQ370 Q: CHPIFLG=0  ;; DETERMI NE PROGRAM  INDICATOR  ;DEV00799 1 10/08/20 10 JAK .S: $D(^CHMVEN (CHL,2)) C HTZIP=$P(^ CHMVEN(CHL ,2),U,5) . I CHXZIP'= "" Q:$E(CH TZIP,1,$L( CHXZIP))'= CHXZIP                   ;; PROV IDER ZIP:  QUIT IF '=  PL ZIP PR OVIDED ;DE V007991 10 /08/2010 J AK .S:$D(^ CHMVEN(CHL ,1)) CHTRZ IP=$P(^CHM VEN(CHL,1) ,U,5) .I C HXRZIP'=""  Q:$E(CHTR ZIP,1,$L(C HXRZIP))'= CHXRZIP               ;; REMIT-T O ZIP: QUI T IF '= RT  ZIP PROVI DED ;DEV00 7991 10/08 /2010 JAK  .I CHSTATE >0 Q:'$D(^ CHMVEN(CHL ,2)) Q:$P( ^CHMVEN(CH L,2),U,4)' =CHSTATE   ;AEB 8/16/ 2007 CHANG E FROM REM IT TO PHY  ADDRESS .I  CHXPRN'=" " D  Q:TMP PRID'=CHXP RN                                 ;; REMIT  NAME: QUI T IF '= RE MIT NAME P ROVIDED ;D EV007991 1 0/08/2010  JAK ..S:'$ D(^CHMVEN( CHL,0)) ^C HMVEN(CHL, 0)="" ..S  TMPPRID=$E ($P(^CHMVE N(CHL,0),U ,1),1,$L(C HXPRN)) .F  XI=1:1:22  S CHLVAR( XI)="" .S: '$D(^CHMVE N(CHL,0))  ^CHMVEN(CH L,0)="" .S :'$D(^CHMV EN(CHL,1))  ^CHMVEN(C HL,1)="" . S:'$D(^CHM VEN(CHL,2) ) ^CHMVEN( CHL,2)=""  .S CHLVAR( 1)=CHL .S  CHLVAR(2)= $P(^CHMVEN (CHL,0),U, 1) ;REMIT  NAME .S CH LVAR(3)=$P (^CHMVEN(C HL,0),U,3)  ;TID .S C HLVAR(4)=$ P(^CHMVEN( CHL,0),U,2 3) ;VAC .S  CHLVAR(5) =$P(^CHMVE N(CHL,1),U ,1) ;REMIT  ADDR 1 .S  CHLVAR(6) =$P(^CHMVE N(CHL,1),U ,2) ;REMIT  ADDR 2 .S  CHRTFAF=$ P(^CHMVEN( CHL,1),U,1 8) .S:CHRT FAF="" CHR TFAF=0 .I  CHRTFAF=0  D ..S CHLV AR(7)=$P(^ CHMVEN(CHL ,1),U,3) ; REMIT CITY  ..S CHLVA R(8)=$P(^C HMVEN(CHL, 1),U,4) ;R EMIT STATE  ..S CHLVA R(9)=$P(^C HMVEN(CHL, 1),U,5) ;R EMIT ZIP . I CHRTFAF= 1 D ..S CH TMP=$P(^CH MVEN(CHL,1 ),U,17) ;R EMIT COUNT RY ..S CHL VAR(8)=CHT MP .S CHLV AR(10)=$P( ^CHMVEN(CH L,1),U,9)  ;AUSTIN VE RIFY .S CH LVAR(11)=$ P(^CHMVEN( CHL,2),U,8 ) ;PR NAME  .S CHLVAR (12)=$P(^C HMVEN(CHL, 2),U,1) ;P R ADDR1 .S  CHLVAR(13 )=$P(^CHMV EN(CHL,2), U,2) ;PR A DDR2 .S CH PRFAF=$P(^ CHMVEN(CHL ,2),U,11)  .S CHPRFAF =$P(^CHMVE N(CHL,2),U ,11) .S:CH PRFAF="" C HPRFAF=0 . I CHPRFAF= 0 D ..S CH LVAR(14)=$ P(^CHMVEN( CHL,2),U,3 ) ;PR CITY  ..S CHLVA R(15)=$P(^ CHMVEN(CHL ,2),U,4) ; PR STATE . .S CHLVAR( 16)=$P(^CH MVEN(CHL,2 ),U,5) ;PR  ZIP .I CH PRFAF=1 D  ..S CHTMP= $P(^CHMVEN (CHL,2),U, 10) ;PR CO UNTRY ..S  CHLVAR(15) =CHTMP .S  CHLVAR(17) =$P(^CHMVE N(CHL,2),U ,9) ;PR VE RIFY .S CH LVAR(18)="  " ;MEDICA RE # .S CH LVAR(19)=" " I $D(^CH MVEN(CHL,4 1)) D  ;CM AC ..S CMA CPTR=99999 99.999999  ..S CMACPT R=$O(^CHMV EN(CHL,41, CMACPTR),- 1) ..Q:'CM ACPTR ..S  CHLVAR(19) =$P(^CHMVE N(CHL,41,C MACPTR,0), U,3) .S CH LVAR(20)="  " I $D(^C HMVEN(CHL, 80)) D  ;D RG ..S CMA CPTR=99999 99.999999  ..S CMACPT R=$O(^CHMV EN(CHL,80, CMACPTR),- 1) ..Q:'CM ACPTR ..S  CHTMPDT=$P (^CHMVEN(C HL,80,CMAC PTR,0),U,1 ) ..S CHLV AR(20)=$P( ^CHMVEN(CH L,80,CMACP TR,0),U,2)  ..S CHLVA R(20)=CHLV AR(20)_" "  ..S CHLVA R(20)=$E(C HLVAR(20), 1,7) ..I $ E(CHLVAR(2 0),1)=" "  I CHTMPDT' ="" S CHLV AR(20)="NO  " .S CHLV AR(21)=" "  I $P(^CHM VEN(CHL,1) ,U,7)'=""  D  ;FACILI TY TYPE .. S CHTMP=$P (^CHMVEN(C HL,1),U,7)  ..S CHLVA R(21)=$P(^ CHMDIC(741 002.11,CHT MP,0),U,2)  ..S CHLVA R(21)=CHLV AR(21)_" "  ..S CHLVA R(21)=$E(C HLVAR(21), 1,20) .S C HLVAR(22)= "" ;INTERN AL MODIFIE R .S:$D(^C HMVEN(CHL, 14)) CHLVA R(22)=$P(^ CHMVEN(CHL ,14),U,1)  .S:$L(CHLV AR(22))='2  CHLVAR(22 )=" " .S C LLEN=CLLEN +1,LLEN=CL LEN,VFN=CH L .S ^UTIL ITY($J,"VL ULIST",CLL EN)=CHLVAR (1)_"^"_CH LVAR(2)_"^ "_CHLVAR(3 )_"^"_CHLV AR(4)_"^"_ CHLVAR(5)_ "^"_CHLVAR (6)_"^"_CH LVAR(7)_"^ "_CHLVAR(8 )_"^"_CHLV AR(9)_"^"_ CHLVAR(10) _"^"_CHLVA R(11) .S ^ UTILITY($J ,"VLULIST" ,CLLEN)=^U TILITY($J, "VLULIST", CLLEN)_"^" _CHLVAR(12 )_"^"_CHLV AR(13)_"^" _CHLVAR(14 )_"^"_CHLV AR(15)_"^" _CHLVAR(16 )_"^"_CHLV AR(17)_"^" _CHLVAR(18 )_"^"_CHLV AR(19)_"^" _CHLVAR(20 )_"^"_CHLV AR(21)_"^" _CHLVAR(22 ) Q
  10  
  11  
  12  
  13  
  14   Edited Rou tines
  15  
  16  
  17   CHGVQ600 ; CVA/BDB/NC D; INACTIV ATE DUPLIC ATE VENDOR  RECORDS ; 01/19/18 2 :49 PM ;;1 .0;CHAMPVA  SYSTEM;;J ANUARY 24,  2018; ;CP E001-010 -  BDB,NCD 0 1/19/18 ;  Q ;START ;  U 0 W !!, "Duplicate  Vendor Cl eanup - Pr ocessing D ata...",!  S ZTRTN="R UN^CHGVQ60 0",ZTDESC= "INACTIVAT E DUPLICAT E VENDOR R ECORDS" S  ZTIO="" D  ^%ZTLOAD Q  ;RUN ; N  CHXTID S U ="^" S CHX TID=(10000 0000-1) F   S CHXTID= $O(^CHMVEN ("D",CHXTI D)) Q:CHXT ID=""  D . N CHXZIP,C HSTATE,CHX RZIP,CHINI T,CHNXT,VC OMINIT,VCO MNXT,IENIN IT,IENNXT  .D LU2^CHG VQ529 .K ^ UTILITY($J ,"VLULIST" ) .S CHXZI P="" .S CH STATE="" . S CHXRZIP= "" .D ADDL IST^CHGVQ5 29 .S CHIN IT=0 F  S  CHINIT=$O( ^UTILITY($ J,"VLULIST ",CHINIT))  Q:CHINIT= ""  D ..S  CHINITD=^U TILITY($J, "VLULIST", CHINIT) .. S IENINIT= +CHINITD Q :(($P(^CHM VEN(IENINI T,0),U,8)' =0)&($P(^C HMVEN(IENI NIT,0),U,8 )'="")) .. I $P(CHINI TD,U,22)=" CG" Q ..N  CHLVPTR,VC OM S CHLVP TR=+$G(^UT ILITY($J," VLULIST",C HINIT)) D  ...S VCOM= "" S:$D(^C HMVCOMM(CH LVPTR,101) ) VCOM="Y"  D EFTCHEC K^CHGVQ370  S VCOMINI T=VCOM ..S  CHNXT=CHI NIT F  S C HNXT=$O(^U TILITY($J, "VLULIST", CHNXT)) Q: CHNXT=""   D ...S CHN XTD=^UTILI TY($J,"VLU LIST",CHNX T) ...S IE NNXT=+CHNX TD  Q:(($P (^CHMVEN(I ENNXT,0),U ,8)'=0)&($ P(^CHMVEN( IENNXT,0), U,8)'=""))  ...N CHLV PTR,VCOM S  CHLVPTR=+ $G(^UTILIT Y($J,"VLUL IST",CHNXT )) D ....S  VCOM="" S :$D(^CHMVC OMM(CHLVPT R,101)) VC OM="Y" D E FTCHECK^CH GVQ370 S V COMNXT=VCO M ...I $P( CHINITD,U, 2)'=$P(CHN XTD,U,2) Q   ;W !,CHN XT," ",$P( CHNXTD,U,2 ) Q ;Remit  to Name . ..I $P(CHI NITD,U,3,4 )'=$P(CHNX TD,U,3,4)  Q  ;W !,CH NXT," ",$P (CHNXTD,U, 3,4) Q ; . ..I $P(CHI NITD,U,5)' =$P(CHNXTD ,U,5) Q  ; W !,CHNXT, " ",$P(CHN XTD,U,5) Q  ;Remit to  Address 1  ...I $P(C HINITD,U,6 )'=$P(CHNX TD,U,6) Q   ;W !,CHNX T," ",$P(C HNXTD,U,6)  Q ;Remit  to Address  2 ...I $P (CHINITD,U ,7)'=$P(CH NXTD,U,7)  Q  ;W !,CH NXT," ",$P (CHNXTD,U, 7) Q ;Remi t to Addre ss City .. .I $P(CHIN ITD,U,8)'= $P(CHNXTD, U,8) Q  ;W  !,CHNXT,"  ",$P(CHNX TD,U,8) Q  ;Remit to  Address St ate ...I $ P(CHINITD, U,9)'=$P(C HNXTD,U,9)  Q  ;W !,C HNXT," ",$ P(CHNXTD,U ,9) Q ;Rem it to Addr ess ZIP .. .I $P(CHIN ITD,U,21)' =$P(CHNXTD ,U,21) Q   ;W !,CHNXT ," ",$P(CH NXTD,U,21)  Q ;FAC Ty pe (Facili ty Type)   ...I $P(CH INITD,U,20 )'=$P(CHNX TD,U,20) Q   ;W !,CHN XT," ",$P( CHNXTD,U,2 0) Q ;DRG  (Diagnosti c Related  Group)  .. .I $P(CHIN ITD,U,19)' =$P(CHNXTD ,U,19) Q   ;W !,CHNXT ," ",$P(CH NXTD,U,19)  Q ;CMAC ( CHAMPVA Ma ximum Allo wable Calc ulation) . ..I VCOMIN IT'=VCOMNX T Q  ;W !, CHNXT," ", VCOMNXT Q  ;VCOM (Ven dor Commen ts) ...I $ P(CHNXTD,U ,22)="CG"  Q  ;W !,CH NXT," ",$P (CHNXTD,U, 22) Q ;CG  in the mod ifier ...D  ....S CHM VNIEN=+^UT ILITY($J," VLULIST",C HNXT) .... Q:'$D(^CHM VEN(CHMVNI EN,0)) ... .S $P(^CHM VEN(CHMVNI EN,0),U,8) =1 ....S ^ CHMVEN(CHM VNIEN,8)=D T ....I $G (DUZ)>1,$D (^VA(200,D UZ)) S $P( ^CHMVEN(CH MVNIEN,8), U,2)=DUZ D  MSG Q ;BA CKOUT ;bac kout the d uplicate v endor inac tivations  N CHMVN U  0 W !!,"Ba ckout of D uplicate V endors - P rocessing  Data...",!  S U="^" S  CHMVN=8 F   S CHMVN= $O(^CHMVEN (CHMVN)) Q :'CHMVN  D  .I $D(^CH MVEN(CHMVN ,8)),(+^CH MVEN(CHMVN ,8)) S $P( ^CHMVEN(CH MVN,0),U,8 )=0 K ^CHM VEN(CHMVN, 8) Q ;LIST  ; N CHMVN  U 0 W !!, "List of D uplicate V endors Ina ctivated -  Processin g Data..." ,! S U="^"  S CHMVN=8  F  S CHMV N=$O(^CHMV EN(CHMVN))  Q:'CHMVN   D .I $D(^ CHMVEN(CHM VN,8)),(+^ CHMVEN(CHM VN,8)) W ! ,"CHMVEN(" ,CHMVN," " ,^CHMVEN(C HMVN,8),"  ",$E(^CHMV EN(CHMVN,0 ),1,50) Q  ;MSG ;MESS AGE THAT I NACTIVATE  DUPLICATE  VENDOR REC ORDS IS CO MPLETE S C NT=1,^TMP( $J,"INACTI VATE_DUPS" ,CNT)="",C NT=CNT+1 S  ^TMP($J," INACTIVATE _DUPS",CNT )="Inactiv ation of d uplicate v endor reco rd complet e." S XMTE XT="^TMP($ J,""INACTI VATE_DUPS" "," S XMDU Z=.5 I $D( DUZ),$D(^V A(200,DUZ) ) S XMDUZ= DUZ I $D(D UZ),$D(^VA (200,DUZ))  S XMY(DUZ )="" S XMS UB="INACTI VATE DUPLI CATE VENDO R RECORDS  COMPLETED"  D ^XMD Q 
  18  
  19   CHGVQ529 ; CVA/PEJ; V F SELECT -  MAIN SCRE EN;05/20/9 9 10:07 AM  ;;1.0;CHA MPVA SYSTE M;;DECEMBE R 08, 2010 ; ;CPTS #1 0846* - PE J 8/15/96  ;CPTS #111 58* - PEJ  10/30/96 ; CPTS #1129 4* - PEJ 1 2/5/96, #1 6483* (RLC ) ;jsg;DEV 002841-02; 05/12/09;A uto Vendor  Selection  Process;  ;DEV007991  10/08/201 0 JAK --VE NDOR LOOKU P utilizin g NPI ;BUG 007991-07  DRW - Adde d comment  on the Fil eman searc h index 12 /15/10 ;BU G007991-07 -03 DRW -  Added K DI C to NPI l ine tag to  clear out  the work  area befor e engaging  in NPI se arch. 12/1 6/10 ;HM 0 6/30/17 CP E001-001-T 3-522242 M odify code  to use ve ndor resul t if only  one is ret urned. ;BD B 01/25/18  CPE001-01 0 Add labe l LU2LU1 ; ; lookup b ased on Ta x Identifi cation Num ber ;DEV00 7991 10/08 /2010 JAK  D RNGECLR^ CHSCH1(SCR LTOP,SCRLB OT,XY,CHEO L)LU2 ;;D  RNGECLR^CH SCH1(4,22, XY,CHEOL)  ;SKD ; ;BD B 01/25/18  CPE001-01 0 S CHLID= CHXTID S:' $D(CHXPI)  CHXPI="" S :'$D(CHXNP I) CHXNPI= ""  ;AEB 9 /18/2007 S :'$D(CHXPR N) CHXPRN= ""  ;AEB 9 /18/2007 S  CHXPI=$P( CHXPI,U,2)  ;I $L(CHL ID)>13 G L U2^CHGVQ37 0 ;DEV0079 91 10/08/2 010 JAK -c ommented o ut ; S CHL ID1=CHLID  K ^UTILITY ($J,"CHLUO UT")  ;jsg ;5/14/09;D EV002841;I f AVS, pul l list of  vendors fr om ^CHMIMA GE(PDI,100 ) AVS inde x: ; IF $D (CHMFPDI), $D(ASVFLG) ,$D(^CHMIM AGE(CHMFPD I,100,0)), $P(^(0),U, 3)>1 {       D MULTIA SV^CHMXV00 5(CHMFPDI, 0) K ASVFL G } ELSE {  D FIND^DI C(741001,, ,"",CHLID1 ,,"H",,,"^ UTILITY($J ,""CHLUOUT "")") } I  '$D(^UTILI TY($J,"CHL UOUT")) Q  I $P(^UTIL ITY($J,"CH LUOUT","DI LIST",0),U ,1)<1 Q D  RESORTF^CH GVQ535 ;DE V007991 10 /08/2010 J AK QNPI ;;  lookup ba sed on Nat ional Prov ider Ident ifier (NPI ) ;DEV0079 91 10/08/2 010 JAK re placed phy sical loca tion name  lookup D R NGECLR^CHS CH1(SCRLTO P,SCRLBOT, XY,CHEOL)  S CHLID=CH XNPI,CHLID 1=CHXNPI S :'$D(CHXPI ) CHXPI=""  S:'$D(CHX PRN) CHXPR N=""  ;AEB  9/18/2007  S CHXPI=$ P(CHXPI,U, 2) ; K ^UT ILITY($J," CHLUOUT"), DIC            ;;BUG7 991-07-03  Added DIC  field in o rder clear  the field  before a  new search  - 12/16/1 0. D FIND^ DIC(741001 ,,,"Q",CHL ID1,,"M",, ,"^UTILITY ($J,""CHLU OUT"")") ; ;BUG7991-0 7 DRW - ch ange "Q" t o "M" for  Quick-sear ch on inde x rather t han Multi  search - 1 2/08/10. I  '$D(^UTIL ITY($J,"CH LUOUT")) Q  I $P(^UTI LITY($J,"C HLUOUT","D ILIST",0), U,1)<1 Q   ;; IF NO N PI MATCHES  FOUND THE N QUIT I ' $D(^UTILIT Y($J,"CHLU OUT")) Q Q LOOK2 ; lo okup based  on remit- to name ;D EV007991 1 0/08/2010  JAK D RNGE CLR^CHSCH1 (SCRLTOP,S CRLBOT,XY, CHEOL) S C HLID=CHXPR N S:'$D(CH XPI) CHXPI ="" S CHXP I=$P(CHXPI ,U,2) ; S  CHLID1=CHL ID K ^UTIL ITY($J,"CH LUOUT") D  FIND^DIC(7 41001,,,"M ",CHLID1,, "B",,,"^UT ILITY($J," "CHLUOUT"" )") I '$D( ^UTILITY($ J,"CHLUOUT ")) Q I $P (^UTILITY( $J,"CHLUOU T","DILIST ",0),U,1)< 1 Q D RESO RTF^CHGVQ5 35 ; ;S CH LUPTR=0 S: '$D(CHTZIP ) CHTZIP=" " ;AEB 4/9 /2008 DEF0 04723 DEFI NED CHTZIP  IF MISSIN G ;F S CHL UPTR=$O(^U TILITY($J, "CHLUOUT", "DILIST",2 ,CHLUPTR))  Q:'CHLUPT R D ;.S CH LPTR=^UTIL ITY($J,"CH LUOUT","DI LIST",2,CH LUPTR) ;.Q :'$D(^CHMV EN(CHLPTR, 0)) ;.S CH ACIM="" S: $D(^CHMVEN (CHLPTR,14 )) CHACIM= $P(^CHMVEN (CHLPTR,14 ),U,1) ;;  DETERMINE  AUSTIN MOD IFIER ;DEV 007991 10/ 08/2010 JA K ;.I CHXI M'="" Q:CH ACIM'=CHXI M ;; AUSTI N MODIFIER : QUIT IF  '= A.M. PR OVIDED ;DE V007991 10 /08/2010 J AK ;.S CHS TAT=$P(^CH MVEN(CHLPT R,0),U,8)  ;; DETERMI NE STATUS  ;DEV007991  10/08/201 0 JAK ;.I  $D(CHXACT)  I CHXACT' ="Y" Q:((C HSTAT=1)!( CHSTAT=2))  ;; DETERM INE TO DIS PLAY ACTIV E OR ACTIV E/INACTIVE  ;DEV00799 1 10/08/20 10 JAK ;.I  CHXPI'=""  D CHKPI^C HGVQ370 Q: CHPIFLG=0  ;; DETERMI NE PROGRAM  INDICATOR  ;DEV00799 1 10/08/20 10 JAK ;.S :$D(^CHMVE N(CHLPTR,2 )) CHTZIP= $P(^CHMVEN (CHLPTR,2) ,U,5) ;.I  CHXZIP'=""  Q:$E(CHTZ IP,1,$L(CH XZIP))'=CH XZIP ;; PR OVIDER ZIP : QUIT IF  '= PL ZIP  PROVIDED ; DEV007991  10/08/2010  JAK ;.S:$ D(^CHMVEN( CHLPTR,1))  CHTRZIP=$ P(^CHMVEN( CHLPTR,1), U,5) ;.I C HXRZIP'=""  Q:$E(CHTR ZIP,1,$L(C HXRZIP))'= CHXRZIP ;;  REMIT-TO  ZIP: QUIT  IF '= RT Z IP PROVIDE D ;DEV0079 91 10/08/2 010 JAK ;. I CHSTATE> 0 Q:'$D(^C HMVEN(CHLP TR,2)) Q:$ P(^CHMVEN( CHLPTR,2), U,4)'=CHST ATE ;AEB 8 /16/2007 C HANGE FROM  REMIT TO  PHY ADDRES S ;.D ADDL IST^CHGVQ5 28 QRN0 ;  ; lookup b ased on ph ysical loc ation name  D RNGECLR ^CHSCH1(SC RLTOP,SCRL BOT,XY,CHE OL) S CHLI D=CHXPLN S :'$D(CHXPI ) CHXPI=""  S CHXPI=$ P(CHXPI,U, 2) S CHLID 1=CHLID K  ^UTILITY($ J,"CHLUOUT ") D FIND^ DIC(741001 ,,,"M",CHL ID1,,"J",, ,"^UTILITY ($J,""CHLU OUT"")") I  '$D(^UTIL ITY($J,"CH LUOUT")) Q  I $P(^UTI LITY($J,"C HLUOUT","D ILIST",0), U,1)<1 Q D  RESORTF^C HGVQ535 ;S  CHLUPTR=0  ;F S CHLU PTR=$O(^UT ILITY($J," CHLUOUT"," DILIST",2, CHLUPTR))  Q:'CHLUPTR  D ;.S CHL PTR=^UTILI TY($J,"CHL UOUT","DIL IST",2,CHL UPTR) ;.Q: '$D(^CHMVE N(CHLPTR,0 )) ;.S CHS TAT=$P(^CH MVEN(CHLPT R,0),U,8)  ;.I $D(CHX ACT) I CHX ACT'="Y" Q :((CHSTAT= 1)!(CHSTAT =2)) ;.I $ D(CHXPI) I  CHXPI'=""  D CHKPI^C HGVQ370 Q: CHPIFLG=0  ;.S CHTZIP =$P(^CHMVE N(CHLPTR,2 ),U,5) ;.I  $D(CHXZIP ) I CHXZIP '="" Q:$E( CHTZIP,1,$ L(CHXZIP)) '=CHXZIP ; .I CHSTATE >0 Q:$P(^C HMVEN(CHLP TR,2),U,4) '=CHSTATE  ;.I $D(CHX PLN) I CHX PLN'="" D  Q:TMPPRID' =CHXPLN ;P ROV LOC QU ALIFIER ;. .S:'$D(^CH MVEN(CHLPT R,2)) ^CHM VEN(CHLPTR ,2)="" ;.. S TMPPRID= $P(^CHMVEN (CHLPTR,2) ,U,8) ;..S  TMPPRID=$ E(TMPPRID, 1,$L(CHXPL N)) ;.D AD DLIST^CHGV Q528 Q SN0  ; D RNGEC LR^CHSCH1( SCRLTOP,SC RLBOT,XY,C HEOL) S DY =SCRLTOP+2 ,DX=0 S $X =$G(DX),$Y =$G(DY) X  XY W "THIS  LIST WILL  TAKE A VE RY LONG TI ME. DO YOU  WANT TO C ONTINUE? "  D CSBRS^C HSC2 I $E( Y,1)'="Y"  Q K ^TMP(" DILIST",$J ) D LIST^D IC(741001, ,,,,,,,"I  $P(^CHMVEN (Y,0),U,8) <1") I '$D (^TMP("DIL IST",$J))  Q I $P(^TM P("DILIST" ,$J,0),U,1 )<1 Q D RE SORT1^CHGV Q535 ; S C HLUPTR=0 F   S CHLUPT R=$O(^TMP( "DILIST",$ J,2,CHLUPT R)) Q:'CHL UPTR  D .S  CHLPTR=^T MP("DILIST ",$J,2,CHL UPTR) Q:'$ D(^CHMVEN( CHLPTR,0))  .S CHSTAT =$P(^CHMVE N(CHLPTR,0 ),U,8) Q:( (CHSTAT=1) !(CHSTAT=2 )) ;; DETE RMINE TO D ISPLAY ACT IVE OR ACT IVE/INACTI VE .D ADDL IST^CHGVQ5 28 Q ; ;** ******SET  UP SCREEN  PARAMETERS ********** ********** ********** ********SC SET ;S SCR LEN=14 N C HFUNC S DS PLEN=SCRLE N+1 ;S DTM =4 ;TOP MA RGIN +1 ;S  DBM=19 ;B OTTOM MARG IN S DTM=5  ;SKD S DB M=20 ;SKD  S CHFUNC=" VLKUP" S C HZONE=0 S  ^UTILITY($ J,"CHSCRN" ,CHFUNC,CH ZONE,"BEG" )=1 D ^CHS C3 ;SCREEN  SETUP (IN STEAD OF ^ CHMFSET) ; D RNGECLR^ CHSCH1(SCR LTOP,SCRLB OT,XY,CHEO L) D RNGEC LR^CHSCH1( 3,19,XY,CH EOL) X CHM AR D DSPHD R^CHGVQ370  Q ;ADDLIS T ;HM 7/11 /2017 CALL  LOCAL LAB EL TO POPU LATE ^UTIL ITY GLOBAL  TO GET CO RRECT COUN TS S CA=0, CLLEN=0,LL EN=0 S:'$D (CHTZIP) C HTZIP="" S :'$D(CHTRZ IP) CHTRZI P="" F  S  CA=$O(^UTI LITY($J,"C HLUOUT","D ILIST",2,C A)) Q:'CA   D   .S CH L=^UTILITY ($J,"CHLUO UT","DILIS T",2,CA) Q :'$D(^CHMV EN(CHL,0))   .S CHSTA T=$P(^CHMV EN(CHL,0), U,8) ;; SE T VENDOR S TATUS ;DEV 007991 10/ 08/2010 JA K  .I CHST AT="" S CH STAT=0 .S  CHXACT=$S( CHSTAT=0:" Y",CHSTAT= 1:"N",1:0)  .I CHSTAT '=0 Q .;.K  ^UTILITY( $J,"CHLUOU T","DILIST ",2,CA),^U TILITY($J, "CHLUOUT", "DILIST",1 ,CA)  .;.S  CHMVTOT=$ P($G(^UTIL ITY($J,"CH LUOUT","DI LIST",0)), "^",1),CHM VTOT=CHMVT OT-1,$P(^U TILITY($J, "CHLUOUT", "DILIST",0 ),"^",1)=C HMVTOT .I  $D(CHXACT)  I CHXACT' ="Y" Q:((C HSTAT=1)!( CHSTAT=2))  ;; DETERM INE TO DIS PLAY ACTIV E OR ACTIV E/INACTIVE  ;DEV00799 1 10/08/20 10 JAK .I  CHXPI'=""  D CHKPI^CH GVQ370 Q:C HPIFLG=0 ; ; DETERMIN E PROGRAM  INDICATOR  ;DEV007991  10/08/201 0 JAK .S:$ D(^CHMVEN( CHL,2)) CH TZIP=$P(^C HMVEN(CHL, 2),U,5) .I  CHXZIP'=" " Q:$E(CHT ZIP,1,$L(C HXZIP))'=C HXZIP                   ;; PROVI DER ZIP: Q UIT IF '=  PL ZIP PRO VIDED ;DEV 007991 10/ 08/2010 JA K .S:$D(^C HMVEN(CHL, 1)) CHTRZI P=$P(^CHMV EN(CHL,1), U,5) .I CH XRZIP'=""  Q:$E(CHTRZ IP,1,$L(CH XRZIP))'=C HXRZIP              ; ; REMIT-TO  ZIP: QUIT  IF '= RT  ZIP PROVID ED ;DEV007 991 10/08/ 2010 JAK . I CHSTATE> 0 Q:'$D(^C HMVEN(CHL, 2)) Q:$P(^ CHMVEN(CHL ,2),U,4)'= CHSTATE  ; AEB 8/16/2 007 CHANGE  FROM REMI T TO PHY A DDRESS .I  CHXPRN'=""  D  Q:TMPP RID'=CHXPR N                                 ;; REMIT  NAME: QUIT  IF '= REM IT NAME PR OVIDED ;DE V007991 10 /08/2010 J AK ..S:'$D (^CHMVEN(C HL,0)) ^CH MVEN(CHL,0 )="" ..S T MPPRID=$E( $P(^CHMVEN (CHL,0),U, 1),1,$L(CH XPRN)) .F  XI=1:1:22  S CHLVAR(X I)="" .S:' $D(^CHMVEN (CHL,0)) ^ CHMVEN(CHL ,0)="" .S: '$D(^CHMVE N(CHL,1))  ^CHMVEN(CH L,1)="" .S :'$D(^CHMV EN(CHL,2))  ^CHMVEN(C HL,2)="" . S CHLVAR(1 )=CHL .S C HLVAR(2)=$ P(^CHMVEN( CHL,0),U,1 ) ;REMIT N AME .S CHL VAR(3)=$P( ^CHMVEN(CH L,0),U,3)  ;TID .S CH LVAR(4)=$P (^CHMVEN(C HL,0),U,23 ) ;VAC .S  CHLVAR(5)= $P(^CHMVEN (CHL,1),U, 1) ;REMIT  ADDR 1 .S  CHLVAR(6)= $P(^CHMVEN (CHL,1),U, 2) ;REMIT  ADDR 2 .S  CHRTFAF=$P (^CHMVEN(C HL,1),U,18 ) .S:CHRTF AF="" CHRT FAF=0 .I C HRTFAF=0 D  ..S CHLVA R(7)=$P(^C HMVEN(CHL, 1),U,3) ;R EMIT CITY  ..S CHLVAR (8)=$P(^CH MVEN(CHL,1 ),U,4) ;RE MIT STATE  ..S CHLVAR (9)=$P(^CH MVEN(CHL,1 ),U,5) ;RE MIT ZIP .I  CHRTFAF=1  D ..S CHT MP=$P(^CHM VEN(CHL,1) ,U,17) ;RE MIT COUNTR Y ..S CHLV AR(8)=CHTM P .S CHLVA R(10)=$P(^ CHMVEN(CHL ,1),U,9) ; AUSTIN VER IFY .S CHL VAR(11)=$P (^CHMVEN(C HL,2),U,8)  ;PR NAME  .S CHLVAR( 12)=$P(^CH MVEN(CHL,2 ),U,1) ;PR  ADDR1 .S  CHLVAR(13) =$P(^CHMVE N(CHL,2),U ,2) ;PR AD DR2 .S CHP RFAF=$P(^C HMVEN(CHL, 2),U,11) . S CHPRFAF= $P(^CHMVEN (CHL,2),U, 11) .S:CHP RFAF="" CH PRFAF=0 .I  CHPRFAF=0  D ..S CHL VAR(14)=$P (^CHMVEN(C HL,2),U,3)  ;PR CITY  ..S CHLVAR (15)=$P(^C HMVEN(CHL, 2),U,4) ;P R STATE .. S CHLVAR(1 6)=$P(^CHM VEN(CHL,2) ,U,5) ;PR  ZIP .I CHP RFAF=1 D . .S CHTMP=$ P(^CHMVEN( CHL,2),U,1 0) ;PR COU NTRY ..S C HLVAR(15)= CHTMP .S C HLVAR(17)= $P(^CHMVEN (CHL,2),U, 9) ;PR VER IFY .S CHL VAR(18)="  " ;MEDICAR E # .S CHL VAR(19)=""  I $D(^CHM VEN(CHL,41 )) D  ;CMA C ..S CMAC PTR=999999 9.999999 . .S CMACPTR =$O(^CHMVE N(CHL,41,C MACPTR),-1 ) ..Q:'CMA CPTR ..S C HLVAR(19)= $P(^CHMVEN (CHL,41,CM ACPTR,0),U ,3) .S CHL VAR(20)="  " I $D(^CH MVEN(CHL,8 0)) D  ;DR G ..S CMAC PTR=999999 9.999999 . .S CMACPTR =$O(^CHMVE N(CHL,80,C MACPTR),-1 ) ..Q:'CMA CPTR ..S C HTMPDT=$P( ^CHMVEN(CH L,80,CMACP TR,0),U,1)  ..S CHLVA R(20)=$P(^ CHMVEN(CHL ,80,CMACPT R,0),U,2)  ..S CHLVAR (20)=CHLVA R(20)_" "  ..S CHLVAR (20)=$E(CH LVAR(20),1 ,7) ..I $E (CHLVAR(20 ),1)=" " I  CHTMPDT'= "" S CHLVA R(20)="NO  " .S CHLVA R(21)=" "  I $P(^CHMV EN(CHL,1), U,7)'="" D   ;FACILIT Y TYPE ..S  CHTMP=$P( ^CHMVEN(CH L,1),U,7)  ..S CHLVAR (21)=$P(^C HMDIC(7410 02.11,CHTM P,0),U,2)  ..S CHLVAR (21)=CHLVA R(21)_" "  ..S CHLVAR (21)=$E(CH LVAR(21),1 ,20) .S CH LVAR(22)=" " ;INTERNA L MODIFIER  .S:$D(^CH MVEN(CHL,1 4)) CHLVAR (22)=$P(^C HMVEN(CHL, 14),U,1) . S:$L(CHLVA R(22))='2  CHLVAR(22) =" " .S CL LEN=CLLEN+ 1,LLEN=CLL EN,VFN=CHL  .S ^UTILI TY($J,"VLU LIST",CLLE N)=CHLVAR( 1)_"^"_CHL VAR(2)_"^" _CHLVAR(3) _"^"_CHLVA R(4)_"^"_C HLVAR(5)_" ^"_CHLVAR( 6)_"^"_CHL VAR(7)_"^" _CHLVAR(8) _"^"_CHLVA R(9)_"^"_C HLVAR(10)_ "^"_CHLVAR (11) .S ^U TILITY($J, "VLULIST", CLLEN)=^UT ILITY($J," VLULIST",C LLEN)_"^"_ CHLVAR(12) _"^"_CHLVA R(13)_"^"_ CHLVAR(14) _"^"_CHLVA R(15)_"^"_ CHLVAR(16) _"^"_CHLVA R(17)_"^"_ CHLVAR(18) _"^"_CHLVA R(19)_"^"_ CHLVAR(20) _"^"_CHLVA R(21)_"^"_ CHLVAR(22)  Q
  20  
  21  
  22   New Fields  Added to  the Data D ictionary
  23  
  24   STANDARD D ATA DICTIO NARY #7410 01 -- CHAM PVA VENDOR  FILE        1/25/18     PAGE 1
  25   STORED IN  ^CHMVEN(    (1243775 E NTRIES)     SITE: 
D NS . URL      UCI: HADTS T,
  26   TOU                                                                  (VERSIO N 1.0)   
  27  
  28   DATA           NAME                    GLOB AL         DATA
  29   ELEMENT        TITLE                   LOCA TION       TYPE
  30   ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  31  
  32   741001,8.0 1   DATE I NACTIVATED        8;1  DATE
  33  
  34                  INPUT  TRANSFORM:   S %DT="E X" D ^%DT  S X=Y K:Y< 1 X
  35                  LAST E DITED:       JAN 22,  2018 
  36                  HELP-P ROMPT:       ENTER TH E DATE THA T THE VEND OR STATUS  WAS 
  37                                      INACTIVA TED. 
  38                  DESCRI PTION:       THIS IS  THE DATE T HAT THE VE NDOR ENTRY  WAS
  39                                      INACTIVA TED BY THE  DUPLICATE  VENDOR CL EANUP
  40                                      ROUTINE.   
  41  
  42  
  43   741001,8.0 2   DUPLIC ATE CLEANU P USER 8;2  POINTER T O NEW PERS ON FILE (# 200)
  44  
  45                  LAST E DITED:       JAN 22,  2018 
  46                  HELP-P ROMPT:       ENTER TH E NAME OF  THE USER. 
  47                  DESCRI PTION:       THIS IS  THE USER W HO IS PERF ORMING THE
  48                                      DUPLICAT E VENDOR C LEANUP.  
  49  
  50  
  51  
  52  
  53  
  54  
  55  
  56   Passed XIN DEX?  (Y /  N):  Y
  57  
  58  
  59  
  60                       V . A.  C R  O S S  R E  F E R E N  C E R  7. 3
  61                            [2008 V A Standard s & Conven tions]
  62                     UCI : HADTST C PU: TOU     Jan 24, 2 018@11:32: 52
  63   Routines:  1  Faux Ro utines: 0
  64  
  65   CHGVQ600  
  66  
  67   --- CROSS  REFERENCIN G ---
  68  
  69  
  70  
  71   Compiled l ist of Err ors and Wa rnings                Jan 24, 20 18@11:32:5 2 page 1
  72   No errors  or warning s to repor t
  73  
  74  
  75   --- Routin e Detail - --