- AURSRCH4 ; SEARCH XREFS FOR ROUTINES [ 04/06/88 8:39 AM ]
- ; PREVIOUSLY NAMED AUSXREF
- ;
- W !!,"This routine searches a file for XREFS that call routines.",!
- S U="^"
- S DIC="^DIC(",DIC(0)="AEMQ" D ^DIC
- I Y<0 D EOJ Q
- S AUSXREF("FILE")=+Y
- K ^UTILITY("AURSRCH",$J)
- S AUSXREF("MASTER")=""
- EN ; ENTRY POINT FOR CALLING ROUTINES
- S AUSXREF("LAST FILE")=""
- D SBTRACE
- D:$D(AUSXREF("MASTER")) LIST
- D EOJ
- Q
- SBTRACE ; CHECK ALL SUB-FILES
- K AUSXREFF S AUSXREF("CNT")=1,AUSXREFF(AUSXREF("CNT"))=AUSXREF("FILE")
- F AUSXREF("L")=0:0 S AUSXREF("LCTL")=$O(AUSXREFF("")) Q:AUSXREF("LCTL")="" S AUSXREF("FILE")=AUSXREFF(AUSXREF("LCTL")) D SBTRACE2 S AUSXREF("LCTL")=$O(AUSXREFF("")) D FILE K AUSXREFF(AUSXREF("LCTL"))
- Q
- SBTRACE2 ;
- S AUSXREF("LCTL")=0 F AUSXREF("L")=0:0 S AUSXREF("LCTL")=$O(^DD(AUSXREF("FILE"),"SB",AUSXREF("LCTL"))) Q:AUSXREF("LCTL")="" S AUSXREF("CNT")=AUSXREF("CNT")+1,AUSXREFF(AUSXREF("CNT"))=AUSXREF("LCTL")
- Q
- ;
- FILE ; CHECK ONE FILE OR SUB-FILE
- S AUSXREF("FIELD")=0
- F AUSXREF("L")=0:0 S AUSXREF("FIELD")=$O(^DD(AUSXREF("FILE"),AUSXREF("FIELD"))) Q:AUSXREF("FIELD")'=+AUSXREF("FIELD") D FIELD
- Q
- ;
- FIELD ; CHECK FIELD'S XREFS
- Q:'$D(^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1))
- S AUSXREF("XREF")=0 F AUSXREF("L")=0:0 S AUSXREF("XREF")=$O(^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1,AUSXREF("XREF"))) Q:AUSXREF("XREF")'=+AUSXREF("XREF") D CHKXREF
- Q
- ;
- CHKXREF ; CHECK ONE XREF
- S X=^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1,AUSXREF("XREF"),1)
- D CHKSK
- S X=^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1,AUSXREF("XREF"),2)
- D CHKSK
- Q
- ;
- CHKSK ; CHECK XREF SET/KILL
- Q:X'[U
- S AURSRCH("FOUND")=0,AUSXREF("COUNT")=$L(X,U)
- F AUSXREF("I")=AUSXREF("COUNT"):-1:2 S Y=$P(X,U,AUSXREF("I")) D ^AURSRCH1
- D:AURSRCH("FOUND") WRITE
- Q
- ;
- WRITE ;
- I $D(AURSRCH("NO DETAIL")) W "." Q
- I AUSXREF("FILE")'=AUSXREF("LAST FILE") S AUSXREF("LAST FILE")=AUSXREF("FILE") W !
- W !,AUSXREF("FILE"),",",AUSXREF("FIELD"),?20,$E(X,1,59)
- F AUSXREF("L")=0:0 S X=$E(X,60,999) Q:X="" W !,?20,$E(X,1,59)
- Q
- ;
- LIST ; LIST ROUTINE NAMES
- Q:'$D(^UTILITY("AURSRCH",$J))
- W !!,"Sorted list of routines found:",!
- S X="" F AUSXREF("L")=0:0 S X=$O(^UTILITY("AURSRCH",$J,X)) Q:X="" W !,"^",X
- K ^UTILITY("AURSRCH",$J)
- W !
- Q
- ;
- EOJ ;
- K DIC
- K X,X0,X1,X2,Y,YY
- K:$D(AUSXREF("MASTER")) AURSRCH
- K AUSXREF,AUSXREFF
- Q
- AURSRCH4 ; SEARCH XREFS FOR ROUTINES [ 04/06/88 8:39 AM ]
- +1 ; PREVIOUSLY NAMED AUSXREF
- +2 ;
- +3 WRITE !!,"This routine searches a file for XREFS that call routines.",!
- +4 SET U="^"
- +5 SET DIC="^DIC("
- SET DIC(0)="AEMQ"
- DO ^DIC
- +6 IF Y<0
- DO EOJ
- QUIT
- +7 SET AUSXREF("FILE")=+Y
- +8 KILL ^UTILITY("AURSRCH",$JOB)
- +9 SET AUSXREF("MASTER")=""
- EN ; ENTRY POINT FOR CALLING ROUTINES
- +1 SET AUSXREF("LAST FILE")=""
- +2 DO SBTRACE
- +3 IF $DATA(AUSXREF("MASTER"))
- DO LIST
- +4 DO EOJ
- +5 QUIT
- SBTRACE ; CHECK ALL SUB-FILES
- +1 KILL AUSXREFF
- SET AUSXREF("CNT")=1
- SET AUSXREFF(AUSXREF("CNT"))=AUSXREF("FILE")
- +2 FOR AUSXREF("L")=0:0
- SET AUSXREF("LCTL")=$ORDER(AUSXREFF(""))
- IF AUSXREF("LCTL")=""
- QUIT
- SET AUSXREF("FILE")=AUSXREFF(AUSXREF("LCTL"))
- DO SBTRACE2
- SET AUSXREF("LCTL")=$ORDER(AUSXREFF(""))
- DO FILE
- KILL AUSXREFF(AUSXREF("LCTL"))
- +3 QUIT
- SBTRACE2 ;
- +1 SET AUSXREF("LCTL")=0
- FOR AUSXREF("L")=0:0
- SET AUSXREF("LCTL")=$ORDER(^DD(AUSXREF("FILE"),"SB",AUSXREF("LCTL")))
- IF AUSXREF("LCTL")=""
- QUIT
- SET AUSXREF("CNT")=AUSXREF("CNT")+1
- SET AUSXREFF(AUSXREF("CNT"))=AUSXREF("LCTL")
- +2 QUIT
- +3 ;
- FILE ; CHECK ONE FILE OR SUB-FILE
- +1 SET AUSXREF("FIELD")=0
- +2 FOR AUSXREF("L")=0:0
- SET AUSXREF("FIELD")=$ORDER(^DD(AUSXREF("FILE"),AUSXREF("FIELD")))
- IF AUSXREF("FIELD")'=+AUSXREF("FIELD")
- QUIT
- DO FIELD
- +3 QUIT
- +4 ;
- FIELD ; CHECK FIELD'S XREFS
- +1 IF '$DATA(^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1))
- QUIT
- +2 SET AUSXREF("XREF")=0
- FOR AUSXREF("L")=0:0
- SET AUSXREF("XREF")=$ORDER(^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1,AUSXREF("XREF")))
- IF AUSXREF("XREF")'=+AUSXREF("XREF")
- QUIT
- DO CHKXREF
- +3 QUIT
- +4 ;
- CHKXREF ; CHECK ONE XREF
- +1 SET X=^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1,AUSXREF("XREF"),1)
- +2 DO CHKSK
- +3 SET X=^DD(AUSXREF("FILE"),AUSXREF("FIELD"),1,AUSXREF("XREF"),2)
- +4 DO CHKSK
- +5 QUIT
- +6 ;
- CHKSK ; CHECK XREF SET/KILL
- +1 IF X'[U
- QUIT
- +2 SET AURSRCH("FOUND")=0
- SET AUSXREF("COUNT")=$LENGTH(X,U)
- +3 FOR AUSXREF("I")=AUSXREF("COUNT"):-1:2
- SET Y=$PIECE(X,U,AUSXREF("I"))
- DO ^AURSRCH1
- +4 IF AURSRCH("FOUND")
- DO WRITE
- +5 QUIT
- +6 ;
- WRITE ;
- +1 IF $DATA(AURSRCH("NO DETAIL"))
- WRITE "."
- QUIT
- +2 IF AUSXREF("FILE")'=AUSXREF("LAST FILE")
- SET AUSXREF("LAST FILE")=AUSXREF("FILE")
- WRITE !
- +3 WRITE !,AUSXREF("FILE"),",",AUSXREF("FIELD"),?20,$EXTRACT(X,1,59)
- +4 FOR AUSXREF("L")=0:0
- SET X=$EXTRACT(X,60,999)
- IF X=""
- QUIT
- WRITE !,?20,$EXTRACT(X,1,59)
- +5 QUIT
- +6 ;
- LIST ; LIST ROUTINE NAMES
- +1 IF '$DATA(^UTILITY("AURSRCH",$JOB))
- QUIT
- +2 WRITE !!,"Sorted list of routines found:",!
- +3 SET X=""
- FOR AUSXREF("L")=0:0
- SET X=$ORDER(^UTILITY("AURSRCH",$JOB,X))
- IF X=""
- QUIT
- WRITE !,"^",X
- +4 KILL ^UTILITY("AURSRCH",$JOB)
- +5 WRITE !
- +6 QUIT
- +7 ;
- EOJ ;
- +1 KILL DIC
- +2 KILL X,X0,X1,X2,Y,YY
- +3 IF $DATA(AUSXREF("MASTER"))
- KILL AURSRCH
- +4 KILL AUSXREF,AUSXREFF
- +5 QUIT
