Changeset 623 for WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXSC78.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXSC78.m (modified) (2 diffs)

WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXSC78.m

@@ -1 @@
-IBXSC78 ; ;01/03/09
+IBXSC78 ; ;12/27/07
  D DE G BEGIN
 DE S DIE="^DGCR(399,",DIC=DIE,DP=399,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DGCR(399,DA,""))=""
- I $D(^("U2")) S %Z=^("U2") S %=$P(%Z,U,5) S:%]"" DE(1)=% S %=$P(%Z,U,6) S:%]"" DE(4)=%
+ I $D(^("U1")) S %Z=^("U1") S %=$P(%Z,U,2) S:%]"" DE(2)=% S %=$P(%Z,U,3) S:%]"" DE(4)=% S %=$P(%Z,U,10) S:%]"" DE(7)=%
+ I $D(^("U2")) S %Z=^("U2") S %=$P(%Z,U,4) S:%]"" DE(12)=% S %=$P(%Z,U,5) S:%]"" DE(15)=% S %=$P(%Z,U,6) S:%]"" DE(18)=%
  K %Z Q
  ;
@@ -50 +51 @@
 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="IBXSC78",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="U2;5",DV="NJ11,2",DU="",DLB="SECONDARY PRIOR PAYMENT",DIFLD=219
- S DE(DW)="C1^IBXSC78"
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,D=0 K DE(1) ;42
+ S DIFLD=42,DGO="^IBXSC79",DC="15^399.042IPA^RC^",DV="399.042MR*P399.2'",DW="0;1",DOW="REVENUE CODE",DLB="Select "_DOW S:D DC=DC_D
+ S DU="DGCR(399.2,"
+ G RE:D I $D(DSC(399.042))#2,$P(DSC(399.042),"I $D(^UTILITY(",1)="" X DSC(399.042) S D=$O(^(0)) S:D="" D=-1 G M1
+ S D=$S($D(^DGCR(399,DA,"RC",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
+M1 I D>0 S DC=DC_D I $D(^DGCR(399,DA,"RC",+D,0)) S DE(1)=$P(^(0),U,1)
  G RE
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
+R1 D DE
+ S D=$S($D(^DGCR(399,DA,"RC",0)):$P(^(0),U,3,4),1:1) G 1+1
+ ;
+2 S DW="U1;2",DV="NJ8,2",DU="",DLB="OFFSET AMOUNT",DIFLD=202
+ S DE(DW)="C2^IBXSC78"
+ G RE
+C2 G C2S:$D(DE(2))[0 K DB
+ S X=DE(2),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(399,202,1,1,2.4)
+C2S S X="" G:DG(DQ)=X C2F1 K DB
+ S X=DG(DQ),DIC=DIE
+ ;
+C2F1 Q
+X2 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999)!(X<0) X
+ Q
+ ;
+3 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=3 D X3 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
+X3 S:'X Y="@757"
+ Q
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW="U1;3",DV="FX",DU="",DLB="OFFSET DESCRIPTION",DIFLD=203
+ G RE
+X4 K:$L(X)>24!($L(X)<3) X
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+5 S DQ=6 ;@757
+6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
+X6 I $P(^DGCR(399,DA,"U1"),"^",11)']"" S Y="@76"
+ Q
+7 S DW="U1;10",DV="RNJ10,2",DU="",DLB="*FY 1 CHARGES",DIFLD=210
+ G RE
+X7 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>9999999)!(X<0) X
+ Q
+ ;
+8 S DQ=9 ;@76
+9 S DQ=10 ;@77
+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 S:IBDR20'["77" Y="@78"
+ Q
+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 S:'$D(^DGCR(399,DA,"I1")) Y="@772"
+ Q
+12 S DW="U2;4",DV="NJ11,2",DU="",DLB="PRIMARY PRIOR PAYMENT",DIFLD=218
+ S DE(DW)="C12^IBXSC78"
+ G RE
+C12 G C12S:$D(DE(12))[0 K DB
+ S X=DE(12),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU-X X ^DD(399,218,1,1,2.4)
+ S X=DE(12),DIC=DIE
+ ;
+C12S S X="" G:DG(DQ)=X C12F1 K DB
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(399,218,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X="PRIOR PAYMENT(S)" X ^DD(399,218,1,2,1.4)
+C12F1 Q
+X12 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999999)!(X<0) X
+ Q
+ ;
+13 S DQ=14 ;@772
+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 S:'$D(^DGCR(399,DA,"I2")) Y="@773"
+ Q
+15 D:$D(DG)>9 F^DIE17,DE S DQ=15,DW="U2;5",DV="NJ11,2",DU="",DLB="SECONDARY PRIOR PAYMENT",DIFLD=219
+ S DE(DW)="C15^IBXSC78"
+ G RE
+C15 G C15S:$D(DE(15))[0 K DB
+ S X=DE(15),DIC=DIE
  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU-X X ^DD(399,219,1,1,2.4)
- S X=DE(1),DIC=DIE
+ S X=DE(15),DIC=DIE
  ;
-C1S S X="" G:DG(DQ)=X C1F1 K DB
+C15S S X="" G:DG(DQ)=X C15F1 K DB
  S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(399,219,1,1,1.4)
  S X=DG(DQ),DIC=DIE
  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X="PRIOR PAYMENT(S)" X ^DD(399,219,1,2,1.4)
-C1F1 Q
-X1 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999999)!(X<0) X
+C15F1 Q
+X15 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999999)!(X<0) X
  Q
  ;
-2 S DQ=3 ;@773
-3 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=3 D X3 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
-X3 S:'$D(^DGCR(399,DA,"I3")) Y="@78"
+16 S DQ=17 ;@773
+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 S:'$D(^DGCR(399,DA,"I3")) Y="@78"
  Q
-4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW="U2;6",DV="NJ11,2",DU="",DLB="TERTIARY PRIOR PAYMENT",DIFLD=220
- S DE(DW)="C4^IBXSC78"
+18 D:$D(DG)>9 F^DIE17,DE S DQ=18,DW="U2;6",DV="NJ11,2",DU="",DLB="TERTIARY PRIOR PAYMENT",DIFLD=220
+ S DE(DW)="C18^IBXSC78"
  G RE
-C4 G C4S:$D(DE(4))[0 K DB
- S X=DE(4),DIC=DIE
+C18 G C18S:$D(DE(18))[0 K DB
+ S X=DE(18),DIC=DIE
  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU-X X ^DD(399,220,1,1,2.4)
- S X=DE(4),DIC=DIE
+ S X=DE(18),DIC=DIE
  ;
-C4S S X="" G:DG(DQ)=X C4F1 K DB
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(399,220,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X="PRIOR PAYMENT(S)" X ^DD(399,220,1,2,1.4)
-C4F1 Q
-X4 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999999)!(X<0) X
+C18S S X="" G:DG(DQ)=X C18F1 K DB
+ D ^IBXSC710
+C18F1 Q
+X18 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999999)!(X<0) X
  Q
  ;
-5 S DQ=6 ;@78
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
-X6 K DIE("NO^")
+19 S DQ=20 ;@78
+20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 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
+X20 K DIE("NO^")
  Q
-7 G 0^DIE17
+21 G 0^DIE17