Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (15 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r613 r623  
    1 IBXX17 ; COMPILED XREF FOR FILE #399.0222 ; 01/03/09
     1IBXX17 ; COMPILED XREF FOR FILE #399.0222 ; 12/27/07
    22 ;
    3 END G ^IBXX17
    4  .N DIK,DIV,DIU,DIN
    5  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,19),X=X S DIU=X K Y S X=DIV S X=$$FT^IBCU3(DA,1) X ^DD(399,135,1,2,1.4)
    6  S X=$P(DIKZ("MP"),U,1)
    7  I X'="" D MAILA^IBCU5
    8  S X=$P(DIKZ("MP"),U,1)
    9  I X'="" S DGRVRCAL=1
    10  S DIKZ("MP")=$G(^DGCR(399,DA,"MP"))
    11  S X=$P(DIKZ("MP"),U,2)
    12  I X'="" D
    13  .N DIK,DIV,DIU,DIN
    14  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$WNRBILL^IBEFUNC(DA) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"MP")):^("MP"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(399,136,1,1,1.1) X ^DD(399,136,1,1,1.4)
    15  S DIKZ("U")=$G(^DGCR(399,DA,"U"))
    16  S X=$P(DIKZ("U"),U,1)
    17  I X'="" D
    18  .N DIK,DIV,DIU,DIN
    19  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $P(^DGCR(399,DA,0),U,5)<3 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$LOS1^IBCU64(DA) X ^DD(399,151,1,1,1.4)
    20  S X=$P(DIKZ("U"),U,1)
    21  I X'="" S DGRVRCAL=1
    22  S X=$P(DIKZ("U"),U,1)
    23  I X'="" D
    24  .N DIK,DIV,DIU,DIN
    25  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I +$G(^DGCR(399,DA,"U1"))=0 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=0 X ^DD(399,151,1,3,1.4)
    26  S X=$P(DIKZ("U"),U,1)
    27  I X'="" S:$P(^DGCR(399,DA,0),"^",2) ^DGCR(399,"APDS",$P(^(0),U,2),-X,DA)=""
    28  S DIKZ("U")=$G(^DGCR(399,DA,"U"))
    29  S X=$P(DIKZ("U"),U,2)
    30  I X'="" D
    31  .N DIK,DIV,DIU,DIN
    32  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $P(^DGCR(399,DA,0),U,5)<3 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$LOS1^IBCU64(DA) X ^DD(399,152,1,1,1.4)
    33  S X=$P(DIKZ("U"),U,2)
    34  I X'="" S DGRVRCAL=1
    35  S DIKZ("U")=$G(^DGCR(399,DA,"U"))
    36  S X=$P(DIKZ("U"),U,11)
    37  I X'="" D
    38  .N DIK,DIV,DIU,DIN
    39  .X ^DD(399,161,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV D DIS^IBCU S X=X S DIH=$G(^DGCR(399,DIV(0),"U")),DIV=X S $P(^("U"),U,12)=DIV,DIH=399,DIG=162 D ^DICR
    40  S DIKZ("U")=$G(^DGCR(399,DA,"U"))
    41  S X=$P(DIKZ("U"),U,15)
    42  I X'="" D
    43  .N DIK,DIV,DIU,DIN
    44  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=($P($G(^DGCR(399,DA,"U2")),U,2)=""&$$INPAT^IBCEF(DA,1)) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U2")):^("U2"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(399,165,1,1,1.4)
    45  S X=$P(DIKZ("U"),U,15)
    46  I X'="" D
    47  .N DIK,DIV,DIU,DIN
    48  .X ^DD(399,165,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U2")):^("U2"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV N Z S X=$$LOS1^IBCU64(DA,.Z),X=+$G(Z) X ^DD(399,165,1,2,1.4)
    49  S DIKZ("U2")=$G(^DGCR(399,DA,"U2"))
    50  S X=$P(DIKZ("U2"),U,4)
    51  I X'="" D
    52  .N DIK,DIV,DIU,DIN
    53  .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)
    54  S X=$P(DIKZ("U2"),U,4)
    55  I X'="" D
    56  .N DIK,DIV,DIU,DIN
    57  .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)
    58  S DIKZ("U2")=$G(^DGCR(399,DA,"U2"))
    59  S X=$P(DIKZ("U2"),U,5)
    60  I X'="" D
    61  .N DIK,DIV,DIU,DIN
    62  .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)
    63  S X=$P(DIKZ("U2"),U,5)
    64  I X'="" D
    65  .N DIK,DIV,DIU,DIN
    66  .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)
    67  S DIKZ("U2")=$G(^DGCR(399,DA,"U2"))
    68  S X=$P(DIKZ("U2"),U,6)
    69  I X'="" D
    70  .N DIK,DIV,DIU,DIN
    71  .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)
    72  S X=$P(DIKZ("U2"),U,6)
    733 I X'="" D
    744 .N DIK,DIV,DIU,DIN
Note: See TracChangeset for help on using the changeset viewer.