Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXSC79.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXSC79.m (modified) (2 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXSC79.m

@@ -1 @@
-IBXSC79 ; ;07/22/08
+IBXSC79 ; ;12/27/07
  D DE G BEGIN
 DE S DIE="^DGCR(399,D0,""RC"",",DIC=DIE,DP=399.042,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^DGCR(399,D0,"RC",DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=% S %=$P(%Z,U,2) S:%]"" DE(2)=% S %=$P(%Z,U,3) S:%]"" DE(3)=% S %=$P(%Z,U,4) S:%]"" DE(4)=% S %=$P(%Z,U,5) S:%]"" DE(5)=% S %=$P(%Z,U,6) S:%]"" DE(7)=% S %=$P(%Z,U,7) S:%]"" DE(9)=%
- I  S %=$P(%Z,U,9) S:%]"" DE(6)=% S %=$P(%Z,U,10) S:%]"" DE(12)=% S %=$P(%Z,U,12) S:%]"" DE(13)=%
+ I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=% S %=$P(%Z,U,2) S:%]"" DE(2)=% S %=$P(%Z,U,3) S:%]"" DE(3)=% S %=$P(%Z,U,4) S:%]"" DE(4)=% S %=$P(%Z,U,5) S:%]"" DE(5)=% S %=$P(%Z,U,6) S:%]"" DE(6)=% S %=$P(%Z,U,7) S:%]"" DE(8)=%
+ I  S %=$P(%Z,U,10) S:%]"" DE(11)=% S %=$P(%Z,U,12) S:%]"" DE(12)=%
  K %Z Q
  ;
@@ -131 +131 @@
  Q
  ;
-6 D:$D(DG)>9 F^DIE17,DE S DQ=6,DW="0;9",DV="NJ8,2",DU="",DLB="NON-COVERED CHARGE",DIFLD=.09
- G RE
-X6 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999)!(X<0)!(X?.E1"."3.N) X
- Q
- ;
-7 S DW="0;6",DV="*P81'",DU="",DLB="PROCEDURE",DIFLD=.06
- S DE(DW)="C7^IBXSC79"
+6 D:$D(DG)>9 F^DIE17,DE S DQ=6,DW="0;6",DV="*P81'",DU="",DLB="PROCEDURE",DIFLD=.06
+ S DE(DW)="C6^IBXSC79"
  S DU="ICPT("
  G RE
-C7 G C7S:$D(DE(7))[0 K DB
- S X=DE(7),DIC=DIE
+C6 G C6S:$D(DE(6))[0 K DB
+ S X=DE(6),DIC=DIE
  K ^DGCR(399,"ASC1",$E(X,1,30),DA(1),DA)
- S X=DE(7),DIC=DIE
+ S X=DE(6),DIC=DIE
  K ^DGCR(399,"ASC2",DA(1),$E(X,1,30),DA)
-C7S S X="" G:DG(DQ)=X C7F1 K DB
+C6S S X="" G:DG(DQ)=X C6F1 K DB
  S X=DG(DQ),DIC=DIE
  I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC1",$E(X,1,30),DA(1),DA)=""
  S X=DG(DQ),DIC=DIE
  I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC2",DA(1),$E(X,1,30),DA)=""
-C7F1 Q
-X7 S ICPTVDT=$$BDATE^IBACSV($G(DA(1))),DIC("S")="I $$CPTACT^IBACSV(+Y,ICPTVDT)",DIC("W")="D EN^DDIOL(""   ""_$P($$CPT^IBACSV(+Y,ICPTVDT),U,2),,""?0"")" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X
- Q
- ;
-8 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X8 I '$P(^DGCR(399,DA(1),"RC",DA,0),U,6) S Y="@758"
- Q
-9 D:$D(DG)>9 F^DIE17,DE S DQ=9,DW="0;7",DV="P40.8'X",DU="",DLB="DIVISION",DIFLD=.07
- S DE(DW)="C9^IBXSC79"
+C6F1 Q
+X6 S ICPTVDT=$$BDATE^IBACSV($G(DA(1))),DIC("S")="I $$CPTACT^IBACSV(+Y,ICPTVDT)",DIC("W")="D EN^DDIOL(""   ""_$P($$CPT^IBACSV(+Y,ICPTVDT),U,2),,""?0"")" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X
+ Q
+ ;
+7 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=7 D X7 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X7 I '$P(^DGCR(399,DA(1),"RC",DA,0),U,6) S Y="@758"
+ Q
+8 D:$D(DG)>9 F^DIE17,DE S DQ=8,DW="0;7",DV="P40.8'X",DU="",DLB="DIVISION",DIFLD=.07
+ S DE(DW)="C8^IBXSC79"
  S DU="DG(40.8,"
  S X=$$DEFDIV^IBCU7(DA(1))
  S Y=X
  G Y
-C9 G C9S:$D(DE(9))[0 K DB
- S X=DE(9),DIC=DIE
+C8 G C8S:$D(DE(8))[0 K DB
+ S X=DE(8),DIC=DIE
  K ^DGCR(399,"ASC1",+$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA(1),DA)
- S X=DE(9),DIC=DIE
+ S X=DE(8),DIC=DIE
  K ^DGCR(399,"ASC2",DA(1),+$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA)
-C9S S X="" G:DG(DQ)=X C9F1 K DB
+C8S S X="" G:DG(DQ)=X C8F1 K DB
  S X=DG(DQ),DIC=DIE
  I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC1",$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA(1),DA)=""
  S X=DG(DQ),DIC=DIE
  I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC2",DA(1),$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA)=""
-C9F1 Q
-X9 Q
-10 S DQ=11 ;@758
-11 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 D X11 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X11 I +$P(^DGCR(399,DA(1),"RC",DA,0),U,8) W !," AUTO ADDED CHARGE - NO CHANGE TO TYPE/COMPONENT" S Y="@759"
- Q
-12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW="0;10",DV="S",DU="",DLB="TYPE",DIFLD=.1
- S DE(DW)="C12^IBXSC79"
+C8F1 Q
+X8 Q
+9 S DQ=10 ;@758
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X10 I +$P(^DGCR(399,DA(1),"RC",DA,0),U,8) W !," AUTO ADDED CHARGE - NO CHANGE TO TYPE/COMPONENT" S Y="@759"
+ Q
+11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW="0;10",DV="S",DU="",DLB="TYPE",DIFLD=.1
+ S DE(DW)="C11^IBXSC79"
  S DU="1:INPT BS;2:OPT VST DT;3:RX;4:CPT;5:PROS;6:DRG;9:UNASSOCIATED;"
  G RE
-C12 G C12S:$D(DE(12))[0 K DB
+C11 G C11S:$D(DE(11))[0 K DB
  D ^IBXSC711
-C12S S X="" G:DG(DQ)=X C12F1 K DB
- S X=DG(DQ),DIC=DIE
- ;
- S X=DG(DQ),DIC=DIE
- ;
-C12F1 Q
+C11S S X="" G:DG(DQ)=X C11F1 K DB
+ S X=DG(DQ),DIC=DIE
+ ;
+ S X=DG(DQ),DIC=DIE
+ ;
+C11F1 Q
+X11 Q
+12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW="0;12",DV="S",DU="",DLB="COMPONENT",DIFLD=.12
+ S DU="1:INSTITUTIONAL;2:PROFESSIONAL;"
+ G RE
 X12 Q
-13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW="0;12",DV="S",DU="",DLB="COMPONENT",DIFLD=.12
- S DU="1:INSTITUTIONAL;2:PROFESSIONAL;"
- G RE
-X13 Q
+13 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=13 D X13 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
+X13 I $S($P($G(^DGCR(399,DA(1),"RC",DA,0)),U,10)=3:0,1:$P($G(^(0)),U,10)'=4)!$P($G(^(0)),U,8) S Y="@759"
+ Q
 14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X14 I $S($P($G(^DGCR(399,DA(1),"RC",DA,0)),U,10)=3:0,1:$P($G(^(0)),U,10)'=4)!$P($G(^(0)),U,8) S Y="@759"
+X14 I $P($G(^DGCR(399,DA(1),"RC",DA,0)),U,10)=4 S Y="@7581"
  Q
 15 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=15 D X15 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X15 I $P($G(^DGCR(399,DA(1),"RC",DA,0)),U,10)=4 S Y="@7581"
+X15 S DGRVRCAL=1
  Q
 16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X16 S DGRVRCAL=1
- Q
-17 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=17 D X17 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
-X17 D LINKRX^IBCEU5(DA(1),DA)
- Q
-18 D:$D(DG)>9 F^DIE17 G ^IBXSC712
+X16 D LINKRX^IBCEU5(DA(1),DA)
+ Q
+17 D:$D(DG)>9 F^DIE17 G ^IBXSC712