- ACRCD14 ; COMPILED XREF FOR FILE #9002196.0111 ; 09/30/09
- ;
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRDOC(D0,"POMI")):^("POMI"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,7,1.1) X ^DD(9002196,113100,1,7,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,8,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,8,1.1) X ^DD(9002196,113100,1,8,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,9,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y X ^DD(9002196,113100,1,9,1.1) X ^DD(9002196,113100,1,9,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,10,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y X ^DD(9002196,113100,1,10,1.1) X ^DD(9002196,113100,1,10,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,11,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,11,1.1) X ^DD(9002196,113100,1,11,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,12,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y X ^DD(9002196,113100,1,12,1.1) X ^DD(9002196,113100,1,12,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,13,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y X ^DD(9002196,113100,1,13,1.1) X ^DD(9002196,113100,1,13,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,14,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y X ^DD(9002196,113100,1,14,1.1) X ^DD(9002196,113100,1,14,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,15,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y X ^DD(9002196,113100,1,15,1.1) X ^DD(9002196,113100,1,15,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,16,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y X ^DD(9002196,113100,1,16,1.1) X ^DD(9002196,113100,1,16,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,17,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TO")):^("TO"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y X ^DD(9002196,113100,1,17,1.1) X ^DD(9002196,113100,1,17,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,18,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TO")):^("TO"),1:"") S X=$P(Y(1),U,21),X=X S DIU=X K Y X ^DD(9002196,113100,1,18,1.1) X ^DD(9002196,113100,1,18,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,19,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TO")):^("TO"),1:"") S X=$P(Y(1),U,16),X=X S DIU=X K Y X ^DD(9002196,113100,1,19,1.1) X ^DD(9002196,113100,1,19,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,20,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"PA")):^("PA"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,20,1.1) X ^DD(9002196,113100,1,20,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,21,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(9002196,113100,1,21,1.1) X ^DD(9002196,113100,1,21,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,22,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"POMI")):^("POMI"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,22,1.1) X ^DD(9002196,113100,1,22,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,23,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(9002196,113100,1,23,1.1) X ^DD(9002196,113100,1,23,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,24,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"") S X=$P(Y(1),U,26),X=X S DIU=X K Y X ^DD(9002196,113100,1,24,1.1) X ^DD(9002196,113100,1,24,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,25,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,25,1.1) X ^DD(9002196,113100,1,25,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,26,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(9002196,113100,1,26,1.1) X ^DD(9002196,113100,1,26,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,27,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(9002196,113100,1,27,1.1) X ^DD(9002196,113100,1,27,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,28,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002196,113100,1,28,1.1) X ^DD(9002196,113100,1,28,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,29,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(9002196,113100,1,29,1.1) X ^DD(9002196,113100,1,29,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,30,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"REQ")):^("REQ"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002196,113100,1,30,1.1) X ^DD(9002196,113100,1,30,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,31,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TO")):^("TO"),1:"") S X=$P(Y(1),U,24),X=X S DIU=X K Y X ^DD(9002196,113100,1,31,1.1) X ^DD(9002196,113100,1,31,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,32,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"") S X=$P(Y(1),U,25),X=X S DIU=X K Y X ^DD(9002196,113100,1,32,1.1) X ^DD(9002196,113100,1,32,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,33,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TO")):^("TO"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(9002196,113100,1,33,1.1) X ^DD(9002196,113100,1,33,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,34,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"") S X=$P(Y(1),U,25),X=X S DIU=X K Y X ^DD(9002196,113100,1,34,1.1) X ^DD(9002196,113100,1,34,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .X ^DD(9002196,113100,1,35,1.3) I X S X=DIV S Y(1)=$S($D(^ACRDOC(D0,"PO")):^("PO"),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y X ^DD(9002196,113100,1,35,1.1) X ^DD(9002196,113100,1,35,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(9002196,113100,1,36,1.1) X ^DD(9002196,113100,1,36,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y X ^DD(9002196,113100,1,37,1.1) X ^DD(9002196,113100,1,37,1.4)
- S X=$P(DIKZ("REQ"),U,10)
- I X'="" D
- .N DIK,DIV,DIU,DIN
- .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y X ^DD(9002196,113100,1,38,1.1) X ^DD(9002196,113100,1,38,1.4)
- END G ^ACRCD15
- ACRCD14 ; COMPILED XREF FOR FILE #9002196.0111 ; 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(1)=$SELECT($DATA(^ACRDOC(D0,"POMI")):^("POMI"),1:"")
- SET X=$PIECE(Y(1),U,1)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,7,1.1)
- XECUTE ^DD(9002196,113100,1,7,1.4)
- End DoDot:1
- +5 SET X=$PIECE(DIKZ("REQ"),U,10)
- +6 IF X'=""
- Begin DoDot:1
- +7 NEW DIK,DIV,DIU,DIN
- +8 XECUTE ^DD(9002196,113100,1,8,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,1)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,8,1.1)
- XECUTE ^DD(9002196,113100,1,8,1.4)
- End DoDot:1
- +9 SET X=$PIECE(DIKZ("REQ"),U,10)
- +10 IF X'=""
- Begin DoDot:1
- +11 NEW DIK,DIV,DIU,DIN
- +12 XECUTE ^DD(9002196,113100,1,9,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,7)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,9,1.1)
- XECUTE ^DD(9002196,113100,1,9,1.4)
- End DoDot:1
- +13 SET X=$PIECE(DIKZ("REQ"),U,10)
- +14 IF X'=""
- Begin DoDot:1
- +15 NEW DIK,DIV,DIU,DIN
- +16 XECUTE ^DD(9002196,113100,1,10,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,8)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,10,1.1)
- XECUTE ^DD(9002196,113100,1,10,1.4)
- End DoDot:1
- +17 SET X=$PIECE(DIKZ("REQ"),U,10)
- +18 IF X'=""
- Begin DoDot:1
- +19 NEW DIK,DIV,DIU,DIN
- +20 XECUTE ^DD(9002196,113100,1,11,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"")
- SET X=$PIECE(Y(1),U,1)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,11,1.1)
- XECUTE ^DD(9002196,113100,1,11,1.4)
- End DoDot:1
- +21 SET X=$PIECE(DIKZ("REQ"),U,10)
- +22 IF X'=""
- Begin DoDot:1
- +23 NEW DIK,DIV,DIU,DIN
- +24 XECUTE ^DD(9002196,113100,1,12,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,12)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,12,1.1)
- XECUTE ^DD(9002196,113100,1,12,1.4)
- End DoDot:1
- +25 SET X=$PIECE(DIKZ("REQ"),U,10)
- +26 IF X'=""
- Begin DoDot:1
- +27 NEW DIK,DIV,DIU,DIN
- +28 XECUTE ^DD(9002196,113100,1,13,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,13)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,13,1.1)
- XECUTE ^DD(9002196,113100,1,13,1.4)
- End DoDot:1
- +29 SET X=$PIECE(DIKZ("REQ"),U,10)
- +30 IF X'=""
- Begin DoDot:1
- +31 NEW DIK,DIV,DIU,DIN
- +32 XECUTE ^DD(9002196,113100,1,14,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,14)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,14,1.1)
- XECUTE ^DD(9002196,113100,1,14,1.4)
- End DoDot:1
- +33 SET X=$PIECE(DIKZ("REQ"),U,10)
- +34 IF X'=""
- Begin DoDot:1
- +35 NEW DIK,DIV,DIU,DIN
- +36 XECUTE ^DD(9002196,113100,1,15,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,15)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,15,1.1)
- XECUTE ^DD(9002196,113100,1,15,1.4)
- End DoDot:1
- +37 SET X=$PIECE(DIKZ("REQ"),U,10)
- +38 IF X'=""
- Begin DoDot:1
- +39 NEW DIK,DIV,DIU,DIN
- +40 XECUTE ^DD(9002196,113100,1,16,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"")
- SET X=$PIECE(Y(1),U,6)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,16,1.1)
- XECUTE ^DD(9002196,113100,1,16,1.4)
- End DoDot:1
- +41 SET X=$PIECE(DIKZ("REQ"),U,10)
- +42 IF X'=""
- Begin DoDot:1
- +43 NEW DIK,DIV,DIU,DIN
- +44 XECUTE ^DD(9002196,113100,1,17,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
- SET X=$PIECE(Y(1),U,12)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,17,1.1)
- XECUTE ^DD(9002196,113100,1,17,1.4)
- End DoDot:1
- +45 SET X=$PIECE(DIKZ("REQ"),U,10)
- +46 IF X'=""
- Begin DoDot:1
- +47 NEW DIK,DIV,DIU,DIN
- +48 XECUTE ^DD(9002196,113100,1,18,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
- SET X=$PIECE(Y(1),U,21)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,18,1.1)
- XECUTE ^DD(9002196,113100,1,18,1.4)
- End DoDot:1
- +49 SET X=$PIECE(DIKZ("REQ"),U,10)
- +50 IF X'=""
- Begin DoDot:1
- +51 NEW DIK,DIV,DIU,DIN
- +52 XECUTE ^DD(9002196,113100,1,19,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
- SET X=$PIECE(Y(1),U,16)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,19,1.1)
- XECUTE ^DD(9002196,113100,1,19,1.4)
- End DoDot:1
- +53 SET X=$PIECE(DIKZ("REQ"),U,10)
- +54 IF X'=""
- Begin DoDot:1
- +55 NEW DIK,DIV,DIU,DIN
- +56 XECUTE ^DD(9002196,113100,1,20,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"PA")):^("PA"),1:"")
- SET X=$PIECE(Y(1),U,1)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,20,1.1)
- XECUTE ^DD(9002196,113100,1,20,1.4)
- End DoDot:1
- +57 SET X=$PIECE(DIKZ("REQ"),U,10)
- +58 IF X'=""
- Begin DoDot:1
- +59 NEW DIK,DIV,DIU,DIN
- +60 XECUTE ^DD(9002196,113100,1,21,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TOAU")):^("TOAU"),1:"")
- SET X=$PIECE(Y(1),U,2)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,21,1.1)
- XECUTE ^DD(9002196,113100,1,21,1.4)
- End DoDot:1
- +61 SET X=$PIECE(DIKZ("REQ"),U,10)
- +62 IF X'=""
- Begin DoDot:1
- +63 NEW DIK,DIV,DIU,DIN
- +64 XECUTE ^DD(9002196,113100,1,22,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"POMI")):^("POMI"),1:"")
- SET X=$PIECE(Y(1),U,1)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,22,1.1)
- XECUTE ^DD(9002196,113100,1,22,1.4)
- End DoDot:1
- +65 SET X=$PIECE(DIKZ("REQ"),U,10)
- +66 IF X'=""
- Begin DoDot:1
- +67 NEW DIK,DIV,DIU,DIN
- +68 XECUTE ^DD(9002196,113100,1,23,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"")
- SET X=$PIECE(Y(1),U,3)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,23,1.1)
- XECUTE ^DD(9002196,113100,1,23,1.4)
- End DoDot:1
- +69 SET X=$PIECE(DIKZ("REQ"),U,10)
- +70 IF X'=""
- Begin DoDot:1
- +71 NEW DIK,DIV,DIU,DIN
- +72 XECUTE ^DD(9002196,113100,1,24,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"")
- SET X=$PIECE(Y(1),U,26)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,24,1.1)
- XECUTE ^DD(9002196,113100,1,24,1.4)
- End DoDot:1
- +73 SET X=$PIECE(DIKZ("REQ"),U,10)
- +74 IF X'=""
- Begin DoDot:1
- +75 NEW DIK,DIV,DIU,DIN
- +76 XECUTE ^DD(9002196,113100,1,25,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"")
- SET X=$PIECE(Y(1),U,1)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,25,1.1)
- XECUTE ^DD(9002196,113100,1,25,1.4)
- End DoDot:1
- +77 SET X=$PIECE(DIKZ("REQ"),U,10)
- +78 IF X'=""
- Begin DoDot:1
- +79 NEW DIK,DIV,DIU,DIN
- +80 XECUTE ^DD(9002196,113100,1,26,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"")
- SET X=$PIECE(Y(1),U,2)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,26,1.1)
- XECUTE ^DD(9002196,113100,1,26,1.4)
- End DoDot:1
- +81 SET X=$PIECE(DIKZ("REQ"),U,10)
- +82 IF X'=""
- Begin DoDot:1
- +83 NEW DIK,DIV,DIU,DIN
- +84 XECUTE ^DD(9002196,113100,1,27,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"")
- SET X=$PIECE(Y(1),U,3)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,27,1.1)
- XECUTE ^DD(9002196,113100,1,27,1.4)
- End DoDot:1
- +85 SET X=$PIECE(DIKZ("REQ"),U,10)
- +86 IF X'=""
- Begin DoDot:1
- +87 NEW DIK,DIV,DIU,DIN
- +88 XECUTE ^DD(9002196,113100,1,28,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"")
- SET X=$PIECE(Y(1),U,4)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,28,1.1)
- XECUTE ^DD(9002196,113100,1,28,1.4)
- End DoDot:1
- +89 SET X=$PIECE(DIKZ("REQ"),U,10)
- +90 IF X'=""
- Begin DoDot:1
- +91 NEW DIK,DIV,DIU,DIN
- +92 XECUTE ^DD(9002196,113100,1,29,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG4")):^("TRNG4"),1:"")
- SET X=$PIECE(Y(1),U,5)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,29,1.1)
- XECUTE ^DD(9002196,113100,1,29,1.4)
- End DoDot:1
- +93 SET X=$PIECE(DIKZ("REQ"),U,10)
- +94 IF X'=""
- Begin DoDot:1
- +95 NEW DIK,DIV,DIU,DIN
- +96 XECUTE ^DD(9002196,113100,1,30,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ")):^("REQ"),1:"")
- SET X=$PIECE(Y(1),U,4)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,30,1.1)
- XECUTE ^DD(9002196,113100,1,30,1.4)
- End DoDot:1
- +97 SET X=$PIECE(DIKZ("REQ"),U,10)
- +98 IF X'=""
- Begin DoDot:1
- +99 NEW DIK,DIV,DIU,DIN
- +100 XECUTE ^DD(9002196,113100,1,31,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
- SET X=$PIECE(Y(1),U,24)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,31,1.1)
- XECUTE ^DD(9002196,113100,1,31,1.4)
- End DoDot:1
- +101 SET X=$PIECE(DIKZ("REQ"),U,10)
- +102 IF X'=""
- Begin DoDot:1
- +103 NEW DIK,DIV,DIU,DIN
- +104 XECUTE ^DD(9002196,113100,1,32,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"")
- SET X=$PIECE(Y(1),U,25)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,32,1.1)
- XECUTE ^DD(9002196,113100,1,32,1.4)
- End DoDot:1
- +105 SET X=$PIECE(DIKZ("REQ"),U,10)
- +106 IF X'=""
- Begin DoDot:1
- +107 NEW DIK,DIV,DIU,DIN
- +108 XECUTE ^DD(9002196,113100,1,33,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TO")):^("TO"),1:"")
- SET X=$PIECE(Y(1),U,1)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,33,1.1)
- XECUTE ^DD(9002196,113100,1,33,1.4)
- End DoDot:1
- +109 SET X=$PIECE(DIKZ("REQ"),U,10)
- +110 IF X'=""
- Begin DoDot:1
- +111 NEW DIK,DIV,DIU,DIN
- +112 XECUTE ^DD(9002196,113100,1,34,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"TRNG")):^("TRNG"),1:"")
- SET X=$PIECE(Y(1),U,25)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,34,1.1)
- XECUTE ^DD(9002196,113100,1,34,1.4)
- End DoDot:1
- +113 SET X=$PIECE(DIKZ("REQ"),U,10)
- +114 IF X'=""
- Begin DoDot:1
- +115 NEW DIK,DIV,DIU,DIN
- +116 XECUTE ^DD(9002196,113100,1,35,1.3)
- IF X
- SET X=DIV
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"PO")):^("PO"),1:"")
- SET X=$PIECE(Y(1),U,6)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,35,1.1)
- XECUTE ^DD(9002196,113100,1,35,1.4)
- End DoDot:1
- +117 SET X=$PIECE(DIKZ("REQ"),U,10)
- +118 IF X'=""
- Begin DoDot:1
- +119 NEW DIK,DIV,DIU,DIN
- +120 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"")
- SET X=$PIECE(Y(1),U,10)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,36,1.1)
- XECUTE ^DD(9002196,113100,1,36,1.4)
- End DoDot:1
- +121 SET X=$PIECE(DIKZ("REQ"),U,10)
- +122 IF X'=""
- Begin DoDot:1
- +123 NEW DIK,DIV,DIU,DIN
- +124 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ2")):^("REQ2"),1:"")
- SET X=$PIECE(Y(1),U,4)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,37,1.1)
- XECUTE ^DD(9002196,113100,1,37,1.4)
- End DoDot:1
- +125 SET X=$PIECE(DIKZ("REQ"),U,10)
- +126 IF X'=""
- Begin DoDot:1
- +127 NEW DIK,DIV,DIU,DIN
- +128 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- SET Y(1)=$SELECT($DATA(^ACRDOC(D0,"REQ1")):^("REQ1"),1:"")
- SET X=$PIECE(Y(1),U,14)
- SET X=X
- SET DIU=X
- KILL Y
- XECUTE ^DD(9002196,113100,1,38,1.1)
- XECUTE ^DD(9002196,113100,1,38,1.4)
- End DoDot:1
- END GOTO ^ACRCD15
