- LRXREF1 ; IHS/DIR/FJE - CONTINUE BUILD X-REF FOR RE-INDEX 12:41 ; [ 5/15/90 ]
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- AT ;^LRO(69,"AT" CROSS REFERENCE
- I DA,DA(1),DA(2),$D(^LRO(69,DA(2),1,DA(1),2,DA,0)) D AT1
- Q
- AT1 S ATX=+^LRO(69,DA(2),1,DA(1),0),ATX(1)=DA(2),ATX(2)=+^(2,DA,0)
- I $D(^LRO(69,DA(2),1,DA(1),4,1,0)) S ATX(3)=+^LRO(69,DA(2),1,DA(1),4,1,0) I ATX,ATX(1),ATX(2),ATX(3) S ^LRO(69,"AT",ATX,ATX(2),ATX(3),ATX(1))="",^(-ATX(1))=""
- K ATX
- Q
- ATD ;KILL FOR ^LRO(69,"AT" CROSS REFERENCE
- I DA,DA(1),DA(2),$D(^LRO(69,DA(2),1,DA(1),2,DA,0)) S ATX=+^LRO(69,DA(2),1,DA(1),0),ATX(1)=DA(2),ATX(2)=+^(2,DA,0)
- I $D(^LRO(69,DA(2),1,DA(1),4,1,0)) S ATX(3)=+^LRO(69,DA(2),1,DA(1),4,1,0) I ATX,ATX(1),ATX(2),ATX(3) K ^LRO(69,"AT",ATX,ATX(2),ATX(3),ATX(1)),^(-ATX(1))
- K ATX
- Q
- AC ;BUILD "AC" CROSS-REFERENCE IN FILE 68
- S LRTN=0,LRTEST=""
- F I=0:0 S LRTN=$O(^LRO(68,DA(2),1,DA(1),1,DA,4,LRTN)) Q:LRTN<1 S LRGTN=LRTN S:LRTEST'="" LRTEST=LRTEST_"^"_LRTN S:LRTEST="" LRTEST=LRTN
- D ^LREXPD G:'$D(LRORD) SET F I=1:1:LRTSTS S LRGTN=LRORD(I) D SET
- END K LRTEST,LRTSTS,^TMP("LR",$J),LRTN,LRGTN Q
- SET I $D(LRGTN) I $D(^LAB(60,LRGTN,.2)) I $P(^LAB(60,LRGTN,0),U,3)'["N" I $P(^(0),U,3)'["I" S ^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2))="" Q
- G:'$D(LRORD) END Q
- AC1 ;KILL "AC" CROSS-REFERENCE IN FILE 68
- S LRTN=0,LRTEST=""
- F I=0:0 S LRTN=$O(^LRO(68,DA(2),1,DA(1),1,DA,4,LRTN)) Q:LRTN<1 S LRGTN=LRTN S:LRTEST'="" LRTEST=LRTEST_"^"_LRTN S:LRTEST="" LRTEST=LRTN
- D ^LREXPD G:'$D(LRORD) KILL F I=1:1:LRTSTS S LRGTN=LRORD(I) D KILL
- K LRTEST,LRTSTS,^TMP("LR",$J),LRTN,LRGTN Q
- KILL I $D(^LAB(60,LRGTN,.2)) I $D(^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2))) K ^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$P(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2))
- Q
- A65 ;Rebuild "A" x-ref in file 65 for 65.15,.08 for Re-index utility
- F LR=0:0 S LR=$O(^LRD(65,DA,15,LR)) Q:'LR S LR(1)=$P(^(LR,0),"^",8) S:LR(1) ^LRD(65,"A",LR(1),DA)=""
- Q
- A658 ;build "A" x-ref in file 65 for 65,.05 for Re-index utility
- S LR=$P(^LRD(65,DA(1),0),"^",5) S:LR ^LRD(65,"A",LR,DA(1))="" Q
- C ;build "C" x-ref in file 69
- I '$D(DIU(0)) S ^LRO(69,"C",+X,DA(1),DA)="" Q
- I $D(DIU(0)),$D(^LRO(69,DA(1),1,DA,2)) S ^LRO(69,"C",+X,DA(1),DA)=""
- Q
- A6599 ;Rebuild Archive "A" x-ref in file 65.9999 for 65.999915,.08 for Re-index utility
- F LR=0:0 S LR=$O(^LRD(65.9999,DA,15,LR)) Q:'LR S LR(1)=$P(^(LR,0),"^",8) S:LR(1) ^LRD(65.9999,"A",LR(1),DA)=""
- Q
- A65899 ;build Archive "A" x-ref in file 65.9999 for 65.9999,.05 for Re-index utility
- S LR=$P(^LRD(65.9999,DA(1),0),"^",5) S:LR ^LRD(65.9999,"A",LR,DA(1))="" Q
- LRXREF1 ; IHS/DIR/FJE - CONTINUE BUILD X-REF FOR RE-INDEX 12:41 ; [ 5/15/90 ]
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- AT ;^LRO(69,"AT" CROSS REFERENCE
- +1 IF DA
- IF DA(1)
- IF DA(2)
- IF $DATA(^LRO(69,DA(2),1,DA(1),2,DA,0))
- DO AT1
- +2 QUIT
- AT1 SET ATX=+^LRO(69,DA(2),1,DA(1),0)
- SET ATX(1)=DA(2)
- SET ATX(2)=+^(2,DA,0)
- +1 IF $DATA(^LRO(69,DA(2),1,DA(1),4,1,0))
- SET ATX(3)=+^LRO(69,DA(2),1,DA(1),4,1,0)
- IF ATX
- IF ATX(1)
- IF ATX(2)
- IF ATX(3)
- SET ^LRO(69,"AT",ATX,ATX(2),ATX(3),ATX(1))=""
- SET ^(-ATX(1))=""
- +2 KILL ATX
- +3 QUIT
- ATD ;KILL FOR ^LRO(69,"AT" CROSS REFERENCE
- +1 IF DA
- IF DA(1)
- IF DA(2)
- IF $DATA(^LRO(69,DA(2),1,DA(1),2,DA,0))
- SET ATX=+^LRO(69,DA(2),1,DA(1),0)
- SET ATX(1)=DA(2)
- SET ATX(2)=+^(2,DA,0)
- +2 IF $DATA(^LRO(69,DA(2),1,DA(1),4,1,0))
- SET ATX(3)=+^LRO(69,DA(2),1,DA(1),4,1,0)
- IF ATX
- IF ATX(1)
- IF ATX(2)
- IF ATX(3)
- KILL ^LRO(69,"AT",ATX,ATX(2),ATX(3),ATX(1)),^(-ATX(1))
- +3 KILL ATX
- +4 QUIT
- AC ;BUILD "AC" CROSS-REFERENCE IN FILE 68
- +1 SET LRTN=0
- SET LRTEST=""
- +2 FOR I=0:0
- SET LRTN=$ORDER(^LRO(68,DA(2),1,DA(1),1,DA,4,LRTN))
- IF LRTN<1
- QUIT
- SET LRGTN=LRTN
- IF LRTEST'=""
- SET LRTEST=LRTEST_"^"_LRTN
- IF LRTEST=""
- SET LRTEST=LRTN
- +3 DO ^LREXPD
- IF '$DATA(LRORD)
- GOTO SET
- FOR I=1:1:LRTSTS
- SET LRGTN=LRORD(I)
- DO SET
- END KILL LRTEST,LRTSTS,^TMP("LR",$JOB),LRTN,LRGTN
- QUIT
- SET IF $DATA(LRGTN)
- IF $DATA(^LAB(60,LRGTN,.2))
- IF $PIECE(^LAB(60,LRGTN,0),U,3)'["N"
- IF $PIECE(^(0),U,3)'["I"
- SET ^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$PIECE(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2))=""
- QUIT
- +1 IF '$DATA(LRORD)
- GOTO END
- QUIT
- AC1 ;KILL "AC" CROSS-REFERENCE IN FILE 68
- +1 SET LRTN=0
- SET LRTEST=""
- +2 FOR I=0:0
- SET LRTN=$ORDER(^LRO(68,DA(2),1,DA(1),1,DA,4,LRTN))
- IF LRTN<1
- QUIT
- SET LRGTN=LRTN
- IF LRTEST'=""
- SET LRTEST=LRTEST_"^"_LRTN
- IF LRTEST=""
- SET LRTEST=LRTN
- +3 DO ^LREXPD
- IF '$DATA(LRORD)
- GOTO KILL
- FOR I=1:1:LRTSTS
- SET LRGTN=LRORD(I)
- DO KILL
- +4 KILL LRTEST,LRTSTS,^TMP("LR",$JOB),LRTN,LRGTN
- QUIT
- KILL IF $DATA(^LAB(60,LRGTN,.2))
- IF $DATA(^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$PIECE(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2)))
- KILL ^LRO(68,"AC",+^LRO(68,DA(2),1,DA(1),1,DA,0),$PIECE(^LRO(68,DA(2),1,DA(1),1,DA,3),U,5),+^LAB(60,LRGTN,.2))
- +1 QUIT
- A65 ;Rebuild "A" x-ref in file 65 for 65.15,.08 for Re-index utility
- +1 FOR LR=0:0
- SET LR=$ORDER(^LRD(65,DA,15,LR))
- IF 'LR
- QUIT
- SET LR(1)=$PIECE(^(LR,0),"^",8)
- IF LR(1)
- SET ^LRD(65,"A",LR(1),DA)=""
- +2 QUIT
- A658 ;build "A" x-ref in file 65 for 65,.05 for Re-index utility
- +1 SET LR=$PIECE(^LRD(65,DA(1),0),"^",5)
- IF LR
- SET ^LRD(65,"A",LR,DA(1))=""
- QUIT
- C ;build "C" x-ref in file 69
- +1 IF '$DATA(DIU(0))
- SET ^LRO(69,"C",+X,DA(1),DA)=""
- QUIT
- +2 IF $DATA(DIU(0))
- IF $DATA(^LRO(69,DA(1),1,DA,2))
- SET ^LRO(69,"C",+X,DA(1),DA)=""
- +3 QUIT
- A6599 ;Rebuild Archive "A" x-ref in file 65.9999 for 65.999915,.08 for Re-index utility
- +1 FOR LR=0:0
- SET LR=$ORDER(^LRD(65.9999,DA,15,LR))
- IF 'LR
- QUIT
- SET LR(1)=$PIECE(^(LR,0),"^",8)
- IF LR(1)
- SET ^LRD(65.9999,"A",LR(1),DA)=""
- +2 QUIT
- A65899 ;build Archive "A" x-ref in file 65.9999 for 65.9999,.05 for Re-index utility
- +1 SET LR=$PIECE(^LRD(65.9999,DA(1),0),"^",5)
- IF LR
- SET ^LRD(65.9999,"A",LR,DA(1))=""
- QUIT
