XBVCH ; IHS/ADC/GTH - CHANGE VARIABLE NAMES ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; Thanks to Paul Wesley, DSD/OIRM, for the original routine.
;
I '$D(IOST(0)) D HOME^%ZIS
S XBJ=$J
D EXIT^XBVCH
S XBJ=$J
S X="IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINORM;IOAWM0;IOAWM1"
D ENDR^%ZISS
S XBD(0)=IOUON,XBD(1)=IOUOFF,XBD(2)=IORVON,XBD(3)=IORVOFF,XBD(4)=IORVON,XBD(5)=IORVOFF,XBD(6)=IOAWM0,XBD(7)=IOAWM1,XBXY=IOXY
D KILL^%ZISS
S XBP=" #&'()*+,'-/<=>@\_?;:[]!"""
S XBS=" #&'()*+,'-/<=>@\_?;:[]!"""
KILL DIR
S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you have a %INDEX Summary in a Host File to work with ? "
D ^DIR
KILL DIR
D:Y=1 ^XBVCHV
START ;
KILL XBV0,XBV1,XBV2
V0 ;
KILL DIR
S DIR(0)="F:0,8",DIR("A")="Old Variable ? or '^' to exit "
I $G(XBFILE) S DIR("A")=DIR("A")_" or '|' to see variables "
D ^DIR
KILL DIR
G:(Y="^") EXIT
I Y["|",$G(XBFILE) S XBV="" D SHOVAR G V0
I $G(XBFILE),'$D(^XBVROU(XBJ,"V",Y)) W *7 G V0
S XBV0=Y
V1 ;
KILL DIR
S DIR(0)="F:0,8",DIR("A")="New Variable ? or '^' to exit "
D ^DIR
KILL DIR
G:(Y="^") V0
S XBV1=Y
I $G(XBFILE),$D(^XBVROU(XBJ,"V",XBV1)) W *7,!!,"FYI >> ",XBV1," << Already Exits" KILL DIR S DIR(0)="E" D ^DIR I Y'>0 G V1
I $D(^XBVROU(XBJ,"NV",XBV1)) W *7,!!,"FYI >> ",XBV1," << is a >>NEW VARIABLE<" KILL DIR S DIR(0)="E" D ^DIR I Y'>0 G V1
;
V2 ;
S XBV1L=$L(XBV1)
I $E(XBV1,XBV1L)=")" S XBV2=$E(XBV1,1,XBV1L-1)_","
SELROU ;
I '$G(XBFILE) X ^%ZOSF("RSEL") S %X="^UTILITY(XBJ,",%Y="^XBVROU(XBJ,""R""," D %XY^%RCR
I $G(XBFILE) F XBVI=1:1 Q:'$D(^XBVROU(XBJ,"V",XBV0,XBVI)) S XBVRM=^(XBVI) D
. I XBVRM'["," S ^XBVROU(XBJ,"R",XBVRM)="" Q
. F XBVJ=1:1 S XBVR=$P(XBVRM,",",XBVJ) Q:XBVR="" S ^XBVROU(XBJ,"R",XBVR)=""
.Q
;
;----------------------------------------
;
PROCESS ;
D ^XBVCH1
G START
;
;--------------------
;
SHOVAR ;
D ^XBCLS
S XBVAR=""
F XBI=0:1 S XBVAR=$O(^XBVROU(XBJ,"V",XBVAR)) Q:XBVAR="" D:'(XBI#120) PAGE Q:X="^" W:'(XBI#6) ! W ?((XBI#6)*10),XBVAR
Q
;
PAGE ;
Q:XBI=0
KILL DIR
S DIR(0)="E"
D ^DIR
Q
;
;----------------------
EXIT ;EP - Paginat, print, kill, quit.
D ^XBCLS
I $D(^XBVROU("PRT",XBJ,"VCHG")) D PRINT
KILL ^XBVROU(XBJ),^UTILITY(XBJ)
I '$D(ZTQUEUED) KILL ^XBVROU("PRT",XBJ)
D EN^XBVK("XB")
Q
;
PRINT ;print variables and routines changed
;
KILL XBRC,XBRP,XBRX
W !,"Changes were made and a Summary is available",!!
S XBRP="PRINT1^XBVCH",XBNS="XB*"
D ^XBDBQUE
Q
;
PRINT1 ; Continue print
S:'$D(XBJ) XBJ=$J
S XBPG("HDR")="VARIABLES/ROUTINES CHANGED"
D XBHDR
S XBSUB=""
F S XBSUB=$O(^XBVROU("PRT",XBJ,"VCHG",XBSUB)) Q:XBSUB="" D
. U IO
. W !!?5,XBSUB
. S XBROU=""
. F XBC=2:1 S XBROU=$O(^XBVROU("PRT",XBJ,"VCHG",XBSUB,XBROU)) Q:XBROU="" D XBPG D
.. U IO
.. W ?(10*XBC),XBROU
.. I (XBC+2)>(IOM\10) S XBC=0 W ! D XBPG
..Q
.Q
S XBROU=""
F S XBROU=$O(^XBVROU("PRT",XBJ,"RCHG",XBROU)) Q:XBROU="" D XBPG D
. U IO
. W !!?5,XBROU
. S XBSUB=""
. F XBC=2:1 S XBSUB=$O(^XBVROU("PRT",XBJ,"RCHG",XBROU,XBSUB)) Q:XBSUB="" D
.. U IO
.. W ?(20*XBC),XBSUB
.. I (XBC+2)>(IOM\20) S XBC=0 W ! D XBPG
..Q
.Q
Q
;
XBPG ;EP PAGE CONTROLLER
; this utility uses variables XBPG("HDR"),XBPG("DT"),XBPG("LINE"),XBPG("PG") ; kill variables by D EXBPG
;
Q:($Y<(IOSL-4))!($G(DUOUT))
S XBPG("PG")=$G(XBPG("PG"))+1
I $E(IOST)="C" S Y=$$DIR^XBDIR("E") Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT))
XBHDR ;EP write page header
W:$Y @IOF
W !
Q:'$D(XBPG("HDR"))
S:'$D(XBPG("LINE")) $P(XBPG("LINE"),"-",IOM-2)=""
S:'$D(XBPG("PG")) XBPG("PG")=1
I '$D(XBPG("DT")) S %H=$H D YX^%DTC S XBPG("DT")=Y
U IO
W ?(IOM-40-$L(XBPG("HDR"))/2),XBPG("HDR"),?(IOM-40),XBPG("DT"),?(IOM-10),"PAGE: ",XBPG("PG"),!,XBPG("LINE")
XBHD ;EP Write column header / message
W !!
Q
;
EXBPG ;
KILL XBPG("LINE"),XBPG("PG"),XBPG("HDR"),XBPG("DT")
Q
;
XBVCH ; IHS/ADC/GTH - CHANGE VARIABLE NAMES ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; Thanks to Paul Wesley, DSD/OIRM, for the original routine.
+4 ;
+5 IF '$DATA(IOST(0))
DO HOME^%ZIS
+6 SET XBJ=$JOB
+7 DO EXIT^XBVCH
+8 SET XBJ=$JOB
+9 SET X="IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINORM;IOAWM0;IOAWM1"
+10 DO ENDR^%ZISS
+11 SET XBD(0)=IOUON
SET XBD(1)=IOUOFF
SET XBD(2)=IORVON
SET XBD(3)=IORVOFF
SET XBD(4)=IORVON
SET XBD(5)=IORVOFF
SET XBD(6)=IOAWM0
SET XBD(7)=IOAWM1
SET XBXY=IOXY
+12 DO KILL^%ZISS
+13 SET XBP=" #&'()*+,'-/<=>@\_?;:[]!"""
+14 SET XBS=" #&'()*+,'-/<=>@\_?;:[]!"""
+15 KILL DIR
+16 SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Do you have a %INDEX Summary in a Host File to work with ? "
+17 DO ^DIR
+18 KILL DIR
+19 IF Y=1
DO ^XBVCHV
START ;
+1 KILL XBV0,XBV1,XBV2
V0 ;
+1 KILL DIR
+2 SET DIR(0)="F:0,8"
SET DIR("A")="Old Variable ? or '^' to exit "
+3 IF $GET(XBFILE)
SET DIR("A")=DIR("A")_" or '|' to see variables "
+4 DO ^DIR
+5 KILL DIR
+6 IF (Y="^")
GOTO EXIT
+7 IF Y["|"
IF $GET(XBFILE)
SET XBV=""
DO SHOVAR
GOTO V0
+8 IF $GET(XBFILE)
IF '$DATA(^XBVROU(XBJ,"V",Y))
WRITE *7
GOTO V0
+9 SET XBV0=Y
V1 ;
+1 KILL DIR
+2 SET DIR(0)="F:0,8"
SET DIR("A")="New Variable ? or '^' to exit "
+3 DO ^DIR
+4 KILL DIR
+5 IF (Y="^")
GOTO V0
+6 SET XBV1=Y
+7 IF $GET(XBFILE)
IF $DATA(^XBVROU(XBJ,"V",XBV1))
WRITE *7,!!,"FYI >> ",XBV1," << Already Exits"
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF Y'>0
GOTO V1
+8 IF $DATA(^XBVROU(XBJ,"NV",XBV1))
WRITE *7,!!,"FYI >> ",XBV1," << is a >>NEW VARIABLE<"
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF Y'>0
GOTO V1
+9 ;
V2 ;
+1 SET XBV1L=$LENGTH(XBV1)
+2 IF $EXTRACT(XBV1,XBV1L)=")"
SET XBV2=$EXTRACT(XBV1,1,XBV1L-1)_","
SELROU ;
+1 IF '$GET(XBFILE)
XECUTE ^%ZOSF("RSEL")
SET %X="^UTILITY(XBJ,"
SET %Y="^XBVROU(XBJ,""R"","
DO %XY^%RCR
+2 IF $GET(XBFILE)
FOR XBVI=1:1
IF '$DATA(^XBVROU(XBJ,"V",XBV0,XBVI))
QUIT
SET XBVRM=^(XBVI)
Begin DoDot:1
+3 IF XBVRM'[","
SET ^XBVROU(XBJ,"R",XBVRM)=""
QUIT
+4 FOR XBVJ=1:1
SET XBVR=$PIECE(XBVRM,",",XBVJ)
IF XBVR=""
QUIT
SET ^XBVROU(XBJ,"R",XBVR)=""
+5 QUIT
End DoDot:1
+6 ;
+7 ;----------------------------------------
+8 ;
PROCESS ;
+1 DO ^XBVCH1
+2 GOTO START
+3 ;
+4 ;--------------------
+5 ;
SHOVAR ;
+1 DO ^XBCLS
+2 SET XBVAR=""
+3 FOR XBI=0:1
SET XBVAR=$ORDER(^XBVROU(XBJ,"V",XBVAR))
IF XBVAR=""
QUIT
IF '(XBI#120)
DO PAGE
IF X="^"
QUIT
IF '(XBI#6)
WRITE !
WRITE ?((XBI#6)*10),XBVAR
+4 QUIT
+5 ;
PAGE ;
+1 IF XBI=0
QUIT
+2 KILL DIR
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 QUIT
+6 ;
+7 ;----------------------
EXIT ;EP - Paginat, print, kill, quit.
+1 DO ^XBCLS
+2 IF $DATA(^XBVROU("PRT",XBJ,"VCHG"))
DO PRINT
+3 KILL ^XBVROU(XBJ),^UTILITY(XBJ)
+4 IF '$DATA(ZTQUEUED)
KILL ^XBVROU("PRT",XBJ)
+5 DO EN^XBVK("XB")
+6 QUIT
+7 ;
PRINT ;print variables and routines changed
+1 ;
+2 KILL XBRC,XBRP,XBRX
+3 WRITE !,"Changes were made and a Summary is available",!!
+4 SET XBRP="PRINT1^XBVCH"
SET XBNS="XB*"
+5 DO ^XBDBQUE
+6 QUIT
+7 ;
PRINT1 ; Continue print
+1 IF '$DATA(XBJ)
SET XBJ=$JOB
+2 SET XBPG("HDR")="VARIABLES/ROUTINES CHANGED"
+3 DO XBHDR
+4 SET XBSUB=""
+5 FOR
SET XBSUB=$ORDER(^XBVROU("PRT",XBJ,"VCHG",XBSUB))
IF XBSUB=""
QUIT
Begin DoDot:1
+6 USE IO
+7 WRITE !!?5,XBSUB
+8 SET XBROU=""
+9 FOR XBC=2:1
SET XBROU=$ORDER(^XBVROU("PRT",XBJ,"VCHG",XBSUB,XBROU))
IF XBROU=""
QUIT
DO XBPG
Begin DoDot:2
+10 USE IO
+11 WRITE ?(10*XBC),XBROU
+12 IF (XBC+2)>(IOM\10)
SET XBC=0
WRITE !
DO XBPG
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 SET XBROU=""
+16 FOR
SET XBROU=$ORDER(^XBVROU("PRT",XBJ,"RCHG",XBROU))
IF XBROU=""
QUIT
DO XBPG
Begin DoDot:1
+17 USE IO
+18 WRITE !!?5,XBROU
+19 SET XBSUB=""
+20 FOR XBC=2:1
SET XBSUB=$ORDER(^XBVROU("PRT",XBJ,"RCHG",XBROU,XBSUB))
IF XBSUB=""
QUIT
Begin DoDot:2
+21 USE IO
+22 WRITE ?(20*XBC),XBSUB
+23 IF (XBC+2)>(IOM\20)
SET XBC=0
WRITE !
DO XBPG
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
XBPG ;EP PAGE CONTROLLER
+1 ; this utility uses variables XBPG("HDR"),XBPG("DT"),XBPG("LINE"),XBPG("PG") ; kill variables by D EXBPG
+2 ;
+3 IF ($Y<(IOSL-4))!($GET(DUOUT))
QUIT
+4 SET XBPG("PG")=$GET(XBPG("PG"))+1
+5 IF $EXTRACT(IOST)="C"
SET Y=$$DIR^XBDIR("E")
IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT))
QUIT
XBHDR ;EP write page header
+1 IF $Y
WRITE @IOF
+2 WRITE !
+3 IF '$DATA(XBPG("HDR"))
QUIT
+4 IF '$DATA(XBPG("LINE"))
SET $PIECE(XBPG("LINE"),"-",IOM-2)=""
+5 IF '$DATA(XBPG("PG"))
SET XBPG("PG")=1
+6 IF '$DATA(XBPG("DT"))
SET %H=$HOROLOG
DO YX^%DTC
SET XBPG("DT")=Y
+7 USE IO
+8 WRITE ?(IOM-40-$LENGTH(XBPG("HDR"))/2),XBPG("HDR"),?(IOM-40),XBPG("DT"),?(IOM-10),"PAGE: ",XBPG("PG"),!,XBPG("LINE")
XBHD ;EP Write column header / message
+1 WRITE !!
+2 QUIT
+3 ;
EXBPG ;
+1 KILL XBPG("LINE"),XBPG("PG"),XBPG("HDR"),XBPG("DT")
+2 QUIT
+3 ;
