ACRCSS5 ; COMPILED XREF FOR FILE #9002193 ; 09/30/09
;
S DIKZK=1
S DIKZ(0)=$G(^ACRSS(DA,0))
S X=$P(DIKZ(0),U,1)
I X'="" S ^ACRSS("B",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,2)
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,0)):^(0),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y X ^DD(9002193,.02,1,1,1.1) X ^DD(9002193,.02,1,1,1.4)
S X=$P(DIKZ(0),U,2)
I X'="" S ^ACRSS("D",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,2)
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,0)):^(0),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002193,.02,1,3,1.4)
S X=$P(DIKZ(0),U,2)
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,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(9002193,.02,1,4,1.1) X ^DD(9002193,.02,1,4,1.4)
S X=$P(DIKZ(0),U,2)
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,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y X ^DD(9002193,.02,1,5,1.1) X ^DD(9002193,.02,1,5,1.4)
S X=$P(DIKZ(0),U,2)
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,4)'="" I X S X=DIV X ^DD(9002193,.02,1,6,89.2) S X=$P(Y(101),U,1) S D0=I(0,0) S DIU=X K Y X ^DD(9002193,.02,1,6,1.1) X ^DD(9002193,.02,1,6,1.4)
S X=$P(DIKZ(0),U,2)
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,9)'="" I X S X=DIV X ^DD(9002193,.02,1,7,89.2) S X=$P(Y(101),U,4) S D0=I(0,0) S DIU=X K Y X ^DD(9002193,.02,1,7,1.1) X ^DD(9002193,.02,1,7,1.4)
S X=$P(DIKZ(0),U,2)
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,7)'="" I X S X=DIV X ^DD(9002193,.02,1,8,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y X ^DD(9002193,.02,1,8,1.1) X ^DD(9002193,.02,1,8,1.4)
S DIKZ(0)=$G(^ACRSS(DA,0))
S X=$P(DIKZ(0),U,3)
I X'="" S ^ACRSS("C",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),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,"PO")):^("PO"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002193,.03,1,2,1.4)
S DIKZ(0)=$G(^ACRSS(DA,0))
S X=$P(DIKZ(0),U,4)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,.04,1,3,89.2) S X=$S('$D(^AUTTOBJC(+$P(Y(101),U,3),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(9002193,.04,1,3,1.4)
S DIKZ(0)=$G(^ACRSS(DA,0))
S X=$P(DIKZ(0),U,5)
I X'="" S ^ACRSS("CAN",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,5)
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,0)):^(0),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y X ^DD(9002193,.05,1,2,1.1) X ^DD(9002193,.05,1,2,1.4)
S DIKZ(0)=$G(^ACRSS(DA,0))
S X=$P(DIKZ(0),U,6)
I X'="" S ^ACRSS("F",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),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,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y X ^DD(9002193,.06,1,2,1.1) X ^DD(9002193,.06,1,2,1.4)
S X=$P(DIKZ(0),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,0)):^(0),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(9002193,.06,1,3,1.1) X ^DD(9002193,.06,1,3,1.4)
S X=$P(DIKZ(0),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,.06,1,4,89.2) S X=$P(Y(101),U,2) S D0=I(0,0) S DIU=X K Y X ^DD(9002193,.06,1,4,1.1) X ^DD(9002193,.06,1,4,1.4)
S X=$P(DIKZ(0),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,.06,1,5,89.2) S X=$P(Y(101),U,5) S D0=I(0,0) S DIU=X K Y X ^DD(9002193,.06,1,5,1.1) X ^DD(9002193,.06,1,5,1.4)
S X=$P(DIKZ(0),U,6)
I X'="" D
.N DIK,DIV,DIU,DIN
.K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(9002193,.06,1,6,89.2) S X=$P(Y(101),U,3) S D0=I(0,0) S DIU=X K Y X ^DD(9002193,.06,1,6,1.1) X ^DD(9002193,.06,1,6,1.4)
S X=$P(DIKZ(0),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,0)):^(0),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(9002193,.06,1,7,1.1) X ^DD(9002193,.06,1,7,1.4)
S DIKZ(0)=$G(^ACRSS(DA,0))
S X=$P(DIKZ(0),U,7)
I X'="" S ^ACRSS("E",$E(X,1,30),$P(^ACRSS(DA,0),U),DA)=""
S X=$P(DIKZ(0),U,8)
I X'="" S ^ACRSS("G",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,9)
I X'="" S ^ACRSS("H",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,11)
I X'="" S ^ACRSS("AREA",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,12)
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,"DESC")):^("DESC"),1:"") S X=$P(Y(1),U,1),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(0),U,12)
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,"DESC")):^("DESC"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(9002193,.12,1,2,1.1) X ^DD(9002193,.12,1,2,1.4)
S X=$P(DIKZ(0),U,12)
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,"VND")):^("VND"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002193,.12,1,3,1.1) X ^DD(9002193,.12,1,3,1.4)
S X=$P(DIKZ(0),U,12)
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,"DESC")):^("DESC"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(9002193,.12,1,4,1.1) X ^DD(9002193,.12,1,4,1.4)
S X=$P(DIKZ(0),U,12)
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,"DESC")):^("DESC"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002193,.12,1,5,1.1) X ^DD(9002193,.12,1,5,1.4)
S X=$P(DIKZ(0),U,12)
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,"DESC")):^("DESC"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(9002193,.12,1,6,1.1) X ^DD(9002193,.12,1,6,1.4)
S X=$P(DIKZ(0),U,12)
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,"NOTES")):^("NOTES"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002193,.12,1,7,1.1) X ^DD(9002193,.12,1,7,1.4)
S X=$P(DIKZ(0),U,12)
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,"NOTES")):^("NOTES"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(9002193,.12,1,8,1.1) X ^DD(9002193,.12,1,8,1.4)
S X=$P(DIKZ(0),U,12)
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,"NOTES")):^("NOTES"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(9002193,.12,1,9,1.1) X ^DD(9002193,.12,1,9,1.4)
S X=$P(DIKZ(0),U,12)
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,"NOTES")):^("NOTES"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002193,.12,1,10,1.1) X ^DD(9002193,.12,1,10,1.4)
S X=$P(DIKZ(0),U,12)
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,"NOTES")):^("NOTES"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(9002193,.12,1,11,1.1) X ^DD(9002193,.12,1,11,1.4)
S DIKZ(0)=$G(^ACRSS(DA,0))
S X=$P(DIKZ(0),U,13)
I X'="" S ^ACRSS("I",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,13)
I X'="" I $P($G(^ACRSS(+$G(DA),"NMS")),U)]"",$P($G(^(0)),U,17) S ^ACRSS("PR",X,$P(^("NMS"),U),$P(^(0),U,17),DA)=""
S X=$P(DIKZ(0),U,15)
I X'="" S ^ACRSS("LCOD",$E(X,1,30),DA)=""
S X=$P(DIKZ(0),U,17)
I X'="" I $P($G(^ACRSS(+$G(DA),"NMS")),U)]"",$P(^(0),U,13) S ^ACRSS("PR",$P(^("NMS"),U),$P(^(0),U,13),X,DA)=""
S DIKZ("PO")=$G(^ACRSS(DA,"PO"))
S X=$P(DIKZ("PO"),U,1)
I X'="" S ^ACRSS("J",$E(X,1,30),DA)=""
S DIKZ("NMS")=$G(^ACRSS(DA,"NMS"))
S X=$P(DIKZ("NMS"),U,1)
I X'="" I $P($G(^ACRSS(+$G(DA),0)),U,13)]"",$P(^(0),U,17) S ^ACRSS("PR",$P(^(0),U,13),X,$P(^(0),U,17),DA)=""
S DIKZ("DT")=$G(^ACRSS(DA,"DT"))
S X=$P(DIKZ("DT"),U,1)
END G ^ACRCSS6
ACRCSS5 ; COMPILED XREF FOR FILE #9002193 ; 09/30/09
+1 ;
+2 SET DIKZK=1
+3 SET DIKZ(0)=$GET(^ACRSS(DA,0))
+4 SET X=$PIECE(DIKZ(0),U,1)
+5 IF X'=""
SET ^ACRSS("B",$EXTRACT(X,1,30),DA)=""
+6 SET X=$PIECE(DIKZ(0),U,2)
+7 IF X'=""
Begin DoDot:1
+8 NEW DIK,DIV,DIU,DIN
+9 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,6)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.02,1,1,1.1)
XECUTE ^DD(9002193,.02,1,1,1.4)
End DoDot:1
+10 SET X=$PIECE(DIKZ(0),U,2)
+11 IF X'=""
SET ^ACRSS("D",$EXTRACT(X,1,30),DA)=""
+12 SET X=$PIECE(DIKZ(0),U,2)
+13 IF X'=""
Begin DoDot:1
+14 NEW DIK,DIV,DIU,DIN
+15 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002193,.02,1,3,1.4)
End DoDot:1
+16 SET X=$PIECE(DIKZ(0),U,2)
+17 IF X'=""
Begin DoDot:1
+18 NEW DIK,DIV,DIU,DIN
+19 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,10)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.02,1,4,1.1)
XECUTE ^DD(9002193,.02,1,4,1.4)
End DoDot:1
+20 SET X=$PIECE(DIKZ(0),U,2)
+21 IF X'=""
Begin DoDot:1
+22 NEW DIK,DIV,DIU,DIN
+23 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.02,1,5,1.1)
XECUTE ^DD(9002193,.02,1,5,1.4)
End DoDot:1
+24 SET X=$PIECE(DIKZ(0),U,2)
+25 IF X'=""
Begin DoDot:1
+26 NEW DIK,DIV,DIU,DIN
+27 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,4)'=""
IF X
SET X=DIV
XECUTE ^DD(9002193,.02,1,6,89.2)
SET X=$PIECE(Y(101),U,1)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.02,1,6,1.1)
XECUTE ^DD(9002193,.02,1,6,1.4)
End DoDot:1
+28 SET X=$PIECE(DIKZ(0),U,2)
+29 IF X'=""
Begin DoDot:1
+30 NEW DIK,DIV,DIU,DIN
+31 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,9)'=""
IF X
SET X=DIV
XECUTE ^DD(9002193,.02,1,7,89.2)
SET X=$PIECE(Y(101),U,4)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.02,1,7,1.1)
XECUTE ^DD(9002193,.02,1,7,1.4)
End DoDot:1
+32 SET X=$PIECE(DIKZ(0),U,2)
+33 IF X'=""
Begin DoDot:1
+34 NEW DIK,DIV,DIU,DIN
+35 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,7)'=""
IF X
SET X=DIV
XECUTE ^DD(9002193,.02,1,8,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.02,1,8,1.1)
XECUTE ^DD(9002193,.02,1,8,1.4)
End DoDot:1
+36 SET DIKZ(0)=$GET(^ACRSS(DA,0))
+37 SET X=$PIECE(DIKZ(0),U,3)
+38 IF X'=""
SET ^ACRSS("C",$EXTRACT(X,1,30),DA)=""
+39 SET X=$PIECE(DIKZ(0),U,3)
+40 IF X'=""
Begin DoDot:1
+41 NEW DIK,DIV,DIU,DIN
+42 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"PO")):^("PO"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002193,.03,1,2,1.4)
End DoDot:1
+43 SET DIKZ(0)=$GET(^ACRSS(DA,0))
+44 SET X=$PIECE(DIKZ(0),U,4)
+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
XECUTE ^DD(9002193,.04,1,3,89.2)
SET X=$SELECT('$DATA(^AUTTOBJC(+$PIECE(Y(101),U,3),0)):"",1:$PIECE(^(0),U,1))
SET D0=I(0,0)
SET DIU=X
KILL Y
SET X=DIV
SET X=DIV
SET X=X
XECUTE ^DD(9002193,.04,1,3,1.4)
End DoDot:1
+48 SET DIKZ(0)=$GET(^ACRSS(DA,0))
+49 SET X=$PIECE(DIKZ(0),U,5)
+50 IF X'=""
SET ^ACRSS("CAN",$EXTRACT(X,1,30),DA)=""
+51 SET X=$PIECE(DIKZ(0),U,5)
+52 IF X'=""
Begin DoDot:1
+53 NEW DIK,DIV,DIU,DIN
+54 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,11)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.05,1,2,1.1)
XECUTE ^DD(9002193,.05,1,2,1.4)
End DoDot:1
+55 SET DIKZ(0)=$GET(^ACRSS(DA,0))
+56 SET X=$PIECE(DIKZ(0),U,6)
+57 IF X'=""
SET ^ACRSS("F",$EXTRACT(X,1,30),DA)=""
+58 SET X=$PIECE(DIKZ(0),U,6)
+59 IF X'=""
Begin DoDot:1
+60 NEW DIK,DIV,DIU,DIN
+61 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,8)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.06,1,2,1.1)
XECUTE ^DD(9002193,.06,1,2,1.4)
End DoDot:1
+62 SET X=$PIECE(DIKZ(0),U,6)
+63 IF X'=""
Begin DoDot:1
+64 NEW DIK,DIV,DIU,DIN
+65 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,9)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.06,1,3,1.1)
XECUTE ^DD(9002193,.06,1,3,1.4)
End DoDot:1
+66 SET X=$PIECE(DIKZ(0),U,6)
+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
XECUTE ^DD(9002193,.06,1,4,89.2)
SET X=$PIECE(Y(101),U,2)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.06,1,4,1.1)
XECUTE ^DD(9002193,.06,1,4,1.4)
End DoDot:1
+70 SET X=$PIECE(DIKZ(0),U,6)
+71 IF X'=""
Begin DoDot:1
+72 NEW DIK,DIV,DIU,DIN
+73 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,.06,1,5,89.2)
SET X=$PIECE(Y(101),U,5)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.06,1,5,1.1)
XECUTE ^DD(9002193,.06,1,5,1.4)
End DoDot:1
+74 SET X=$PIECE(DIKZ(0),U,6)
+75 IF X'=""
Begin DoDot:1
+76 NEW DIK,DIV,DIU,DIN
+77 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
XECUTE ^DD(9002193,.06,1,6,89.2)
SET X=$PIECE(Y(101),U,3)
SET D0=I(0,0)
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.06,1,6,1.1)
XECUTE ^DD(9002193,.06,1,6,1.4)
End DoDot:1
+78 SET X=$PIECE(DIKZ(0),U,6)
+79 IF X'=""
Begin DoDot:1
+80 NEW DIK,DIV,DIU,DIN
+81 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.06,1,7,1.1)
XECUTE ^DD(9002193,.06,1,7,1.4)
End DoDot:1
+82 SET DIKZ(0)=$GET(^ACRSS(DA,0))
+83 SET X=$PIECE(DIKZ(0),U,7)
+84 IF X'=""
SET ^ACRSS("E",$EXTRACT(X,1,30),$PIECE(^ACRSS(DA,0),U),DA)=""
+85 SET X=$PIECE(DIKZ(0),U,8)
+86 IF X'=""
SET ^ACRSS("G",$EXTRACT(X,1,30),DA)=""
+87 SET X=$PIECE(DIKZ(0),U,9)
+88 IF X'=""
SET ^ACRSS("H",$EXTRACT(X,1,30),DA)=""
+89 SET X=$PIECE(DIKZ(0),U,11)
+90 IF X'=""
SET ^ACRSS("AREA",$EXTRACT(X,1,30),DA)=""
+91 SET X=$PIECE(DIKZ(0),U,12)
+92 IF X'=""
Begin DoDot:1
+93 NEW DIK,DIV,DIU,DIN
+94 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DESC")):^("DESC"),1:"")
SET X=$PIECE(Y(1),U,1)
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
+95 SET X=$PIECE(DIKZ(0),U,12)
+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,"DESC")):^("DESC"),1:"")
SET X=$PIECE(Y(1),U,2)
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
+99 SET X=$PIECE(DIKZ(0),U,12)
+100 IF X'=""
Begin DoDot:1
+101 NEW DIK,DIV,DIU,DIN
+102 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"VND")):^("VND"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,3,1.1)
XECUTE ^DD(9002193,.12,1,3,1.4)
End DoDot:1
+103 SET X=$PIECE(DIKZ(0),U,12)
+104 IF X'=""
Begin DoDot:1
+105 NEW DIK,DIV,DIU,DIN
+106 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DESC")):^("DESC"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,4,1.1)
XECUTE ^DD(9002193,.12,1,4,1.4)
End DoDot:1
+107 SET X=$PIECE(DIKZ(0),U,12)
+108 IF X'=""
Begin DoDot:1
+109 NEW DIK,DIV,DIU,DIN
+110 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DESC")):^("DESC"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,5,1.1)
XECUTE ^DD(9002193,.12,1,5,1.4)
End DoDot:1
+111 SET X=$PIECE(DIKZ(0),U,12)
+112 IF X'=""
Begin DoDot:1
+113 NEW DIK,DIV,DIU,DIN
+114 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"DESC")):^("DESC"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,6,1.1)
XECUTE ^DD(9002193,.12,1,6,1.4)
End DoDot:1
+115 SET X=$PIECE(DIKZ(0),U,12)
+116 IF X'=""
Begin DoDot:1
+117 NEW DIK,DIV,DIU,DIN
+118 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"NOTES")):^("NOTES"),1:"")
SET X=$PIECE(Y(1),U,1)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,7,1.1)
XECUTE ^DD(9002193,.12,1,7,1.4)
End DoDot:1
+119 SET X=$PIECE(DIKZ(0),U,12)
+120 IF X'=""
Begin DoDot:1
+121 NEW DIK,DIV,DIU,DIN
+122 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"NOTES")):^("NOTES"),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,8,1.1)
XECUTE ^DD(9002193,.12,1,8,1.4)
End DoDot:1
+123 SET X=$PIECE(DIKZ(0),U,12)
+124 IF X'=""
Begin DoDot:1
+125 NEW DIK,DIV,DIU,DIN
+126 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"NOTES")):^("NOTES"),1:"")
SET X=$PIECE(Y(1),U,3)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,9,1.1)
XECUTE ^DD(9002193,.12,1,9,1.4)
End DoDot:1
+127 SET X=$PIECE(DIKZ(0),U,12)
+128 IF X'=""
Begin DoDot:1
+129 NEW DIK,DIV,DIU,DIN
+130 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"NOTES")):^("NOTES"),1:"")
SET X=$PIECE(Y(1),U,4)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,10,1.1)
XECUTE ^DD(9002193,.12,1,10,1.4)
End DoDot:1
+131 SET X=$PIECE(DIKZ(0),U,12)
+132 IF X'=""
Begin DoDot:1
+133 NEW DIK,DIV,DIU,DIN
+134 KILL DIV
SET DIV=X
SET D0=DA
SET DIV(0)=D0
SET Y(1)=$SELECT($DATA(^ACRSS(D0,"NOTES")):^("NOTES"),1:"")
SET X=$PIECE(Y(1),U,5)
SET X=X
SET DIU=X
KILL Y
XECUTE ^DD(9002193,.12,1,11,1.1)
XECUTE ^DD(9002193,.12,1,11,1.4)
End DoDot:1
+135 SET DIKZ(0)=$GET(^ACRSS(DA,0))
+136 SET X=$PIECE(DIKZ(0),U,13)
+137 IF X'=""
SET ^ACRSS("I",$EXTRACT(X,1,30),DA)=""
+138 SET X=$PIECE(DIKZ(0),U,13)
+139 IF X'=""
IF $PIECE($GET(^ACRSS(+$GET(DA),"NMS")),U)]""
IF $PIECE($GET(^(0)),U,17)
SET ^ACRSS("PR",X,$PIECE(^("NMS"),U),$PIECE(^(0),U,17),DA)=""
+140 SET X=$PIECE(DIKZ(0),U,15)
+141 IF X'=""
SET ^ACRSS("LCOD",$EXTRACT(X,1,30),DA)=""
+142 SET X=$PIECE(DIKZ(0),U,17)
+143 IF X'=""
IF $PIECE($GET(^ACRSS(+$GET(DA),"NMS")),U)]""
IF $PIECE(^(0),U,13)
SET ^ACRSS("PR",$PIECE(^("NMS"),U),$PIECE(^(0),U,13),X,DA)=""
+144 SET DIKZ("PO")=$GET(^ACRSS(DA,"PO"))
+145 SET X=$PIECE(DIKZ("PO"),U,1)
+146 IF X'=""
SET ^ACRSS("J",$EXTRACT(X,1,30),DA)=""
+147 SET DIKZ("NMS")=$GET(^ACRSS(DA,"NMS"))
+148 SET X=$PIECE(DIKZ("NMS"),U,1)
+149 IF X'=""
IF $PIECE($GET(^ACRSS(+$GET(DA),0)),U,13)]""
IF $PIECE(^(0),U,17)
SET ^ACRSS("PR",$PIECE(^(0),U,13),X,$PIECE(^(0),U,17),DA)=""
+150 SET DIKZ("DT")=$GET(^ACRSS(DA,"DT"))
+151 SET X=$PIECE(DIKZ("DT"),U,1)
END GOTO ^ACRCSS6
