- XBRSRCH5 ; IHS/ADC/GTH - SEARCH MISCELLANEOUS 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 MISCELLANEOUS ^DD ENTRIES that call routines.",!
- S U="^",DIC="^DIC(",DIC(0)="AEMQ"
- D ^DIC
- I Y<0 D EOJ Q
- S XBSM("FILE")=+Y
- KILL ^UTILITY("XBRSRCH",$J)
- S XBSM("MASTER")=""
- EN ;EP - ENTRY POINT FOR CALLING ROUTINES
- S XBSM("LAST FILE")=""
- D FILE
- D:$D(XBSM("MASTER")) LIST
- D EOJ
- Q
- ;
- FILE ; CHECK ONE FILE
- I $D(^DD(XBSM("FILE"),0,"ACT")) S X=^("ACT"),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2
- I $D(^DD(XBSM("FILE"),0,"SCR")) S X=^("SCR"),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2
- I $D(^DD(XBSM("FILE"),0,"ID")) S XBSM("FIELD")="" F XBSM("L")=0:0 S XBSM("FIELD")=$O(^DD(XBSM("FILE"),0,"ID",XBSM("FIELD"))) Q:XBSM("FIELD")="" S X=^(XBSM("FIELD")),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2
- I $D(^DD(XBSM("FILE"),.01,7.5)) S X=^(7.5),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2
- I $D(^DD(XBSM("FILE"),.01,"DEL")) S XBSM("SUB")="DEL" D FIELD
- I $D(^DD(XBSM("FILE"),.01,"LAYGO")) S XBSM("SUB")="LAYGO" D FIELD
- Q
- ;
- FIELD ; CHECK ONE FIELD
- S XBSM("FIELD")=""
- F XBSM("L")=0:0 S XBSM("FIELD")=$O(^DD(XBSM("FILE"),.01,XBSM("SUB"),XBSM("FIELD"))) Q:XBSM("FIELD")="" D FIELD2
- Q
- ;
- FIELD2 ;
- S XBSM("NODE")=""
- F XBSM("L")=0:0 S XBSM("NODE")=$O(^DD(XBSM("FILE"),.01,XBSM("SUB"),XBSM("FIELD"),XBSM("NODE"))) Q:XBSM("NODE")="" S X=^(XBSM("NODE")),XBSM("GR")=$$MSMZR^ZIBNSSV D FILE2
- Q
- ;
- FILE2 ;
- Q:X'[U
- S XBRSRCH("FOUND")=0,XBSM("COUNT")=$L(X,U)
- F XBSM("I")=XBSM("COUNT"):-1:2 S Y=$P(X,U,XBSM("I")) D ^XBRSRCH1
- D:XBRSRCH("FOUND") WRITE
- Q
- ;
- WRITE ;
- I $D(XBRSRCH("NO DETAIL")) W "." Q
- I XBSM("FILE")'=XBSM("LAST FILE") S XBSM("LAST FILE")=XBSM("FILE") W !
- W !,XBSM("GR"),?30,$E(X,1,49)
- F XBSM("L")=0:0 S X=$E(X,50,999) Q:X="" W !?30,$E(X,1,49)
- Q
- ;
- LIST ; LIST ROUTINE NAMES
- Q:'$D(^UTILITY("XBRSRCH",$J))
- W !!,"Sorted list of routines found:",!
- S X=""
- F XBSM("L")=0:0 S X=$O(^UTILITY("XBRSRCH",$J,X)) Q:X="" W !,"^",X
- KILL ^UTILITY("XBRSRCH",$J)
- W !
- Q
- ;
- EOJ ;
- KILL DIC
- KILL X,X0,X1,X2,Y,YY
- KILL:$D(XBSM("MASTER")) XBRSRCH
- KILL XBSM,XBSMFL
- Q
- ;
- XBRSRCH5 ; IHS/ADC/GTH - SEARCH MISCELLANEOUS 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 MISCELLANEOUS ^DD ENTRIES 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 XBSM("FILE")=+Y
- +6 KILL ^UTILITY("XBRSRCH",$JOB)
- +7 SET XBSM("MASTER")=""
- EN ;EP - ENTRY POINT FOR CALLING ROUTINES
- +1 SET XBSM("LAST FILE")=""
- +2 DO FILE
- +3 IF $DATA(XBSM("MASTER"))
- DO LIST
- +4 DO EOJ
- +5 QUIT
- +6 ;
- FILE ; CHECK ONE FILE
- +1 IF $DATA(^DD(XBSM("FILE"),0,"ACT"))
- SET X=^("ACT")
- SET XBSM("GR")=$$MSMZR^ZIBNSSV
- DO FILE2
- +2 IF $DATA(^DD(XBSM("FILE"),0,"SCR"))
- SET X=^("SCR")
- SET XBSM("GR")=$$MSMZR^ZIBNSSV
- DO FILE2
- +3 IF $DATA(^DD(XBSM("FILE"),0,"ID"))
- SET XBSM("FIELD")=""
- FOR XBSM("L")=0:0
- SET XBSM("FIELD")=$ORDER(^DD(XBSM("FILE"),0,"ID",XBSM("FIELD")))
- IF XBSM("FIELD")=""
- QUIT
- SET X=^(XBSM("FIELD"))
- SET XBSM("GR")=$$MSMZR^ZIBNSSV
- DO FILE2
- +4 IF $DATA(^DD(XBSM("FILE"),.01,7.5))
- SET X=^(7.5)
- SET XBSM("GR")=$$MSMZR^ZIBNSSV
- DO FILE2
- +5 IF $DATA(^DD(XBSM("FILE"),.01,"DEL"))
- SET XBSM("SUB")="DEL"
- DO FIELD
- +6 IF $DATA(^DD(XBSM("FILE"),.01,"LAYGO"))
- SET XBSM("SUB")="LAYGO"
- DO FIELD
- +7 QUIT
- +8 ;
- FIELD ; CHECK ONE FIELD
- +1 SET XBSM("FIELD")=""
- +2 FOR XBSM("L")=0:0
- SET XBSM("FIELD")=$ORDER(^DD(XBSM("FILE"),.01,XBSM("SUB"),XBSM("FIELD")))
- IF XBSM("FIELD")=""
- QUIT
- DO FIELD2
- +3 QUIT
- +4 ;
- FIELD2 ;
- +1 SET XBSM("NODE")=""
- +2 FOR XBSM("L")=0:0
- SET XBSM("NODE")=$ORDER(^DD(XBSM("FILE"),.01,XBSM("SUB"),XBSM("FIELD"),XBSM("NODE")))
- IF XBSM("NODE")=""
- QUIT
- SET X=^(XBSM("NODE"))
- SET XBSM("GR")=$$MSMZR^ZIBNSSV
- DO FILE2
- +3 QUIT
- +4 ;
- FILE2 ;
- +1 IF X'[U
- QUIT
- +2 SET XBRSRCH("FOUND")=0
- SET XBSM("COUNT")=$LENGTH(X,U)
- +3 FOR XBSM("I")=XBSM("COUNT"):-1:2
- SET Y=$PIECE(X,U,XBSM("I"))
- DO ^XBRSRCH1
- +4 IF XBRSRCH("FOUND")
- DO WRITE
- +5 QUIT
- +6 ;
- WRITE ;
- +1 IF $DATA(XBRSRCH("NO DETAIL"))
- WRITE "."
- QUIT
- +2 IF XBSM("FILE")'=XBSM("LAST FILE")
- SET XBSM("LAST FILE")=XBSM("FILE")
- WRITE !
- +3 WRITE !,XBSM("GR"),?30,$EXTRACT(X,1,49)
- +4 FOR XBSM("L")=0:0
- SET X=$EXTRACT(X,50,999)
- IF X=""
- QUIT
- WRITE !?30,$EXTRACT(X,1,49)
- +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 XBSM("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
- +2 KILL X,X0,X1,X2,Y,YY
- +3 IF $DATA(XBSM("MASTER"))
- KILL XBRSRCH
- +4 KILL XBSM,XBSMFL
- +5 QUIT
- +6 ;
