- XBRSRCH4 ; IHS/ADC/GTH - SEARCH XREFS FOR ROUTINES ; [ 02/07/97 3:02 PM ]
- ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- ;
- ; Part of XBRSRCH
- ;
- START ;
- W !!,"This routine searches a file for XREFS that call routines.",!
- S U="^",DIC="^DIC(",DIC(0)="AEMQ"
- D ^DIC
- I Y<0 D EOJ Q
- S XBSXREF("FILE")=+Y
- KILL ^UTILITY("XBRSRCH",$J)
- S XBSXREF("MASTER")=""
- EN ;EP - ENTRY POINT FOR CALLING ROUTINES
- S XBSXREF("LAST FILE")=""
- D SBTRACE
- D:$D(XBSXREF("MASTER")) LIST
- D EOJ
- Q
- ;
- SBTRACE ; CHECK ALL SUB-FILES
- KILL XBSXREFF
- S XBSXREF("CNT")=1,XBSXREFF(XBSXREF("CNT"))=XBSXREF("FILE")
- F XBSXREF("L")=0:0 S XBSXREF("LCTL")=$O(XBSXREFF("")) Q:XBSXREF("LCTL")="" S XBSXREF("FILE")=XBSXREFF(XBSXREF("LCTL")) D SBTRACE2 S XBSXREF("LCTL")=$O(XBSXREFF("")) D FILE KILL XBSXREFF(XBSXREF("LCTL"))
- Q
- ;
- SBTRACE2 ;
- S XBSXREF("LCTL")=0
- F XBSXREF("L")=0:0 S XBSXREF("LCTL")=$O(^DD(XBSXREF("FILE"),"SB",XBSXREF("LCTL"))) Q:XBSXREF("LCTL")="" S XBSXREF("CNT")=XBSXREF("CNT")+1,XBSXREFF(XBSXREF("CNT"))=XBSXREF("LCTL")
- Q
- ;
- FILE ; CHECK ONE FILE OR SUB-FILE
- S XBSXREF("FIELD")=0
- F XBSXREF("L")=0:0 S XBSXREF("FIELD")=$O(^DD(XBSXREF("FILE"),XBSXREF("FIELD"))) Q:XBSXREF("FIELD")'=+XBSXREF("FIELD") D FIELD
- Q
- ;
- FIELD ; CHECK FIELD'S XREFS
- Q:'$D(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1))
- S XBSXREF("XREF")=0
- F XBSXREF("L")=0:0 S XBSXREF("XREF")=$O(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"))) Q:XBSXREF("XREF")'=+XBSXREF("XREF") D CHKXREF
- Q
- ;
- CHKXREF ; CHECK ONE XREF
- S X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),1)
- D CHKSK
- S X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),2)
- D CHKSK
- Q
- ;
- CHKSK ; CHECK XREF SET/KILL
- Q:X'[U
- S XBRSRCH("FOUND")=0,XBSXREF("COUNT")=$L(X,U)
- F XBSXREF("I")=XBSXREF("COUNT"):-1:2 S Y=$P(X,U,XBSXREF("I")) D ^XBRSRCH1
- D:XBRSRCH("FOUND") WRITE
- Q
- ;
- WRITE ;
- I $D(XBRSRCH("NO DETAIL")) W "." Q
- I XBSXREF("FILE")'=XBSXREF("LAST FILE") S XBSXREF("LAST FILE")=XBSXREF("FILE") W !
- W !,XBSXREF("FILE"),",",XBSXREF("FIELD"),?20,$E(X,1,59)
- F XBSXREF("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("XBRSRCH",$J))
- W !!,"Sorted list of routines found:",!
- S X=""
- F XBSXREF("L")=0:0 S X=$O(^UTILITY("XBRSRCH",$J,X)) Q:X="" W !,"^",X
- KILL ^UTILITY("XBRSRCH",$J)
- W !
- Q
- ;
- EOJ ;
- KILL DIC,X,X0,X1,X2,Y,YY
- K:$D(XBSXREF("MASTER")) XBRSRCH
- KILL XBSXREF,XBSXREFF
- Q
- ;
- XBRSRCH4 ; IHS/ADC/GTH - SEARCH XREFS FOR ROUTINES ; [ 02/07/97 3:02 PM ]
- +1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- +2 ;
- +3 ; Part of XBRSRCH
- +4 ;
- START ;
- +1 WRITE !!,"This routine searches a file for XREFS that call routines.",!
- +2 SET U="^"
- SET DIC="^DIC("
- SET DIC(0)="AEMQ"
- +3 DO ^DIC
- +4 IF Y<0
- DO EOJ
- QUIT
- +5 SET XBSXREF("FILE")=+Y
- +6 KILL ^UTILITY("XBRSRCH",$JOB)
- +7 SET XBSXREF("MASTER")=""
- EN ;EP - ENTRY POINT FOR CALLING ROUTINES
- +1 SET XBSXREF("LAST FILE")=""
- +2 DO SBTRACE
- +3 IF $DATA(XBSXREF("MASTER"))
- DO LIST
- +4 DO EOJ
- +5 QUIT
- +6 ;
- SBTRACE ; CHECK ALL SUB-FILES
- +1 KILL XBSXREFF
- +2 SET XBSXREF("CNT")=1
- SET XBSXREFF(XBSXREF("CNT"))=XBSXREF("FILE")
- +3 FOR XBSXREF("L")=0:0
- SET XBSXREF("LCTL")=$ORDER(XBSXREFF(""))
- IF XBSXREF("LCTL")=""
- QUIT
- SET XBSXREF("FILE")=XBSXREFF(XBSXREF("LCTL"))
- DO SBTRACE2
- SET XBSXREF("LCTL")=$ORDER(XBSXREFF(""))
- DO FILE
- KILL XBSXREFF(XBSXREF("LCTL"))
- +4 QUIT
- +5 ;
- SBTRACE2 ;
- +1 SET XBSXREF("LCTL")=0
- +2 FOR XBSXREF("L")=0:0
- SET XBSXREF("LCTL")=$ORDER(^DD(XBSXREF("FILE"),"SB",XBSXREF("LCTL")))
- IF XBSXREF("LCTL")=""
- QUIT
- SET XBSXREF("CNT")=XBSXREF("CNT")+1
- SET XBSXREFF(XBSXREF("CNT"))=XBSXREF("LCTL")
- +3 QUIT
- +4 ;
- FILE ; CHECK ONE FILE OR SUB-FILE
- +1 SET XBSXREF("FIELD")=0
- +2 FOR XBSXREF("L")=0:0
- SET XBSXREF("FIELD")=$ORDER(^DD(XBSXREF("FILE"),XBSXREF("FIELD")))
- IF XBSXREF("FIELD")'=+XBSXREF("FIELD")
- QUIT
- DO FIELD
- +3 QUIT
- +4 ;
- FIELD ; CHECK FIELD'S XREFS
- +1 IF '$DATA(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1))
- QUIT
- +2 SET XBSXREF("XREF")=0
- +3 FOR XBSXREF("L")=0:0
- SET XBSXREF("XREF")=$ORDER(^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF")))
- IF XBSXREF("XREF")'=+XBSXREF("XREF")
- QUIT
- DO CHKXREF
- +4 QUIT
- +5 ;
- CHKXREF ; CHECK ONE XREF
- +1 SET X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),1)
- +2 DO CHKSK
- +3 SET X=^DD(XBSXREF("FILE"),XBSXREF("FIELD"),1,XBSXREF("XREF"),2)
- +4 DO CHKSK
- +5 QUIT
- +6 ;
- CHKSK ; CHECK XREF SET/KILL
- +1 IF X'[U
- QUIT
- +2 SET XBRSRCH("FOUND")=0
- SET XBSXREF("COUNT")=$LENGTH(X,U)
- +3 FOR XBSXREF("I")=XBSXREF("COUNT"):-1:2
- SET Y=$PIECE(X,U,XBSXREF("I"))
- DO ^XBRSRCH1
- +4 IF XBRSRCH("FOUND")
- DO WRITE
- +5 QUIT
- +6 ;
- WRITE ;
- +1 IF $DATA(XBRSRCH("NO DETAIL"))
- WRITE "."
- QUIT
- +2 IF XBSXREF("FILE")'=XBSXREF("LAST FILE")
- SET XBSXREF("LAST FILE")=XBSXREF("FILE")
- WRITE !
- +3 WRITE !,XBSXREF("FILE"),",",XBSXREF("FIELD"),?20,$EXTRACT(X,1,59)
- +4 FOR XBSXREF("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("XBRSRCH",$JOB))
- QUIT
- +2 WRITE !!,"Sorted list of routines found:",!
- +3 SET X=""
- +4 FOR XBSXREF("L")=0:0
- SET X=$ORDER(^UTILITY("XBRSRCH",$JOB,X))
- IF X=""
- QUIT
- WRITE !,"^",X
- +5 KILL ^UTILITY("XBRSRCH",$JOB)
- +6 WRITE !
- +7 QUIT
- +8 ;
- EOJ ;
- +1 KILL DIC,X,X0,X1,X2,Y,YY
- +2 IF $DATA(XBSXREF("MASTER"))
- KILL XBRSRCH
- +3 KILL XBSXREF,XBSXREFF
- +4 QUIT
- +5 ;
