Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBXX11

IBXX11.m

Go to the documentation of this file. 
  1. IBXX11 ; COMPILED XREF FOR FILE #399 ; 02/13/06
  1.  ; 
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .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,13),X=X S DIU=X K Y S X=DIV S X=4 X ^DD(399,14,1,1,1.4)
  1.  S X=$P(DIKZ("S"),U,14)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,14,1,3,1.4)
  1.  S DIKZ("S")=$G(^DGCR(399,DA,"S"))
  1.  S X=$P(DIKZ("S"),U,16)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,17),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,16,1,1,1.4)
  1.  S X=$P(DIKZ("S"),U,16)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,18),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,16,1,2,1.4)
  1.  S DIKZ("S")=$G(^DGCR(399,DA,"S"))
  1.  S X=$P(DIKZ("S"),U,17)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $P(^DGCR(399,DA,"S"),U,16)=1 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=7 X ^DD(399,17,1,1,1.4)
  1.  S DIKZ("C")=$G(^DGCR(399,DA,"C"))
  1.  S X=$P(DIKZ("C"),U,14)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $P(^DGCR(399,DA,0),"^",5)>2 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"C")):^("C"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=$P(^ICD9(+X,0),"^",3) X ^DD(399,64,1,1,1.4)
  1.  S DIKZ("M")=$G(^DGCR(399,DA,"M"))
  1.  S X=$P(DIKZ("M"),U,1)
  1.  I X'="" D MAILA^IBCU5
  1.  S X=$P(DIKZ("M"),U,1)
  1.  I X'="" S DGRVRCAL=1
  1.  S X=$P(DIKZ("M"),U,1)
  1.  I X'="" S:$P(^DGCR(399,DA,0),"^",2) ^DGCR(399,"AE",$P(^(0),U,2),X,DA)=""
  1.  S X=$P(DIKZ("M"),U,1)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .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) X ^DD(399,101,1,4,1.4)
  1.  S X=$P(DIKZ("M"),U,1)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(399,101,1,5,1.1) X ^DD(399,101,1,5,1.4)
  1.  S DIKZ("M")=$G(^DGCR(399,DA,"M"))
  1.  S X=$P(DIKZ("M"),U,2)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(399,102,1,2,1.1) X ^DD(399,102,1,2,1.4)
  1.  S DIKZ("M")=$G(^DGCR(399,DA,"M"))
  1.  S X=$P(DIKZ("M"),U,3)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(399,103,1,2,1.1) X ^DD(399,103,1,2,1.4)
  1.  S DIKZ("M")=$G(^DGCR(399,DA,"M"))
  1.  S X=$P(DIKZ("M"),U,11)
  1.  I X'="" D MAILIN^IBCU5
  1.  S X=$P(DIKZ("M"),U,11)
  1.  I X'="" S DGRVRCAL=1
  1.  S X=$P(DIKZ("M"),U,12)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(399,112,1,1,1.1) X ^DD(399,112,1,1,1.4)
  1.  S X=$P(DIKZ("M"),U,12)
  1.  I X'="" D IX^IBCNS2(DA,"I1")
  1.  S DIKZ("M")=$G(^DGCR(399,DA,"M"))
  1.  S X=$P(DIKZ("M"),U,13)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(399,113,1,1,1.1) X ^DD(399,113,1,1,1.4)
  1.  S X=$P(DIKZ("M"),U,13)
  1.  I X'="" D IX^IBCNS2(DA,"I2")
  1.  S DIKZ("M")=$G(^DGCR(399,DA,"M"))
  1.  S X=$P(DIKZ("M"),U,14)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(399,114,1,1,1.1) X ^DD(399,114,1,1,1.4)
  1.  S X=$P(DIKZ("M"),U,14)
  1.  I X'="" D IX^IBCNS2(DA,"I3")
  1.  S DIKZ("U")=$G(^DGCR(399,DA,"U"))
  1.  S X=$P(DIKZ("U"),U,1)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .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)
  1.  S X=$P(DIKZ("U"),U,1)
  1.  I X'="" S DGRVRCAL=1
  1.  S X=$P(DIKZ("U"),U,1)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .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,9),X=X S DIU=X K Y X ^DD(399,151,1,3,1.1) X ^DD(399,151,1,3,1.4)
  1.  S DIKZ("U")=$G(^DGCR(399,DA,"U"))
  1.  S X=$P(DIKZ("U"),U,2)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .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)
  1.  S X=$P(DIKZ("U"),U,2)
  1.  I X'="" S DGRVRCAL=1
  1.  S DIKZ("U")=$G(^DGCR(399,DA,"U"))
  1.  S X=$P(DIKZ("U"),U,11)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .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 X ^DD(399,161,1,1,1.4)
  1.  S DIKZ("U1")=$G(^DGCR(399,DA,"U1"))
  1.  S X=$P(DIKZ("U1"),U,1)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .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,10),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(399,201,1,1,1.4)
  1.  S DIKZ("U1")=$G(^DGCR(399,DA,"U1"))
  1.  S X=$P(DIKZ("U1"),U,10)
  1.  I X'="" D
  1.  .N DIK,DIV,DIU,DIN
  1.  .X ^DD(399,210,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y X ^DD(399,210,1,1,1.1) X ^DD(399,210,1,1,1.4)
  1. END G ^IBXX12