IBY371PO ;ALB/WCJ - Post Install for IB patch 371 ;17-APR-2007
;;2.0;INTEGRATED BILLING;**371**;21-MAR-94;Build 57
;
EN ;
N XPDIDTOT S XPDIDTOT=5
D RIT ; 1. Recompile input templates
D CUINS ; 2. Clean up duplicate insurance address lines
D MEDWNR ; 3. Pre-populate Medicare WNR with professional payer ID 2U and station number
D VCHELP ; 4. Add help text to Value Codes and Deactivate some value codes.
D NEWXREF ; 5. Add NEW STYLE XREF to Value Code Subfile in 399.047
EX ;
Q
;
RIT ; Recompile input templates for billing screens
NEW X,Y,DMAX
D BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Recompiling Input Templates for Billing Screens 3 through 7 ....")
S X="IBXSC3",Y=$$FIND1^DIC(.402,,"X","IB SCREEN3","B"),DMAX=8000
I Y D EN^DIEZ
S X="IBXSC4",Y=$$FIND1^DIC(.402,,"X","IB SCREEN4","B"),DMAX=8000
I Y D EN^DIEZ
S X="IBXSC5",Y=$$FIND1^DIC(.402,,"X","IB SCREEN5","B"),DMAX=8000
I Y D EN^DIEZ
S X="IBXSC6",Y=$$FIND1^DIC(.402,,"X","IB SCREEN6","B"),DMAX=8000
I Y D EN^DIEZ
S X="IBXSC7",Y=$$FIND1^DIC(.402,,"X","IB SCREEN7","B"),DMAX=8000
I Y D EN^DIEZ
RITX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(1)
Q
;
CUINS ; Clean up Insurance company address line duplicates
;
D BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Removing duplicate address lines in insurance company file")
;
N INSCO,ADDLOC,I,FIELD,VALUE
S INSCO=0 F S INSCO=$O(^DIC(36,INSCO)) Q:'+INSCO D
. F ADDLOC=.11,.12,.14,.15,.16,.18 D
.. N ADDRESS
.. F I=1:1:3 D
... S FIELD=ADDLOC_I
... S ADDRESS(I)=$$UP^XLFSTR($$GET1^DIQ(36,INSCO,FIELD))
... D CLEAN^DILF
.. ;
.. I ADDRESS(3)]"",ADDRESS(3)=ADDRESS(2)!(ADDRESS(3)=ADDRESS(1)) D
... S VALUE="@",FIELD=ADDLOC_3
... D POPULATE(INSCO,FIELD,VALUE)
... S ADDRESS(3)=""
.. ;
.. I ADDRESS(2)]"",ADDRESS(2)=ADDRESS(1) D
... S FIELD=ADDLOC_2
... S VALUE=$S(ADDRESS(3)="":"@",1:ADDRESS(3))
... D POPULATE(INSCO,FIELD,VALUE)
;
CUINSX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(2)
Q
;
POPULATE(INSCO,FLD,VAL) ;
N X,Y,DA,DIE,DR
S DA=INSCO
S DIE=36
S DR=FLD_"////"_VAL
D ^DIE
Q
;
MEDWNR ; Prepopulate Medicare WNR with professional payer ID 2U and station number
;
D BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Prepopulate Medicare WNR with professional payer ID")
;
N INSCO,SITE
S SITE="VA"_$P($$SITE^VASITE,U,3)
S INSCO=0 F S INSCO=$O(^DIC(36,"B","MEDICARE (WNR)",INSCO)) Q:'+INSCO D
. N X,Y,DA,DIE,DR
. S DA=INSCO
. S DIE=36
. S DR="6.05////2U;6.06////"_SITE
. D ^DIE
MEDWNRX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(3)
Q
;
VCHELP ;
;
D BMES^XPDUTL(" STEP 4 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Add help text and obsolete date to value codes")
;
N VC
S VC("45",1)="Enter the hour when the accident occurred that caused"
S VC("45",2)="the need for medical treatment. "
S VC("45",3)=" "
S VC("45",4)="Enter correct code."
S VC("45",5)="00 12:00-12:59 (Midnight)"
S VC("45",6)="01 01:00-01:59 AM"
S VC("45",7)="02 02:00-02:59 AM"
S VC("45",8)="03 03:00-03:59 AM"
S VC("45",9)="04 04:00-04:59 AM"
S VC("45",10)="05 05:00-05:59 AM"
S VC("45",11)="06 06:00-06:59 AM"
S VC("45",12)="07 07:00-07:59 AM"
S VC("45",13)="08 08:00-08:59 AM"
S VC("45",14)="09 09:00-09:59 AM"
S VC("45",15)="10 10:00-10:59 AM"
S VC("45",16)="11 11:00-11:59 AM"
S VC("45",17)="12 12:00-12:59 (Noon)"
S VC("45",18)="13 01:00-01:59 PM"
S VC("45",19)="14 02:00-02:59 PM"
S VC("45",20)="15 03:00-03:59 PM"
S VC("45",21)="16 04:00-04:59 PM"
S VC("45",22)="17 05:00-05:59 PM"
S VC("45",23)="18 06:00-06:59 PM"
S VC("45",24)="19 07:00-07:59 PM"
S VC("45",25)="20 08:00-08:59 PM"
S VC("45",26)="21 09:00-09:59 PM"
S VC("45",27)="22 10:00-10:59 PM"
S VC("45",28)="23 11:00-11:59 PM"
S VC("45",29)="99 Unknown"
S VC("24",1)="Medicaid-eligibility requirements to be determined at state level."
S VC("37",1)="Enter the total number of pints of whole blood or"
S VC("37",2)="units of packed red cells furnished to the patient."
S VC("38",1)="Enter the total number of pints of whole blood or"
S VC("38",2)="units of packed red cells furnished to the patient."
S VC("46",1)="Enter the number of days determined by the QIO (medical"
S VC("46",2)="necessity reviewer) as needed to arrange for post-discharge"
S VC("46",3)="care."
S VC("48",1)="Enter the most recent hemoglobin reading taken before"
S VC("48",2)="the start of this billing period."
S VC("48",3)="Enter it in the format XX.X."
S VC("49",1)="Enter the most recent hematocrit reading taken before"
S VC("49",2)="the start of this billing period."
S VC("49",3)="Enter it in the format XX.X."
S VC("50",1)="Enter the number of physical therapy visits provided"
S VC("50",2)="from the onset of treatment by this billing provider"
S VC("50",3)="through this billing period."
S VC("51",1)="Enter the number of occupational therapy visits provided"
S VC("51",2)="from the onset of treatment by this billing provider"
S VC("51",3)="through this billing period."
S VC("52",1)="Enter the number of speech therapy visits provided"
S VC("52",2)="from the onset of treatment by this billing provider"
S VC("52",3)="through this billing period."
S VC("53",1)="Enter the number of cardiac rehabilitation visits provided"
S VC("53",2)="from the onset of treatment by this billing provider"
S VC("53",3)="through this billing period."
S VC("56",1)="Enter the number of home visit hours of skilled"
S VC("56",2)="nursing provided during the billing period. Do"
S VC("56",3)="not include travel time. Enter whole hours."
S VC("57",1)="Enter the number of home health aide hours of service"
S VC("57",2)="provided during the billing period. Do"
S VC("57",3)="not include travel time. Enter whole hours."
S VC("58",1)="Enter arterial blood gas value at the beginning of "
S VC("58",2)="each reporting period for oxygen therapy. Code 58 "
S VC("58",3)="or 59 required on the initial bill and the fourth "
S VC("58",4)="month's bill. Enter the nearest whole number "
S VC("58",5)="(Example: 56.5 is entered as 57.)"
S VC("59",1)="Enter oxygen saturation value at the beginning of "
S VC("59",2)="each reporting period for oxygen therapy. Code 58 "
S VC("59",3)="or 59 required on the initial bill and the fourth "
S VC("59",4)="month's bill. Enter the nearest whole percent "
S VC("59",5)="(Example: 93.5 is entered as 94.)"
S VC("60",1)="Enter the MSA number in which the HHA branch is located "
S VC("60",2)="when the MSA's branch location is different than the "
S VC("60",3)="HHA's. "
S VC("68",1)="Enter the number of units of EPO administered and/or"
S VC("68",2)="supplied related to this billing period. Enter amount"
S VC("68",3)="in whole units."
S VC("39",1)="Enter the total number of pints of whole blood or"
S VC("39",2)="units of packed red cells furnished to the patient."
S VC("61",1)="Enter MSA or Core Based Statistical Area (CBSA)"
S VC("61",2)="number (or rural state code) of the location"
S VC("61",3)="where the home health or hospice service was "
S VC("61",4)="delivered. Do not include travel time. Enter a "
S VC("61",5)="whole number rounded to the nearest whole hour."
S VC("67",1)="Enter the number of hours of peritoneal dialysis"
S VC("67",2)="provided during the billing period. "
S VC("A0",1)="Enter the 5 digit ZIP Code of the location at which "
S VC("A0",2)="the beneficiary is initially placed on board the"
S VC("A0",3)="ambulance."
; defaults
S VC("AMT",1)="Enter a monetary amount associated with this value code."
S VC("AMT",2)="Enter it in the format of dollars and cents (00.00)."
S VC("AMT",3)=" "
S VC("AMT",4)="If you enter only dollars (00), the system will add on .00 cents."
S VC("AMT",5)="Maximum length INCLUDING the cents, is 9 numbers."
;
N DA,CODE,DAT,AMTFLG
S DA=0 F S DA=$O(^DGCR(399.1,DA)) Q:DA="" D
. N HLPTXT,FDA
. S DAT=$G(^(DA,0))
. Q:'$P(DAT,U,11) ; not a value code
. S CODE=$P(DAT,U,2)
. Q:CODE=""
. I ".E1.E2.E3.F1.F2.F3.G1.G2.G3."[("."_CODE_".") S FDA(399.1,DA_",",.26)=3070301
. S AMTFLG=0
. I '$D(VC(CODE)) S CODE="AMT",AMTFLG=1
. M HLPTXT=VC(CODE)
. S FDA(399.1,DA_",",1)="HLPTXT"
. S FDA(399.1,DA_",",.19)=$S(AMTFLG:1,1:0)
. S FDA="FDA"
. D FILE^DIE("",FDA)
;
VCHELPX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(4)
Q
;
NEWXREF ;
;
D BMES^XPDUTL(" STEP 5 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Adding new style cross reference")
;
N ZZWJXR,ZZWJRES,ZZWJOUT
S ZZWJXR("FILE")=399.047
S ZZWJXR("NAME")="AC"
S ZZWJXR("TYPE")="MU"
S ZZWJXR("USE")="A"
S ZZWJXR("EXECUTION")="F"
S ZZWJXR("ACTIVITY")=""
S ZZWJXR("SHORT DESCR")="VALUE field clean up"
S ZZWJXR("DESCR",1)="If the VALUE CODE field is modified, make sure the VALUE field associated"
S ZZWJXR("DESCR",2)="with it is still VALID. If not, delete the VALUE."
S ZZWJXR("SET")="D REMOVE^IBCVC(.DA)"
S ZZWJXR("KILL")="Q"
S ZZWJXR("SET CONDITION")="S X=$$COND^IBCVC(.DA,X1(1),X2(1))"
S ZZWJXR("VAL",1)=.01
S ZZWJXR("VAL",1,"COLLATION")="F"
D CREIXN^DDMOD(.ZZWJXR,"",.ZZWJRES,"ZZWJOUT")
;
NEWXREFX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(5)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY371PO 9533 printed Dec 13, 2024@02:33:52 Page 2
IBY371PO ;ALB/WCJ - Post Install for IB patch 371 ;17-APR-2007
+1 ;;2.0;INTEGRATED BILLING;**371**;21-MAR-94;Build 57
+2 ;
EN ;
+1 NEW XPDIDTOT
SET XPDIDTOT=5
+2 ; 1. Recompile input templates
DO RIT
+3 ; 2. Clean up duplicate insurance address lines
DO CUINS
+4 ; 3. Pre-populate Medicare WNR with professional payer ID 2U and station number
DO MEDWNR
+5 ; 4. Add help text to Value Codes and Deactivate some value codes.
DO VCHELP
+6 ; 5. Add NEW STYLE XREF to Value Code Subfile in 399.047
DO NEWXREF
EX ;
+1 QUIT
+2 ;
RIT ; Recompile input templates for billing screens
+1 NEW X,Y,DMAX
+2 DO BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Recompiling Input Templates for Billing Screens 3 through 7 ....")
+5 SET X="IBXSC3"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN3","B")
SET DMAX=8000
+6 IF Y
DO EN^DIEZ
+7 SET X="IBXSC4"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN4","B")
SET DMAX=8000
+8 IF Y
DO EN^DIEZ
+9 SET X="IBXSC5"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN5","B")
SET DMAX=8000
+10 IF Y
DO EN^DIEZ
+11 SET X="IBXSC6"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN6","B")
SET DMAX=8000
+12 IF Y
DO EN^DIEZ
+13 SET X="IBXSC7"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN7","B")
SET DMAX=8000
+14 IF Y
DO EN^DIEZ
RITX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(1)
+3 QUIT
+4 ;
CUINS ; Clean up Insurance company address line duplicates
+1 ;
+2 DO BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Removing duplicate address lines in insurance company file")
+5 ;
+6 NEW INSCO,ADDLOC,I,FIELD,VALUE
+7 SET INSCO=0
FOR
SET INSCO=$ORDER(^DIC(36,INSCO))
if '+INSCO
QUIT
Begin DoDot:1
+8 FOR ADDLOC=.11,.12,.14,.15,.16,.18
Begin DoDot:2
+9 NEW ADDRESS
+10 FOR I=1:1:3
Begin DoDot:3
+11 SET FIELD=ADDLOC_I
+12 SET ADDRESS(I)=$$UP^XLFSTR($$GET1^DIQ(36,INSCO,FIELD))
+13 DO CLEAN^DILF
End DoDot:3
+14 ;
+15 IF ADDRESS(3)]""
IF ADDRESS(3)=ADDRESS(2)!(ADDRESS(3)=ADDRESS(1))
Begin DoDot:3
+16 SET VALUE="@"
SET FIELD=ADDLOC_3
+17 DO POPULATE(INSCO,FIELD,VALUE)
+18 SET ADDRESS(3)=""
End DoDot:3
+19 ;
+20 IF ADDRESS(2)]""
IF ADDRESS(2)=ADDRESS(1)
Begin DoDot:3
+21 SET FIELD=ADDLOC_2
+22 SET VALUE=$SELECT(ADDRESS(3)="":"@",1:ADDRESS(3))
+23 DO POPULATE(INSCO,FIELD,VALUE)
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
CUINSX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(2)
+3 QUIT
+4 ;
POPULATE(INSCO,FLD,VAL) ;
+1 NEW X,Y,DA,DIE,DR
+2 SET DA=INSCO
+3 SET DIE=36
+4 SET DR=FLD_"////"_VAL
+5 DO ^DIE
+6 QUIT
+7 ;
MEDWNR ; Prepopulate Medicare WNR with professional payer ID 2U and station number
+1 ;
+2 DO BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Prepopulate Medicare WNR with professional payer ID")
+5 ;
+6 NEW INSCO,SITE
+7 SET SITE="VA"_$PIECE($$SITE^VASITE,U,3)
+8 SET INSCO=0
FOR
SET INSCO=$ORDER(^DIC(36,"B","MEDICARE (WNR)",INSCO))
if '+INSCO
QUIT
Begin DoDot:1
+9 NEW X,Y,DA,DIE,DR
+10 SET DA=INSCO
+11 SET DIE=36
+12 SET DR="6.05////2U;6.06////"_SITE
+13 DO ^DIE
End DoDot:1
MEDWNRX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(3)
+3 QUIT
+4 ;
VCHELP ;
+1 ;
+2 DO BMES^XPDUTL(" STEP 4 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Add help text and obsolete date to value codes")
+5 ;
+6 NEW VC
+7 SET VC("45",1)="Enter the hour when the accident occurred that caused"
+8 SET VC("45",2)="the need for medical treatment. "
+9 SET VC("45",3)=" "
+10 SET VC("45",4)="Enter correct code."
+11 SET VC("45",5)="00 12:00-12:59 (Midnight)"
+12 SET VC("45",6)="01 01:00-01:59 AM"
+13 SET VC("45",7)="02 02:00-02:59 AM"
+14 SET VC("45",8)="03 03:00-03:59 AM"
+15 SET VC("45",9)="04 04:00-04:59 AM"
+16 SET VC("45",10)="05 05:00-05:59 AM"
+17 SET VC("45",11)="06 06:00-06:59 AM"
+18 SET VC("45",12)="07 07:00-07:59 AM"
+19 SET VC("45",13)="08 08:00-08:59 AM"
+20 SET VC("45",14)="09 09:00-09:59 AM"
+21 SET VC("45",15)="10 10:00-10:59 AM"
+22 SET VC("45",16)="11 11:00-11:59 AM"
+23 SET VC("45",17)="12 12:00-12:59 (Noon)"
+24 SET VC("45",18)="13 01:00-01:59 PM"
+25 SET VC("45",19)="14 02:00-02:59 PM"
+26 SET VC("45",20)="15 03:00-03:59 PM"
+27 SET VC("45",21)="16 04:00-04:59 PM"
+28 SET VC("45",22)="17 05:00-05:59 PM"
+29 SET VC("45",23)="18 06:00-06:59 PM"
+30 SET VC("45",24)="19 07:00-07:59 PM"
+31 SET VC("45",25)="20 08:00-08:59 PM"
+32 SET VC("45",26)="21 09:00-09:59 PM"
+33 SET VC("45",27)="22 10:00-10:59 PM"
+34 SET VC("45",28)="23 11:00-11:59 PM"
+35 SET VC("45",29)="99 Unknown"
+36 SET VC("24",1)="Medicaid-eligibility requirements to be determined at state level."
+37 SET VC("37",1)="Enter the total number of pints of whole blood or"
+38 SET VC("37",2)="units of packed red cells furnished to the patient."
+39 SET VC("38",1)="Enter the total number of pints of whole blood or"
+40 SET VC("38",2)="units of packed red cells furnished to the patient."
+41 SET VC("46",1)="Enter the number of days determined by the QIO (medical"
+42 SET VC("46",2)="necessity reviewer) as needed to arrange for post-discharge"
+43 SET VC("46",3)="care."
+44 SET VC("48",1)="Enter the most recent hemoglobin reading taken before"
+45 SET VC("48",2)="the start of this billing period."
+46 SET VC("48",3)="Enter it in the format XX.X."
+47 SET VC("49",1)="Enter the most recent hematocrit reading taken before"
+48 SET VC("49",2)="the start of this billing period."
+49 SET VC("49",3)="Enter it in the format XX.X."
+50 SET VC("50",1)="Enter the number of physical therapy visits provided"
+51 SET VC("50",2)="from the onset of treatment by this billing provider"
+52 SET VC("50",3)="through this billing period."
+53 SET VC("51",1)="Enter the number of occupational therapy visits provided"
+54 SET VC("51",2)="from the onset of treatment by this billing provider"
+55 SET VC("51",3)="through this billing period."
+56 SET VC("52",1)="Enter the number of speech therapy visits provided"
+57 SET VC("52",2)="from the onset of treatment by this billing provider"
+58 SET VC("52",3)="through this billing period."
+59 SET VC("53",1)="Enter the number of cardiac rehabilitation visits provided"
+60 SET VC("53",2)="from the onset of treatment by this billing provider"
+61 SET VC("53",3)="through this billing period."
+62 SET VC("56",1)="Enter the number of home visit hours of skilled"
+63 SET VC("56",2)="nursing provided during the billing period. Do"
+64 SET VC("56",3)="not include travel time. Enter whole hours."
+65 SET VC("57",1)="Enter the number of home health aide hours of service"
+66 SET VC("57",2)="provided during the billing period. Do"
+67 SET VC("57",3)="not include travel time. Enter whole hours."
+68 SET VC("58",1)="Enter arterial blood gas value at the beginning of "
+69 SET VC("58",2)="each reporting period for oxygen therapy. Code 58 "
+70 SET VC("58",3)="or 59 required on the initial bill and the fourth "
+71 SET VC("58",4)="month's bill. Enter the nearest whole number "
+72 SET VC("58",5)="(Example: 56.5 is entered as 57.)"
+73 SET VC("59",1)="Enter oxygen saturation value at the beginning of "
+74 SET VC("59",2)="each reporting period for oxygen therapy. Code 58 "
+75 SET VC("59",3)="or 59 required on the initial bill and the fourth "
+76 SET VC("59",4)="month's bill. Enter the nearest whole percent "
+77 SET VC("59",5)="(Example: 93.5 is entered as 94.)"
+78 SET VC("60",1)="Enter the MSA number in which the HHA branch is located "
+79 SET VC("60",2)="when the MSA's branch location is different than the "
+80 SET VC("60",3)="HHA's. "
+81 SET VC("68",1)="Enter the number of units of EPO administered and/or"
+82 SET VC("68",2)="supplied related to this billing period. Enter amount"
+83 SET VC("68",3)="in whole units."
+84 SET VC("39",1)="Enter the total number of pints of whole blood or"
+85 SET VC("39",2)="units of packed red cells furnished to the patient."
+86 SET VC("61",1)="Enter MSA or Core Based Statistical Area (CBSA)"
+87 SET VC("61",2)="number (or rural state code) of the location"
+88 SET VC("61",3)="where the home health or hospice service was "
+89 SET VC("61",4)="delivered. Do not include travel time. Enter a "
+90 SET VC("61",5)="whole number rounded to the nearest whole hour."
+91 SET VC("67",1)="Enter the number of hours of peritoneal dialysis"
+92 SET VC("67",2)="provided during the billing period. "
+93 SET VC("A0",1)="Enter the 5 digit ZIP Code of the location at which "
+94 SET VC("A0",2)="the beneficiary is initially placed on board the"
+95 SET VC("A0",3)="ambulance."
+96 ; defaults
+97 SET VC("AMT",1)="Enter a monetary amount associated with this value code."
+98 SET VC("AMT",2)="Enter it in the format of dollars and cents (00.00)."
+99 SET VC("AMT",3)=" "
+100 SET VC("AMT",4)="If you enter only dollars (00), the system will add on .00 cents."
+101 SET VC("AMT",5)="Maximum length INCLUDING the cents, is 9 numbers."
+102 ;
+103 NEW DA,CODE,DAT,AMTFLG
+104 SET DA=0
FOR
SET DA=$ORDER(^DGCR(399.1,DA))
if DA=""
QUIT
Begin DoDot:1
+105 NEW HLPTXT,FDA
+106 SET DAT=$GET(^(DA,0))
+107 ; not a value code
if '$PIECE(DAT,U,11)
QUIT
+108 SET CODE=$PIECE(DAT,U,2)
+109 if CODE=""
QUIT
+110 IF ".E1.E2.E3.F1.F2.F3.G1.G2.G3."[("."_CODE_".")
SET FDA(399.1,DA_",",.26)=3070301
+111 SET AMTFLG=0
+112 IF '$DATA(VC(CODE))
SET CODE="AMT"
SET AMTFLG=1
+113 MERGE HLPTXT=VC(CODE)
+114 SET FDA(399.1,DA_",",1)="HLPTXT"
+115 SET FDA(399.1,DA_",",.19)=$SELECT(AMTFLG:1,1:0)
+116 SET FDA="FDA"
+117 DO FILE^DIE("",FDA)
End DoDot:1
+118 ;
VCHELPX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(4)
+3 QUIT
+4 ;
NEWXREF ;
+1 ;
+2 DO BMES^XPDUTL(" STEP 5 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Adding new style cross reference")
+5 ;
+6 NEW ZZWJXR,ZZWJRES,ZZWJOUT
+7 SET ZZWJXR("FILE")=399.047
+8 SET ZZWJXR("NAME")="AC"
+9 SET ZZWJXR("TYPE")="MU"
+10 SET ZZWJXR("USE")="A"
+11 SET ZZWJXR("EXECUTION")="F"
+12 SET ZZWJXR("ACTIVITY")=""
+13 SET ZZWJXR("SHORT DESCR")="VALUE field clean up"
+14 SET ZZWJXR("DESCR",1)="If the VALUE CODE field is modified, make sure the VALUE field associated"
+15 SET ZZWJXR("DESCR",2)="with it is still VALID. If not, delete the VALUE."
+16 SET ZZWJXR("SET")="D REMOVE^IBCVC(.DA)"
+17 SET ZZWJXR("KILL")="Q"
+18 SET ZZWJXR("SET CONDITION")="S X=$$COND^IBCVC(.DA,X1(1),X2(1))"
+19 SET ZZWJXR("VAL",1)=.01
+20 SET ZZWJXR("VAL",1,"COLLATION")="F"
+21 DO CREIXN^DDMOD(.ZZWJXR,"",.ZZWJRES,"ZZWJOUT")
+22 ;
NEWXREFX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(5)
+3 QUIT