- ORD11 ; COMPILED XREF FOR FILE #101 ; 04/18/11
- ;
- S DIKZK=2
- S DIKZ(0)=$G(^ORD(101,DA,0))
- S X=$P(DIKZ(0),U,2)
- I X'="" S ORKX=X D UP^ORDD1 K ^ORD(101,"C",$E(X,1,63),DA) S X=ORKX K ORKX
- S X=$P(DIKZ(0),U,2)
- I X'="" D REDO^ORDD101
- S X=$P(DIKZ(0),U,2)
- I X'="" D K12^ORDD1
- S DIKZ(5)=$G(^ORD(101,DA,5))
- S X=$P(DIKZ(5),U,1)
- I X'="" K ^ORD(101,"AE",$E(X,1,30),DA)
- S DIKZ(4)=$G(^ORD(101,DA,4))
- S X=$P(DIKZ(4),U,1)
- I X'="" D REDO^ORDD101
- S DIKZ(99)=$G(^ORD(101,DA,99))
- S X=$P(DIKZ(99),U,1)
- I X'="" D KILL^ORDD101
- S DIKZ(770)=$G(^ORD(101,DA,770))
- S X=$P(DIKZ(770),U,1)
- I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^",3)&($P(HL770,"^",4)) ^ORD(101,"AHL1",X,$P(HL770,"^",3),$P(HL770,"^",4),DA)
- S X=$P(DIKZ(770),U,1)
- I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^",3)&($P(HL770,"^",10)) ^ORD(101,"AHL21",X,$P(HL770,"^",3),$P(HL770,"^",10),DA)
- S X=$P(DIKZ(770),U,2)
- I X'="" K ^ORD(101,"AHL2",$E(X,1,30),DA)
- S X=$P(DIKZ(770),U,3)
- I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",4)) ^ORD(101,"AHL1",$P(HL770,"^"),X,$P(HL770,"^",4),DA)
- S X=$P(DIKZ(770),U,3)
- I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",10)) ^ORD(101,"AHL21",$P(HL770,"^"),X,$P(HL770,"^",10),DA)
- S X=$P(DIKZ(770),U,4)
- I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",3)) ^ORD(101,"AHL1",$P(HL770,"^"),$P(HL770,"^",3),X,DA)
- S X=$P(DIKZ(770),U,10)
- I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",3))&($P(HL770,"^",4)) ^ORD(101,"AHL1",$P(HL770,"^"),$P(HL770,"^",3),$P(HL770,"^",4),X,DA)
- S X=$P(DIKZ(770),U,10)
- I X'="" N HL770 S HL770=$G(^ORD(101,DA,770)) K:$P(HL770,"^")&($P(HL770,"^",3)) ^ORD(101,"AHL21",$P(HL770,"^"),$P(HL770,"^",3),X,DA)
- S X=$P(DIKZ(0),U,1)
- I X'="" K ^ORD(101,"B",$E(X,1,63),DA)
- END G ^ORD12
- ORD11 ; COMPILED XREF FOR FILE #101 ; 04/18/11
- +1 ;
- +2 SET DIKZK=2
- +3 SET DIKZ(0)=$GET(^ORD(101,DA,0))
- +4 SET X=$PIECE(DIKZ(0),U,2)
- +5 IF X'=""
- SET ORKX=X
- DO UP^ORDD1
- KILL ^ORD(101,"C",$EXTRACT(X,1,63),DA)
- SET X=ORKX
- KILL ORKX
- +6 SET X=$PIECE(DIKZ(0),U,2)
- +7 IF X'=""
- DO REDO^ORDD101
- +8 SET X=$PIECE(DIKZ(0),U,2)
- +9 IF X'=""
- DO K12^ORDD1
- +10 SET DIKZ(5)=$GET(^ORD(101,DA,5))
- +11 SET X=$PIECE(DIKZ(5),U,1)
- +12 IF X'=""
- KILL ^ORD(101,"AE",$EXTRACT(X,1,30),DA)
- +13 SET DIKZ(4)=$GET(^ORD(101,DA,4))
- +14 SET X=$PIECE(DIKZ(4),U,1)
- +15 IF X'=""
- DO REDO^ORDD101
- +16 SET DIKZ(99)=$GET(^ORD(101,DA,99))
- +17 SET X=$PIECE(DIKZ(99),U,1)
- +18 IF X'=""
- DO KILL^ORDD101
- +19 SET DIKZ(770)=$GET(^ORD(101,DA,770))
- +20 SET X=$PIECE(DIKZ(770),U,1)
- +21 IF X'=""
- NEW HL770
- SET HL770=$GET(^ORD(101,DA,770))
- IF $PIECE(HL770,"^",3)&($PIECE(HL770,"^",4))
- KILL ^ORD(101,"AHL1",X,$PIECE(HL770,"^",3),$PIECE(HL770,"^",4),DA)
- +22 SET X=$PIECE(DIKZ(770),U,1)
- +23 IF X'=""
- NEW HL770
- SET HL770=$GET(^ORD(101,DA,770))
- IF $PIECE(HL770,"^",3)&($PIECE(HL770,"^",10))
- KILL ^ORD(101,"AHL21",X,$PIECE(HL770,"^",3),$PIECE(HL770,"^",10),DA)
- +24 SET X=$PIECE(DIKZ(770),U,2)
- +25 IF X'=""
- KILL ^ORD(101,"AHL2",$EXTRACT(X,1,30),DA)
- +26 SET X=$PIECE(DIKZ(770),U,3)
- +27 IF X'=""
- NEW HL770
- SET HL770=$GET(^ORD(101,DA,770))
- IF $PIECE(HL770,"^")&($PIECE(HL770,"^",4))
- KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),X,$PIECE(HL770,"^",4),DA)
- +28 SET X=$PIECE(DIKZ(770),U,3)
- +29 IF X'=""
- NEW HL770
- SET HL770=$GET(^ORD(101,DA,770))
- IF $PIECE(HL770,"^")&($PIECE(HL770,"^",10))
- KILL ^ORD(101,"AHL21",$PIECE(HL770,"^"),X,$PIECE(HL770,"^",10),DA)
- +30 SET X=$PIECE(DIKZ(770),U,4)
- +31 IF X'=""
- NEW HL770
- SET HL770=$GET(^ORD(101,DA,770))
- IF $PIECE(HL770,"^")&($PIECE(HL770,"^",3))
- KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),$PIECE(HL770,"^",3),X,DA)
- +32 SET X=$PIECE(DIKZ(770),U,10)
- +33 IF X'=""
- NEW HL770
- SET HL770=$GET(^ORD(101,DA,770))
- IF $PIECE(HL770,"^")&($PIECE(HL770,"^",3))&($PIECE(HL770,"^",4))
- KILL ^ORD(101,"AHL1",$PIECE(HL770,"^"),$PIECE(HL770,"^",3),$PIECE(HL770,"^",4),X,DA)
- +34 SET X=$PIECE(DIKZ(770),U,10)
- +35 IF X'=""
- NEW HL770
- SET HL770=$GET(^ORD(101,DA,770))
- IF $PIECE(HL770,"^")&($PIECE(HL770,"^",3))
- KILL ^ORD(101,"AHL21",$PIECE(HL770,"^"),$PIECE(HL770,"^",3),X,DA)
- +36 SET X=$PIECE(DIKZ(0),U,1)
- +37 IF X'=""
- KILL ^ORD(101,"B",$EXTRACT(X,1,63),DA)
- END GOTO ^ORD12
