Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 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/IBXX.m

    r613 r623  
    1 IBXX ; DRIVER FOR COMPILED XREFS FOR FILE #399 ; 01/03/09
     1IBXX ; DRIVER FOR COMPILED XREFS FOR FILE #399 ; 12/27/07
    22 ;
    33 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2
     
    77DI S DIKM1=0,DIKUM=0,DA(0)="",DV=0 F  S DV=$O(DA(DV)) Q:DV'>0  S DIKUM=DIKUM+1,DIKUP(DV)=DA(DV)
    88 S:DV="" DV=-1 S DH(1)=399,DIKUP=DA
    9  I $D(DIKKS) D:DIKZ1=DH(1) ^IBXX1 S DA=DIKUP D:DIKZ1=DH(1) ^IBXX15 D:DIKZ1'=DH(1) KILL D:DIKZ1'=DH(1) DA D:DIKZ1'=DH(1) SET D DA Q
     9 I $D(DIKKS) D:DIKZ1=DH(1) ^IBXX1 S DA=DIKUP D:DIKZ1=DH(1) ^IBXX14 D:DIKZ1'=DH(1) KILL D:DIKZ1'=DH(1) DA D:DIKZ1'=DH(1) SET D DA Q
    1010 I $D(DIKIL) D:DIKZ1=DH(1) ^IBXX1 S:DIKZ1=DH(1) DIKM1=1 D:DIKZ1'=DH(1) KILL S DA=DIKUP D:DIKM1>0 KIL1 D DA Q
    11  I $D(DIKST) D:DIKZ1=DH(1) ^IBXX15 D:DIKZ1'=DH(1) SET D DA Q
     11 I $D(DIKST) D:DIKZ1=DH(1) ^IBXX14 D:DIKZ1'=DH(1) SET D DA Q
    1212 I $D(DIKSAT) D SET1 D DA Q
    1313 Q
     
    1717 S DU=$E(DIK,1,$L(DIK)-1),DIKLK=$S(DIK[",":DU_")",1:DU) L +@DIKLK:10 K:'$T DIKLK
    1818C I @("$O("_DIK_"DA))'>0") S DA=$$C1(DA),^(0)=$P(@(DIK_"0)"),U,1,2)_U_DA_U_DCNT K DCNT L:$D(DIKLK) -@DIKLK Q
    19  S (DIKY,DA)=$O(^(DA)) G C:$P($G(^(DA,0)),U)']"" S DU=1,DCNT=DCNT+1 S:DA="" (DIKY,DA)=-1 D:DIKZ1=DH(1) ^IBXX15 D:DIKZ1'=DH(1) SET D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C
     19 S (DIKY,DA)=$O(^(DA)) G C:$P($G(^(DA,0)),U)']"" S DU=1,DCNT=DCNT+1 S:DA="" (DIKY,DA)=-1 D:DIKZ1=DH(1) ^IBXX14 D:DIKZ1'=DH(1) SET D:DIKZ1'=DH(1) DA K DB(0) S DA=DIKY G C
    2020 Q
    2121C1(A) Q:$P($G(@(DIK_"A,0)")),U)]"" A
     
    2424KILL S DIKILL=1,DIKZK=2
    2525 I DIKZ1=399.0222,DIKUM'<1 S DIKM1=1 D A1^IBXX3 Q
    26  I DIKZ1=399.0304,DIKUM'<1 S DIKM1=1 D A1^IBXX4,A1^IBXX14 Q
     26 I DIKZ1=399.0304,DIKUM'<1 S DIKM1=1 D A1^IBXX4,A1^IBXX13 Q
    2727 I DIKZ1=399.041,DIKUM'<1 S DIKM1=1 D A1^IBXX5 Q
    2828 I DIKZ1=399.042,DIKUM'<1 S DIKM1=1 D A1^IBXX6 Q
     
    3333 I DIKZ1=399.047,DIKUM'<1 S DIKM1=1 D A1^IBXX11 Q
    3434 I DIKZ1=399.048,DIKUM'<1 S DIKM1=1 D A1^IBXX12 Q
    35  I DIKZ1=399.077,DIKUM'<1 S DIKM1=1 D A1^IBXX13 Q
    36  I DIKZ1=399.30416,DIKUM'<2 S DIKM1=2 D A1^IBXX14 Q
     35 I DIKZ1=399.30416,DIKUM'<2 S DIKM1=2 D A1^IBXX13 Q
    3736 Q
    3837SET S DISET=1,DIKZK=1 K DIKPUSH
    3938 I DIKZ1=399.0222,DIKUM'<1 S DIKM1=1 D A1^IBXX18 Q
    40  I DIKZ1=399.0304,DIKUM'<1 S DIKM1=1 D A1^IBXX19,A1^IBXX29 Q
     39 I DIKZ1=399.0304,DIKUM'<1 S DIKM1=1 D A1^IBXX19,A1^IBXX28 Q
    4140 I DIKZ1=399.041,DIKUM'<1 S DIKM1=1 D A1^IBXX20 Q
    4241 I DIKZ1=399.042,DIKUM'<1 S DIKM1=1 D A1^IBXX21 Q
     
    4746 I DIKZ1=399.047,DIKUM'<1 S DIKM1=1 D A1^IBXX26 Q
    4847 I DIKZ1=399.048,DIKUM'<1 S DIKM1=1 D A1^IBXX27 Q
    49  I DIKZ1=399.077,DIKUM'<1 S DIKM1=1 D A1^IBXX28 Q
    50  I DIKZ1=399.30416,DIKUM'<2 S DIKM1=2 D A1^IBXX29 Q
     48 I DIKZ1=399.30416,DIKUM'<2 S DIKM1=2 D A1^IBXX28 Q
    5149 Q
    5250KIL1 K @(DIK_"DA)") Q:'$D(^(0))
Note: See TracChangeset for help on using the changeset viewer.