- ACRCSS6 ; COMPILED XREF FOR FILE #9002193.01101 ; 09/30/09
- ;
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,1)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,1)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
- S X=$P(DIKZ("DT"),U,3)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,3)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
- S X=$P(DIKZ("DT"),U,4)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,4)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,4)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,4)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,4)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
- S X=$P(DIKZ("DT"),U,6)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
- S X=$P(DIKZ("DT"),U,21)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,21)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,21)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,21)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
- S X=$P(DIKZ("DT"),U,19)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
- S X=$P(DIKZ("DT"),U,9)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,9)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,9)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,9)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S X=$P(DIKZ("DT"),U,9)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("VND")=$G(^ACRSS(DA,"VND"))
- S X=$P(DIKZ("VND"),U,1)
- I X'="" S ^ACRSS("VND",$E(X,1,30),DA)=""
- S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
- S X=$P(DIKZ("DT"),U,20)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- S DIKZ("APV")=$G(^ACRSS(DA,"APV"))
- S X=$P(DIKZ("APV"),U,2)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .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)
- END G ^ACRCSS7
- ACRCSS6 ; COMPILED XREF FOR FILE #9002193.01101 ; 09/30/09
- +1 ;
- +2 IF X'=""
- Begin DoDot:1
- +3 NEW DIK,DIV,DIU,DIN
- +4 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(0)=X
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,3)'=""
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,4)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,10,1,1,1.1)
- XECUTE ^DD(9002193,10,1,1,1.4)
- End DoDot:1
- +5 SET X=$PIECE(DIKZ("DT"),U,1)
- +6 IF X'=""
- Begin DoDot:1
- +7 NEW DIK,DIV,DIU,DIN
- +8 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,14)
- SET X=X
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIV
- XECUTE ^DD(9002193,10,1,2,1.4)
- End DoDot:1
- +9 SET X=$PIECE(DIKZ("DT"),U,1)
- +10 IF X'=""
- Begin DoDot:1
- +11 NEW DIK,DIV,DIU,DIN
- +12 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,7)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,10,1,3,1.1)
- XECUTE ^DD(9002193,10,1,3,1.4)
- End DoDot:1
- +13 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
- +14 SET X=$PIECE(DIKZ("DT"),U,3)
- +15 IF X'=""
- Begin DoDot:1
- +16 NEW DIK,DIV,DIU,DIN
- +17 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,4)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,12,1,1,1.1)
- XECUTE ^DD(9002193,12,1,1,1.4)
- End DoDot:1
- +18 SET X=$PIECE(DIKZ("DT"),U,3)
- +19 IF X'=""
- Begin DoDot:1
- +20 NEW DIK,DIV,DIU,DIN
- +21 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,7)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,12,1,2,1.1)
- XECUTE ^DD(9002193,12,1,2,1.4)
- End DoDot:1
- +22 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
- +23 SET X=$PIECE(DIKZ("DT"),U,4)
- +24 IF X'=""
- Begin DoDot:1
- +25 NEW DIK,DIV,DIU,DIN
- +26 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(9002193,13,1,1,89.2)
- SET X=$PIECE(Y(101),U,2)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,13,1,1,1.4)
- End DoDot:1
- +27 SET X=$PIECE(DIKZ("DT"),U,4)
- +28 IF X'=""
- Begin DoDot:1
- +29 NEW DIK,DIV,DIU,DIN
- +30 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(9002193,13,1,2,89.2)
- SET X=$PIECE(Y(101),U,2)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,13,1,2,1.4)
- End DoDot:1
- +31 SET X=$PIECE(DIKZ("DT"),U,4)
- +32 IF X'=""
- Begin DoDot:1
- +33 NEW DIK,DIV,DIU,DIN
- +34 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(9002193,13,1,3,89.2)
- SET X=$PIECE(Y(101),U,2)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,13,1,3,1.4)
- End DoDot:1
- +35 SET X=$PIECE(DIKZ("DT"),U,4)
- +36 IF X'=""
- Begin DoDot:1
- +37 NEW DIK,DIV,DIU,DIN
- +38 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(9002193,13,1,4,89.2)
- SET X=$PIECE(Y(101),U,1)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,13,1,4,1.4)
- End DoDot:1
- +39 SET X=$PIECE(DIKZ("DT"),U,4)
- +40 IF X'=""
- Begin DoDot:1
- +41 NEW DIK,DIV,DIU,DIN
- +42 XECUTE ^DD(9002193,13,1,5,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,9)
- SET X=X
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIV
- XECUTE ^DD(9002193,13,1,5,1.4)
- End DoDot:1
- +43 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
- +44 SET X=$PIECE(DIKZ("DT"),U,6)
- +45 IF X'=""
- Begin DoDot:1
- +46 NEW DIK,DIV,DIU,DIN
- +47 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,14)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,15,1,2,1.1)
- XECUTE ^DD(9002193,15,1,2,1.4)
- End DoDot:1
- +48 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
- +49 SET X=$PIECE(DIKZ("DT"),U,21)
- +50 IF X'=""
- Begin DoDot:1
- +51 NEW DIK,DIV,DIU,DIN
- +52 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(0)=X
- SET X=Y(0)'=0
- IF X
- SET X=DIV
- XECUTE ^DD(9002193,16.1,1,1,89.2)
- SET X=$PIECE(Y(101),U,2)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,16.1,1,1,1.4)
- End DoDot:1
- +53 SET X=$PIECE(DIKZ("DT"),U,21)
- +54 IF X'=""
- Begin DoDot:1
- +55 NEW DIK,DIV,DIU,DIN
- +56 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(0)=X
- SET X=Y(0)'=0
- IF X
- SET X=DIV
- XECUTE ^DD(9002193,16.1,1,2,89.2)
- SET X=$PIECE(Y(101),U,3)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,16.1,1,2,1.4)
- End DoDot:1
- +57 SET X=$PIECE(DIKZ("DT"),U,21)
- +58 IF X'=""
- Begin DoDot:1
- +59 NEW DIK,DIV,DIU,DIN
- +60 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(0)=X
- SET X=Y(0)'=0
- IF X
- SET X=DIV
- XECUTE ^DD(9002193,16.1,1,3,89.2)
- SET X=$PIECE(Y(101),U,3)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,16.1,1,3,1.4)
- End DoDot:1
- +61 SET X=$PIECE(DIKZ("DT"),U,21)
- +62 IF X'=""
- Begin DoDot:1
- +63 NEW DIK,DIV,DIU,DIN
- +64 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(0)=X
- SET X=Y(0)'=0
- IF X
- SET X=DIV
- XECUTE ^DD(9002193,16.1,1,4,89.2)
- SET X=$PIECE(Y(101),U,3)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,16.1,1,4,1.4)
- End DoDot:1
- +65 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
- +66 SET X=$PIECE(DIKZ("DT"),U,19)
- +67 IF X'=""
- Begin DoDot:1
- +68 NEW DIK,DIV,DIU,DIN
- +69 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,21)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,17,1,1,1.1)
- XECUTE ^DD(9002193,17,1,1,1.4)
- End DoDot:1
- +70 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
- +71 SET X=$PIECE(DIKZ("DT"),U,9)
- +72 IF X'=""
- Begin DoDot:1
- +73 NEW DIK,DIV,DIU,DIN
- +74 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(0)=X
- SET X=Y(0)'=""
- IF X
- SET X=DIV
- XECUTE ^DD(9002193,18,1,1,89.2)
- SET X=$PIECE(Y(101),U,4)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,18,1,1,1.4)
- End DoDot:1
- +75 SET X=$PIECE(DIKZ("DT"),U,9)
- +76 IF X'=""
- Begin DoDot:1
- +77 NEW DIK,DIV,DIU,DIN
- +78 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(9002193,18,1,2,89.2)
- SET X=$PIECE(Y(101),U,5)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,18,1,2,1.4)
- End DoDot:1
- +79 SET X=$PIECE(DIKZ("DT"),U,9)
- +80 IF X'=""
- Begin DoDot:1
- +81 NEW DIK,DIV,DIU,DIN
- +82 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(9002193,18,1,3,89.2)
- SET X=$PIECE(Y(101),U,5)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,18,1,3,1.4)
- End DoDot:1
- +83 SET X=$PIECE(DIKZ("DT"),U,9)
- +84 IF X'=""
- Begin DoDot:1
- +85 NEW DIK,DIV,DIU,DIN
- +86 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(9002193,18,1,4,89.2)
- SET X=$PIECE(Y(101),U,5)
- SET D0=I(0,0)
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIU+DIV
- XECUTE ^DD(9002193,18,1,4,1.4)
- End DoDot:1
- +87 SET X=$PIECE(DIKZ("DT"),U,9)
- +88 IF X'=""
- Begin DoDot:1
- +89 NEW DIK,DIV,DIU,DIN
- +90 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,7)
- SET X=X
- SET DIU=X
- KILL Y
- SET X=DIV
- SET X=DIV
- XECUTE ^DD(9002193,18,1,5,1.4)
- End DoDot:1
- +91 SET DIKZ("VND")=$GET(^ACRSS(DA,"VND"))
- +92 SET X=$PIECE(DIKZ("VND"),U,1)
- +93 IF X'=""
- SET ^ACRSS("VND",$EXTRACT(X,1,30),DA)=""
- +94 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
- +95 SET X=$PIECE(DIKZ("DT"),U,20)
- +96 IF X'=""
- Begin DoDot:1
- +97 NEW DIK,DIV,DIU,DIN
- +98 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,21)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,32,1,1,1.1)
- XECUTE ^DD(9002193,32,1,1,1.4)
- End DoDot:1
- +99 SET DIKZ("APV")=$GET(^ACRSS(DA,"APV"))
- +100 SET X=$PIECE(DIKZ("APV"),U,2)
- +101 IF X'=""
- Begin DoDot:1
- +102 NEW DIK,DIV,DIU,DIN
- +103 XECUTE ^DD(9002193,911,1,1,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DT")):^("DT"),1:"")
- SET X=$PIECE(Y(1),U,9)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002193,911,1,1,1.1)
- XECUTE ^DD(9002193,911,1,1,1.4)
- End DoDot:1
- END GOTO ^ACRCSS7