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

ACRCSS6.m

Go to the documentation of this file.
  1. ACRCSS6 ; COMPILED XREF FOR FILE #9002193.01101 ; 09/30/09
  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 S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,3)'="" I X S X=DIV S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002193,10,1,1,1.1) X ^DD(9002193,10,1,1,1.4)
  1. S X=$P(DIKZ("DT"),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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002193,10,1,2,1.4)
  1. S X=$P(DIKZ("DT"),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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002193,10,1,3,1.1) X ^DD(9002193,10,1,3,1.4)
  1. S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
  1. S X=$P(DIKZ("DT"),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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002193,12,1,1,1.1) X ^DD(9002193,12,1,1,1.4)
  1. S X=$P(DIKZ("DT"),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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002193,12,1,2,1.1) X ^DD(9002193,12,1,2,1.4)
  1. S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
  1. S X=$P(DIKZ("DT"),U,4)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,1,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,1,1.4)
  1. S X=$P(DIKZ("DT"),U,4)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,2,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,2,1.4)
  1. S X=$P(DIKZ("DT"),U,4)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,3,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,3,1.4)
  1. S X=$P(DIKZ("DT"),U,4)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,13,1,4,89.2) S X=$P(Y(101),U,1) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,13,1,4,1.4)
  1. S X=$P(DIKZ("DT"),U,4)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .X ^DD(9002193,13,1,5,1.3) I X S X=DIV S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002193,13,1,5,1.4)
  1. S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
  1. S X=$P(DIKZ("DT"),U,6)
  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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y X ^DD(9002193,15,1,2,1.1) X ^DD(9002193,15,1,2,1.4)
  1. S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
  1. S X=$P(DIKZ("DT"),U,21)
  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 S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,1,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,1,1.4)
  1. S X=$P(DIKZ("DT"),U,21)
  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 S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,2,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,2,1.4)
  1. S X=$P(DIKZ("DT"),U,21)
  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 S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,3,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,3,1.4)
  1. S X=$P(DIKZ("DT"),U,21)
  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 S X=Y(0)'=0 I X S X=DIV X ^DD(9002193,16.1,1,4,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,16.1,1,4,1.4)
  1. S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
  1. S X=$P(DIKZ("DT"),U,19)
  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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,21),X=X S DIU=X K Y X ^DD(9002193,17,1,1,1.1) X ^DD(9002193,17,1,1,1.4)
  1. S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
  1. S X=$P(DIKZ("DT"),U,9)
  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 S X=Y(0)'="" I X S X=DIV X ^DD(9002193,18,1,1,89.2) S X=$P(Y(101),U,4) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,1,1.4)
  1. S X=$P(DIKZ("DT"),U,9)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,18,1,2,89.2) S X=$P(Y(101),U,5) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,2,1.4)
  1. S X=$P(DIKZ("DT"),U,9)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,18,1,3,89.2) S X=$P(Y(101),U,5) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,3,1.4)
  1. S X=$P(DIKZ("DT"),U,9)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,18,1,4,89.2) S X=$P(Y(101),U,5) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(9002193,18,1,4,1.4)
  1. S X=$P(DIKZ("DT"),U,9)
  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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(9002193,18,1,5,1.4)
  1. S DIKZ("VND")=$G(^ACRSS(DA,"VND"))
  1. S X=$P(DIKZ("VND"),U,1)
  1. I X'="" S ^ACRSS("VND",$E(X,1,30),DA)=""
  1. S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
  1. S X=$P(DIKZ("DT"),U,20)
  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(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,21),X=X S DIU=X K Y X ^DD(9002193,32,1,1,1.1) X ^DD(9002193,32,1,1,1.4)
  1. S DIKZ("APV")=$G(^ACRSS(DA,"APV"))
  1. S X=$P(DIKZ("APV"),U,2)
  1. I X'="" D
  1. .N DIK,DIV,DIU,DIN
  1. .X ^DD(9002193,911,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^ACRSS(D0,"DT")):^("DT"),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(9002193,911,1,1,1.1) X ^DD(9002193,911,1,1,1.4)
  1. END G ^ACRCSS7