- XBRSRCH2 ; IHS/ADC/GTH - SEARCH INPUT TRANSFORM 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 INPUT TRANSFORMS that call routines.",!
- S U="^",DIC="^DIC(",DIC(0)="AEMQ"
- D ^DIC
- I Y<0 D EOJ Q
- S XBSINP("FILE")=+Y
- KILL ^UTILITY("XBRSRCH",$J)
- S XBSINP("MASTER")=""
- EN ;EP - Search for routines in Input Transforms.
- S XBSINP("LAST FILE")=""
- D SBTRACE
- D:$D(XBSINP("MASTER")) LIST
- D EOJ
- Q
- ;
- SBTRACE ; CHECK ALL SUB-FILES
- KILL XBSINPFL
- S XBSINP("CNT")=1,XBSINPFL(XBSINP("CNT"))=XBSINP("FILE")
- F XBSINP("L")=0:0 S XBSINP("LCTL")=$O(XBSINPFL("")) Q:XBSINP("LCTL")="" S XBSINP("FILE")=XBSINPFL(XBSINP("LCTL")) D SBTRACE2 S XBSINP("LCTL")=$O(XBSINPFL("")) D FILE KILL XBSINPFL(XBSINP("LCTL"))
- Q
- ;
- SBTRACE2 ;
- S XBSINP("LCTL")=0
- F XBSINP("L")=0:0 S XBSINP("LCTL")=$O(^DD(XBSINP("FILE"),"SB",XBSINP("LCTL"))) Q:XBSINP("LCTL")="" S XBSINP("CNT")=XBSINP("CNT")+1,XBSINPFL(XBSINP("CNT"))=XBSINP("LCTL")
- Q
- ;
- FILE ; CHECK ONE FILE OR SUB-FILE
- S XBSINP("FIELD")=0
- F XBSINP("L")=0:0 S XBSINP("FIELD")=$O(^DD(XBSINP("FILE"),XBSINP("FIELD"))) Q:XBSINP("FIELD")'=+XBSINP("FIELD") S X=$P(^(XBSINP("FIELD"),0),U,5,99) D:X[U FIELD
- Q
- ;
- FIELD ; Check Field's Input Transform.
- S XBRSRCH("FOUND")=0,XBSINP("COUNT")=$L(X,U)
- F XBSINP("I")=XBSINP("COUNT"):-1:2 S Y=$P(X,U,XBSINP("I")) D ^XBRSRCH1
- D:XBRSRCH("FOUND") WRITE
- Q
- ;
- WRITE ;
- I $D(XBRSRCH("NO DETAIL")) W "." Q
- I XBSINP("FILE")'=XBSINP("LAST FILE") S XBSINP("LAST FILE")=XBSINP("FILE") W !
- W !,XBSINP("FILE"),",",XBSINP("FIELD"),?20,$E(X,1,59)
- F XBSINP("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 XBSINP("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
- KILL:$D(XBSINP("MASTER")) XBRSRCH
- KILL XBSINP,XBSINPFL
- Q
- ;
- XBRSRCH2 ; IHS/ADC/GTH - SEARCH INPUT TRANSFORM 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 INPUT TRANSFORMS 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 XBSINP("FILE")=+Y
- +6 KILL ^UTILITY("XBRSRCH",$JOB)
- +7 SET XBSINP("MASTER")=""
- EN ;EP - Search for routines in Input Transforms.
- +1 SET XBSINP("LAST FILE")=""
- +2 DO SBTRACE
- +3 IF $DATA(XBSINP("MASTER"))
- DO LIST
- +4 DO EOJ
- +5 QUIT
- +6 ;
- SBTRACE ; CHECK ALL SUB-FILES
- +1 KILL XBSINPFL
- +2 SET XBSINP("CNT")=1
- SET XBSINPFL(XBSINP("CNT"))=XBSINP("FILE")
- +3 FOR XBSINP("L")=0:0
- SET XBSINP("LCTL")=$ORDER(XBSINPFL(""))
- IF XBSINP("LCTL")=""
- QUIT
- SET XBSINP("FILE")=XBSINPFL(XBSINP("LCTL"))
- DO SBTRACE2
- SET XBSINP("LCTL")=$ORDER(XBSINPFL(""))
- DO FILE
- KILL XBSINPFL(XBSINP("LCTL"))
- +4 QUIT
- +5 ;
- SBTRACE2 ;
- +1 SET XBSINP("LCTL")=0
- +2 FOR XBSINP("L")=0:0
- SET XBSINP("LCTL")=$ORDER(^DD(XBSINP("FILE"),"SB",XBSINP("LCTL")))
- IF XBSINP("LCTL")=""
- QUIT
- SET XBSINP("CNT")=XBSINP("CNT")+1
- SET XBSINPFL(XBSINP("CNT"))=XBSINP("LCTL")
- +3 QUIT
- +4 ;
- FILE ; CHECK ONE FILE OR SUB-FILE
- +1 SET XBSINP("FIELD")=0
- +2 FOR XBSINP("L")=0:0
- SET XBSINP("FIELD")=$ORDER(^DD(XBSINP("FILE"),XBSINP("FIELD")))
- IF XBSINP("FIELD")'=+XBSINP("FIELD")
- QUIT
- SET X=$PIECE(^(XBSINP("FIELD"),0),U,5,99)
- IF X[U
- DO FIELD
- +3 QUIT
- +4 ;
- FIELD ; Check Field's Input Transform.
- +1 SET XBRSRCH("FOUND")=0
- SET XBSINP("COUNT")=$LENGTH(X,U)
- +2 FOR XBSINP("I")=XBSINP("COUNT"):-1:2
- SET Y=$PIECE(X,U,XBSINP("I"))
- DO ^XBRSRCH1
- +3 IF XBRSRCH("FOUND")
- DO WRITE
- +4 QUIT
- +5 ;
- WRITE ;
- +1 IF $DATA(XBRSRCH("NO DETAIL"))
- WRITE "."
- QUIT
- +2 IF XBSINP("FILE")'=XBSINP("LAST FILE")
- SET XBSINP("LAST FILE")=XBSINP("FILE")
- WRITE !
- +3 WRITE !,XBSINP("FILE"),",",XBSINP("FIELD"),?20,$EXTRACT(X,1,59)
- +4 FOR XBSINP("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 XBSINP("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(XBSINP("MASTER"))
- KILL XBRSRCH
- +3 KILL XBSINP,XBSINPFL
- +4 QUIT
- +5 ;