- ORD11 ; COMPILED XREF FOR FILE #101 ; 04/16/99
- ;
- S DIKZK=2
- S DIKZ(0)=$G(^ORD(101,DA,0))
- S X=$P(DIKZ(0),U,1)
- I X'="" K ^ORD(101,"B",$E(X,1,63),DA)
- 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,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,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)
- END G ^ORD12
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORD11 1191 printed Mar 13, 2025@21:34:10 Page 2
- ORD11 ; COMPILED XREF FOR FILE #101 ; 04/16/99
- +1 ;
- +2 SET DIKZK=2
- +3 SET DIKZ(0)=$GET(^ORD(101,DA,0))
- +4 SET X=$PIECE(DIKZ(0),U,1)
- +5 IF X'=""
- KILL ^ORD(101,"B",$EXTRACT(X,1,63),DA)
- +6 SET X=$PIECE(DIKZ(0),U,2)
- +7 IF X'=""
- SET ORKX=X
- DO UP^ORDD1
- KILL ^ORD(101,"C",$EXTRACT(X,1,63),DA)
- SET X=ORKX
- KILL ORKX
- +8 SET X=$PIECE(DIKZ(0),U,2)
- +9 IF X'=""
- DO REDO^ORDD101
- +10 SET X=$PIECE(DIKZ(0),U,2)
- +11 IF X'=""
- DO K12^ORDD1
- +12 SET DIKZ(5)=$GET(^ORD(101,DA,5))
- +13 SET X=$PIECE(DIKZ(5),U,1)
- +14 IF X'=""
- KILL ^ORD(101,"AE",$EXTRACT(X,1,30),DA)
- +15 SET DIKZ(4)=$GET(^ORD(101,DA,4))
- +16 SET X=$PIECE(DIKZ(4),U,1)
- +17 IF X'=""
- DO REDO^ORDD101
- +18 SET DIKZ(99)=$GET(^ORD(101,DA,99))
- +19 SET X=$PIECE(DIKZ(99),U,1)
- +20 IF X'=""
- DO KILL^ORDD101
- +21 SET DIKZ(770)=$GET(^ORD(101,DA,770))
- +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,"^",4))
- KILL ^ORD(101,"AHL1",X,$PIECE(HL770,"^",3),$PIECE(HL770,"^",4),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,4)
- +29 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)
- END GOTO ^ORD12
