IBINI01U ; ; 21-MAR-1994
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
Q:'DIFQ(350.5) F I=1:2 S X=$T(Q+I) Q:X="" S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E S @X=Y
Q Q
;;^DIC(350.5,0,"GL")
;;=^IBE(350.5,
;;^DIC("B","BASC LOCALITY MODIFIER",350.5)
;;=
;;^DIC(350.5,"%D",0)
;;=^^7^7^2940214^^^^
;;^DIC(350.5,"%D",1,0)
;;=This file is used in the calculation of the charge for an ambulatory
;;^DIC(350.5,"%D",2,0)
;;=surgery performed on any given date. This file contains time sensitive data
;;^DIC(350.5,"%D",3,0)
;;=with each entry defining a locality modifier and wage percentage for a
;;^DIC(350.5,"%D",4,0)
;;=division. There may be multiple entries for each division indicating changes
;;^DIC(350.5,"%D",5,0)
;;=effective on a particular date.
;;^DIC(350.5,"%D",6,0)
;;=
;;^DIC(350.5,"%D",7,0)
;;=Per VHA Directive 10-93-142, this file definition should not be modified.
;;^DD(350.5,0)
;;=FIELD^^.07^6
;;^DD(350.5,0,"DDA")
;;=N
;;^DD(350.5,0,"DT")
;;=2920121
;;^DD(350.5,0,"ID",.02)
;;=S %I=Y,Y=$S('$D(^(0)):"",$D(^DG(40.8,+$P(^(0),U,2),0))#2:$P(^(0),U,1),1:""),C=$P(^DD(40.8,.01,0),U,2) D Y^DIQ:Y]"" W " ",Y,@("$E("_DIC_"%I,0),0)") S Y=%I K %I
;;^DD(350.5,0,"ID",.04)
;;=W " ",@("$P($P($C(59)_$S($D(^DD(350.5,.04,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,4)_"":"",2),$C(59),1)")
;;^DD(350.5,0,"ID",.07)
;;=W " ",$P(^(0),U,7)
;;^DD(350.5,0,"IX","AIVDT",350.5,.01)
;;=
;;^DD(350.5,0,"IX","AIVDT1",350.5,.02)
;;=
;;^DD(350.5,0,"IX","B",350.5,.01)
;;=
;;^DD(350.5,0,"IX","C",350.5,.02)
;;=
;;^DD(350.5,0,"NM","BASC LOCALITY MODIFIER")
;;=
;;^DD(350.5,.01,0)
;;=EFFECTIVE DATE^RD^^0;1^S %DT="EX" D ^%DT S X=Y K:Y<1 X
;;^DD(350.5,.01,1,0)
;;=^.1
;;^DD(350.5,.01,1,1,0)
;;=350.5^B
;;^DD(350.5,.01,1,1,1)
;;=S ^IBE(350.5,"B",$E(X,1,30),DA)=""
;;^DD(350.5,.01,1,1,2)
;;=K ^IBE(350.5,"B",$E(X,1,30),DA)
;;^DD(350.5,.01,1,2,0)
;;=350.5^AIVDT^MUMPS
;;^DD(350.5,.01,1,2,1)
;;=I $P(^IBE(350.5,DA,0),"^",2) S ^IBE(350.5,"AIVDT",$P(^(0),"^",2),-X,DA)=""
;;^DD(350.5,.01,1,2,2)
;;=I $P(^IBE(350.5,DA,0),"^",2) K ^IBE(350.5,"AIVDT",$P(^(0),"^",2),-X,DA)
;;^DD(350.5,.01,1,2,"%D",0)
;;=^^1^1^2911113^^
;;^DD(350.5,.01,1,2,"%D",1,0)
;;=Used to find the appropriate entry for a division on any particular date.
;;^DD(350.5,.01,1,2,"DT")
;;=2911113
;;^DD(350.5,.01,3)
;;=
;;^DD(350.5,.01,21,0)
;;=^^3^3^2911113^^
;;^DD(350.5,.01,21,1,0)
;;=The date on which this entries data becomes effective.
;;^DD(350.5,.01,21,2,0)
;;=The data in this entry will override any other entry for
;;^DD(350.5,.01,21,3,0)
;;=this DIVISION that has a previous EFFECTIVE DATE.
;;^DD(350.5,.01,"DT")
;;=2911113
;;^DD(350.5,.02,0)
;;=DIVISION^RP40.8'^DG(40.8,^0;2^Q
;;^DD(350.5,.02,1,0)
;;=^.1
;;^DD(350.5,.02,1,1,0)
;;=350.5^C
;;^DD(350.5,.02,1,1,1)
;;=S ^IBE(350.5,"C",$E(X,1,30),DA)=""
;;^DD(350.5,.02,1,1,2)
;;=K ^IBE(350.5,"C",$E(X,1,30),DA)
;;^DD(350.5,.02,1,1,"DT")
;;=2910829
;;^DD(350.5,.02,1,2,0)
;;=350.5^AIVDT1^MUMPS
;;^DD(350.5,.02,1,2,1)
;;=I $P(^IBE(350.5,DA,0),"^") S ^IBE(350.5,"AIVDT",X,-$P(^(0),"^"),DA)=""
;;^DD(350.5,.02,1,2,2)
;;=I $P(^IBE(350.5,DA,0),"^") K ^IBE(350.5,"AIVDT",X,-$P(^(0),"^"),DA)
;;^DD(350.5,.02,1,2,"%D",0)
;;=^^1^1^2911113^
;;^DD(350.5,.02,1,2,"%D",1,0)
;;=Used to find the correct entry for a division for a particular date.
;;^DD(350.5,.02,1,2,"DT")
;;=2910829
;;^DD(350.5,.02,21,0)
;;=^^1^1^2920121^^
;;^DD(350.5,.02,21,1,0)
;;=The division that this data applies to.
;;^DD(350.5,.02,"DT")
;;=2920121
;;^DD(350.5,.04,0)
;;=STATUS^RS^1:ACTIVE;0:INACTIVE;^0;4^Q
;;^DD(350.5,.04,21,0)
;;=^^1^1^2920723^^^
;;^DD(350.5,.04,21,1,0)
;;=The status for this DIVISION on/after this EFFECTIVE DATE.
IBINI01U ; ; 21-MAR-1994
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 IF 'DIFQ(350.5)
QUIT
FOR I=1:2
SET X=$TEXT(Q+I)
IF X=""
QUIT
SET Y=$EXTRACT($TEXT(Q+I+1),4,999)
SET X=$EXTRACT(X,4,999)
IF $ASCII(Y)=126
SET I=I+1
SET Y=$EXTRACT(Y,2,999)_$EXTRACT($TEXT(Q+I+1),5,99)
IF $ASCII(Y)=61
SET Y=$EXTRACT(Y,2,999)
XECUTE NO
IF '$TEST
SET @X=Y
Q QUIT
+1 ;;^DIC(350.5,0,"GL")
+2 ;;=^IBE(350.5,
+3 ;;^DIC("B","BASC LOCALITY MODIFIER",350.5)
+4 ;;=
+5 ;;^DIC(350.5,"%D",0)
+6 ;;=^^7^7^2940214^^^^
+7 ;;^DIC(350.5,"%D",1,0)
+8 ;;=This file is used in the calculation of the charge for an ambulatory
+9 ;;^DIC(350.5,"%D",2,0)
+10 ;;=surgery performed on any given date. This file contains time sensitive data
+11 ;;^DIC(350.5,"%D",3,0)
+12 ;;=with each entry defining a locality modifier and wage percentage for a
+13 ;;^DIC(350.5,"%D",4,0)
+14 ;;=division. There may be multiple entries for each division indicating changes
+15 ;;^DIC(350.5,"%D",5,0)
+16 ;;=effective on a particular date.
+17 ;;^DIC(350.5,"%D",6,0)
+18 ;;=
+19 ;;^DIC(350.5,"%D",7,0)
+20 ;;=Per VHA Directive 10-93-142, this file definition should not be modified.
+21 ;;^DD(350.5,0)
+22 ;;=FIELD^^.07^6
+23 ;;^DD(350.5,0,"DDA")
+24 ;;=N
+25 ;;^DD(350.5,0,"DT")
+26 ;;=2920121
+27 ;;^DD(350.5,0,"ID",.02)
+28 ;;=S %I=Y,Y=$S('$D(^(0)):"",$D(^DG(40.8,+$P(^(0),U,2),0))#2:$P(^(0),U,1),1:""),C=$P(^DD(40.8,.01,0),U,2) D Y^DIQ:Y]"" W " ",Y,@("$E("_DIC_"%I,0),0)") S Y=%I K %I
+29 ;;^DD(350.5,0,"ID",.04)
+30 ;;=W " ",@("$P($P($C(59)_$S($D(^DD(350.5,.04,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,4)_"":"",2),$C(59),1)")
+31 ;;^DD(350.5,0,"ID",.07)
+32 ;;=W " ",$P(^(0),U,7)
+33 ;;^DD(350.5,0,"IX","AIVDT",350.5,.01)
+34 ;;=
+35 ;;^DD(350.5,0,"IX","AIVDT1",350.5,.02)
+36 ;;=
+37 ;;^DD(350.5,0,"IX","B",350.5,.01)
+38 ;;=
+39 ;;^DD(350.5,0,"IX","C",350.5,.02)
+40 ;;=
+41 ;;^DD(350.5,0,"NM","BASC LOCALITY MODIFIER")
+42 ;;=
+43 ;;^DD(350.5,.01,0)
+44 ;;=EFFECTIVE DATE^RD^^0;1^S %DT="EX" D ^%DT S X=Y K:Y<1 X
+45 ;;^DD(350.5,.01,1,0)
+46 ;;=^.1
+47 ;;^DD(350.5,.01,1,1,0)
+48 ;;=350.5^B
+49 ;;^DD(350.5,.01,1,1,1)
+50 ;;=S ^IBE(350.5,"B",$E(X,1,30),DA)=""
+51 ;;^DD(350.5,.01,1,1,2)
+52 ;;=K ^IBE(350.5,"B",$E(X,1,30),DA)
+53 ;;^DD(350.5,.01,1,2,0)
+54 ;;=350.5^AIVDT^MUMPS
+55 ;;^DD(350.5,.01,1,2,1)
+56 ;;=I $P(^IBE(350.5,DA,0),"^",2) S ^IBE(350.5,"AIVDT",$P(^(0),"^",2),-X,DA)=""
+57 ;;^DD(350.5,.01,1,2,2)
+58 ;;=I $P(^IBE(350.5,DA,0),"^",2) K ^IBE(350.5,"AIVDT",$P(^(0),"^",2),-X,DA)
+59 ;;^DD(350.5,.01,1,2,"%D",0)
+60 ;;=^^1^1^2911113^^
+61 ;;^DD(350.5,.01,1,2,"%D",1,0)
+62 ;;=Used to find the appropriate entry for a division on any particular date.
+63 ;;^DD(350.5,.01,1,2,"DT")
+64 ;;=2911113
+65 ;;^DD(350.5,.01,3)
+66 ;;=
+67 ;;^DD(350.5,.01,21,0)
+68 ;;=^^3^3^2911113^^
+69 ;;^DD(350.5,.01,21,1,0)
+70 ;;=The date on which this entries data becomes effective.
+71 ;;^DD(350.5,.01,21,2,0)
+72 ;;=The data in this entry will override any other entry for
+73 ;;^DD(350.5,.01,21,3,0)
+74 ;;=this DIVISION that has a previous EFFECTIVE DATE.
+75 ;;^DD(350.5,.01,"DT")
+76 ;;=2911113
+77 ;;^DD(350.5,.02,0)
+78 ;;=DIVISION^RP40.8'^DG(40.8,^0;2^Q
+79 ;;^DD(350.5,.02,1,0)
+80 ;;=^.1
+81 ;;^DD(350.5,.02,1,1,0)
+82 ;;=350.5^C
+83 ;;^DD(350.5,.02,1,1,1)
+84 ;;=S ^IBE(350.5,"C",$E(X,1,30),DA)=""
+85 ;;^DD(350.5,.02,1,1,2)
+86 ;;=K ^IBE(350.5,"C",$E(X,1,30),DA)
+87 ;;^DD(350.5,.02,1,1,"DT")
+88 ;;=2910829
+89 ;;^DD(350.5,.02,1,2,0)
+90 ;;=350.5^AIVDT1^MUMPS
+91 ;;^DD(350.5,.02,1,2,1)
+92 ;;=I $P(^IBE(350.5,DA,0),"^") S ^IBE(350.5,"AIVDT",X,-$P(^(0),"^"),DA)=""
+93 ;;^DD(350.5,.02,1,2,2)
+94 ;;=I $P(^IBE(350.5,DA,0),"^") K ^IBE(350.5,"AIVDT",X,-$P(^(0),"^"),DA)
+95 ;;^DD(350.5,.02,1,2,"%D",0)
+96 ;;=^^1^1^2911113^
+97 ;;^DD(350.5,.02,1,2,"%D",1,0)
+98 ;;=Used to find the correct entry for a division for a particular date.
+99 ;;^DD(350.5,.02,1,2,"DT")
+100 ;;=2910829
+101 ;;^DD(350.5,.02,21,0)
+102 ;;=^^1^1^2920121^^
+103 ;;^DD(350.5,.02,21,1,0)
+104 ;;=The division that this data applies to.
+105 ;;^DD(350.5,.02,"DT")
+106 ;;=2920121
+107 ;;^DD(350.5,.04,0)
+108 ;;=STATUS^RS^1:ACTIVE;0:INACTIVE;^0;4^Q
+109 ;;^DD(350.5,.04,21,0)
+110 ;;=^^1^1^2920723^^^
+111 ;;^DD(350.5,.04,21,1,0)
+112 ;;=The status for this DIVISION on/after this EFFECTIVE DATE.
