Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBVCH

XBVCH.m

Go to the documentation of this file. 
  1. XBVCH ; IHS/ADC/GTH - CHANGE VARIABLE NAMES ; [ 02/07/97   3:02 PM ]
  1.  ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
  1.  ;
  1.  ; Thanks to Paul Wesley, DSD/OIRM, for the original routine.
  1.  ;
  1.  I '$D(IOST(0)) D HOME^%ZIS
  1.  S XBJ=$J
  1.  D EXIT^XBVCH
  1.  S XBJ=$J
  1.  S X="IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINORM;IOAWM0;IOAWM1"
  1.  D ENDR^%ZISS
  1.  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
  1.  D KILL^%ZISS
  1.  S XBP=" #&'()*+,'-/<=>@\_?;:[]!"""
  1.  S XBS=" #&'()*+,'-/<=>@\_?;:[]!"""
  1.  KILL DIR
  1.  S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you have a %INDEX Summary in a Host File to work with ? "
  1.  D ^DIR
  1.  KILL DIR
  1.  D:Y=1 ^XBVCHV
  1. START ;
  1.  KILL XBV0,XBV1,XBV2
  1. V0 ;
  1.  KILL DIR
  1.  S DIR(0)="F:0,8",DIR("A")="Old Variable ? or '^' to exit "
  1.  I $G(XBFILE) S DIR("A")=DIR("A")_" or '|' to see variables "
  1.  D ^DIR
  1.  KILL DIR
  1.  G:(Y="^") EXIT
  1.  I Y["|",$G(XBFILE) S XBV="" D SHOVAR G V0
  1.  I $G(XBFILE),'$D(^XBVROU(XBJ,"V",Y)) W *7 G V0
  1.  S XBV0=Y
  1. V1 ;
  1.  KILL DIR
  1.  S DIR(0)="F:0,8",DIR("A")="New Variable ? or '^' to exit "
  1.  D ^DIR
  1.  KILL DIR
  1.  G:(Y="^") V0
  1.  S XBV1=Y
  1.  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
  1.  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
  1.  ;
  1. V2 ;
  1.  S XBV1L=$L(XBV1)
  1.  I $E(XBV1,XBV1L)=")" S XBV2=$E(XBV1,1,XBV1L-1)_","
  1. SELROU ;
  1.  I '$G(XBFILE) X ^%ZOSF("RSEL") S %X="^UTILITY(XBJ,",%Y="^XBVROU(XBJ,""R""," D %XY^%RCR
  1.  I $G(XBFILE) F XBVI=1:1 Q:'$D(^XBVROU(XBJ,"V",XBV0,XBVI))  S XBVRM=^(XBVI) D
  1.  . I XBVRM'["," S ^XBVROU(XBJ,"R",XBVRM)="" Q
  1.  . F XBVJ=1:1 S XBVR=$P(XBVRM,",",XBVJ) Q:XBVR=""  S ^XBVROU(XBJ,"R",XBVR)=""
  1.  .Q
  1.  ;
  1.  ;----------------------------------------
  1.  ;
  1. PROCESS ;
  1.  D ^XBVCH1
  1.  G START
  1.  ;
  1.  ;--------------------
  1.  ;
  1. SHOVAR ;
  1.  D ^XBCLS
  1.  S XBVAR=""
  1.  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
  1.  Q
  1.  ;
  1. PAGE ;
  1.  Q:XBI=0
  1.  KILL DIR
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  Q
  1.  ;
  1.  ;----------------------
  1. EXIT ;EP - Paginat, print, kill, quit.
  1.  D ^XBCLS
  1.  I $D(^XBVROU("PRT",XBJ,"VCHG")) D PRINT
  1.  KILL ^XBVROU(XBJ),^UTILITY(XBJ)
  1.  I '$D(ZTQUEUED) KILL ^XBVROU("PRT",XBJ)
  1.  D EN^XBVK("XB")
  1.  Q
  1.  ;
  1. PRINT ;print variables and routines changed
  1.  ;
  1.  KILL XBRC,XBRP,XBRX
  1.  W !,"Changes were made and a Summary is available",!!
  1.  S XBRP="PRINT1^XBVCH",XBNS="XB*"
  1.  D ^XBDBQUE
  1.  Q
  1.  ;
  1. PRINT1 ; Continue print
  1.  S:'$D(XBJ) XBJ=$J
  1.  S XBPG("HDR")="VARIABLES/ROUTINES CHANGED"
  1.  D XBHDR
  1.  S XBSUB=""
  1.  F  S XBSUB=$O(^XBVROU("PRT",XBJ,"VCHG",XBSUB)) Q:XBSUB=""  D
  1.  . U IO
  1.  . W !!?5,XBSUB
  1.  . S XBROU=""
  1.  . F XBC=2:1 S XBROU=$O(^XBVROU("PRT",XBJ,"VCHG",XBSUB,XBROU)) Q:XBROU=""  D XBPG D
  1.  .. U IO
  1.  .. W ?(10*XBC),XBROU
  1.  .. I (XBC+2)>(IOM\10) S XBC=0 W ! D XBPG
  1.  ..Q
  1.  .Q
  1.  S XBROU=""
  1.  F  S XBROU=$O(^XBVROU("PRT",XBJ,"RCHG",XBROU)) Q:XBROU=""  D XBPG D
  1.  . U IO
  1.  . W !!?5,XBROU
  1.  . S XBSUB=""
  1.  . F XBC=2:1 S XBSUB=$O(^XBVROU("PRT",XBJ,"RCHG",XBROU,XBSUB)) Q:XBSUB=""  D
  1.  .. U IO
  1.  .. W ?(20*XBC),XBSUB
  1.  .. I (XBC+2)>(IOM\20) S XBC=0 W ! D XBPG
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. XBPG ;EP PAGE CONTROLLER
  1.  ; this utility uses variables XBPG("HDR"),XBPG("DT"),XBPG("LINE"),XBPG("PG") ; kill variables by D EXBPG
  1.  ;
  1.  Q:($Y<(IOSL-4))!($G(DUOUT))
  1.  S XBPG("PG")=$G(XBPG("PG"))+1
  1.  I $E(IOST)="C" S Y=$$DIR^XBDIR("E") Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT))
  1. XBHDR ;EP write page header
  1.  W:$Y @IOF
  1.  W !
  1.  Q:'$D(XBPG("HDR"))
  1.  S:'$D(XBPG("LINE")) $P(XBPG("LINE"),"-",IOM-2)=""
  1.  S:'$D(XBPG("PG")) XBPG("PG")=1
  1.  I '$D(XBPG("DT")) S %H=$H D YX^%DTC S XBPG("DT")=Y
  1.  U IO
  1.  W ?(IOM-40-$L(XBPG("HDR"))/2),XBPG("HDR"),?(IOM-40),XBPG("DT"),?(IOM-10),"PAGE: ",XBPG("PG"),!,XBPG("LINE")
  1. XBHD ;EP Write column header / message
  1.  W !!
  1.  Q
  1.  ;
  1. EXBPG ;
  1.  KILL XBPG("LINE"),XBPG("PG"),XBPG("HDR"),XBPG("DT")
  1.  Q
  1.  ;