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

XBVCH1.m

Go to the documentation of this file. 
  1. XBVCH1 ; IHS/ADC/GTH - CONTINUE VARIABLE CHANGER ; [ 10/29/2002   7:42 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
  1.  ;
  1.  ; Thanks to Paul Wesley, DSD/OIRM, for the original routine.
  1.  ;
  1. PROCESS ;
  1.  S XBL=$L(XBV0),XBOUT=0
  1.  S X=0
  1.  X ^%ZOSF("RM")
  1.  S (XBROU,XBRM)=""
  1.  F  S XBROU=$O(^XBVROU(XBJ,"R",XBROU)) Q:XBROU=""  S XBRM=XBRM_XBROU_","
  1.  S XBROU=""
  1.  F  S XBROU=$O(^XBVROU(XBJ,"R",XBROU)) Q:XBROU=""  D  Q:$G(XBOUT)
  1.  . S X=XBROU
  1.  . X ^%ZOSF("TEST")
  1.  . E  D ^XBCLS W !!,X,"  NOT FOUND",! KILL DIR S DIR(0)="E" D ^DIR S:(Y=0) XBOUT=1 Q
  1.  . S X=XBROU,DIF="^XBVROU(XBJ,""R"","""_XBROU_""",",(XCNP,%N)=0
  1.  . X ^%ZOSF("LOAD")
  1.  . I ^XBVROU(XBJ,"R",XBROU,1,0)["GENERATED FROM" W !,^(0),! KILL DIR S DIR(0)="E" D ^DIR D ^XBCLS Q
  1.  . S XBLN=0,XBEDIT=0
  1.  . F  S XBLN=$O(^XBVROU(XBJ,"R",XBROU,XBLN)) Q:XBLN=""  S XBLIN=^(XBLN,0) D LIN Q:$G(XBOUT)
  1.  . I XBEDIT D SAVE
  1.  . KILL ^XBVROU(XBJ,"R",XBROU)
  1.  .Q
  1.  Q
  1.  ;
  1. DISPROU ;display routine list
  1.  S DX=1,DY=22
  1.  X XBXY
  1.  S XBRD=""
  1.  F XBRI=1:1 S XBRD=$P(XBRM,",",XBRI) Q:XBRD=""  W:'(XBRI-1#8) ! S XBRC=(10*(XBRI-1#8)) W ?XBRC W:XBRD=XBROU "|" W XBRD W:XBRD=XBROU "|"
  1.  Q
  1.  ;
  1.  ;--------------------------------------
  1.  ;
  1. LIN ;PROCESS LINE FROM TOP    
  1.  S XBLIN0=XBLIN,XBVX=XBV0
  1.  Q:XBLIN0'[XBV0
  1.  D SCAN0,CHKMK
  1.  I '$G(XBMK),$L(XBV0)=1 Q  ;skip when single character variable
  1.  I '$G(XBMK) KILL XBEDLIN D EDIT,CHKMK Q:'$G(XBMK)  Q:$G(XBOUT)
  1.  D ACCEPT
  1.  Q
  1.  ;
  1. SCAN0 ;
  1.  S XBLINX=XBLIN0,XBVX=XBV0
  1.  D SCAN,UPT
  1.  Q
  1.  ;
  1. SCAN1 ;
  1.  S XBLINX=XBLIN1,XBVX=XBV1
  1.  D SCAN
  1.  Q
  1.  ;
  1. DISP0 ;
  1.  S XBVX=XBV0,XBLINX=XBLIN0
  1.  D ^XBCLS,DISPLAY
  1.  Q
  1.  ;
  1. DISP1 ;
  1.  S XBVX=XBV1,XBLINX=XBLIN1
  1.  D DISPLAY
  1.  Q
  1.  ;
  1. SCAN ;
  1.  KILL XB,XBT,XBMK
  1.  S XBL=$L(XBVX)
  1.  F XBI=1:1 S XB(XBI)=$F(XBLINX,XBVX,$G(XB(XBI-1))+1)-XBL Q:XB(XBI)'>0  D
  1.  . S XB(XBI,"M")=0,XB(XBI,0)=XB(XBI)
  1.  . I XBP[$E(XBLINX,XB(XBI)-1),XBS[$E(XBLINX,XB(XBI)+XBL) S XB(XBI,"M")=1
  1.  . S XB("B",XB(XBI))=XBI,XB("E",XB(XBI)+XBL-1)=XBI
  1.  . S XB(XBI,"E")=XB(XBI)+XBL-1
  1.  .Q
  1.  KILL XB(XBI)
  1. CHKMK ;
  1.  I XBVX=XBV0 KILL XBMK S XBJM="" F  S XBJM=$O(XB(XBJM)) Q:XBJM=""  I $G(XB(XBJM,"M")) W *7 S XBMK=1
  1.  KILL XBJM
  1.  Q
  1.  ;
  1. EDIT ;
  1.  D DISP0
  1.  S DX=1,DY=13
  1.  X XBXY
  1.  R "TAB/T/SPC/CR/R/N/%/^/? :",*X:DTIME
  1.  S X=$C(X)
  1.  I X="T" D UPT G EDIT
  1.  I $A(X)=9 D UPT G EDIT
  1.  I X=" " S XB(XBT,"M")=XB(XBT,"M")+1#2 D UPT G EDIT
  1.  I X="R" S XBLN=0 KILL XBMK Q
  1.  I X="N" S XBLN=999 KILL XBMK Q
  1.  ; I X="%" D ^XBNEW("%EDIT^XBVCH1:XBJ;XBROU") S XBLN=0 KILL XBMK Q  ; IHS/SET/GTH XB*3*9 10/29/2002
  1.  I X="%" D EN^XBNEW("%EDIT^XBVCH1","XBJ;XBROU") S XBLN=0 KILL XBMK Q  ; IHS/SET/GTH XB*3*9 10/29/2002
  1.  I X="^" S XBOUT=1 KILL XBMK Q
  1.  KILL XBMK
  1.  S XBJM=""
  1.  F  S XBJM=$O(XB(XBJM)) Q:XBJM=""  I $G(XB(XBJM,"M")) W *7 S XBMK=1
  1.  KILL XBJM
  1.  I $A(X)=13 Q
  1.  D ^XBCLS
  1.  W !!!
  1.  W !?5,"'X'             Set changes"
  1.  W !?5,"'Tab' or 'T'    Move to next marker"
  1.  W !?5,"'Space bar'     Toggel marker and move to next"
  1.  W !?5,"'CR'            Skip to next line"
  1.  W !?5,"'R'             Restart the current Routine"
  1.  W !?5,"'%'             %E Edit Routine"
  1.  W !?5,"'N'             Next Routine"
  1.  W !?5,"'^'             Exit"
  1.  KILL DIR
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  G EDIT
  1.  ;
  1. DISPLAY ; display line
  1.  ; XB(XBI,0)=POS XB("B",POS)=XBI XB("E",POS)=XBI XB(XBI,"M")=MARK (0 OR 1)
  1.  ; XBD(0) =underline-on,XBD(1)=Bold on,XBD(2)=Underline Off,XBD(3)=Bold Off,XBD("RVON")=RVON,XBD("RVOFF")=RVOFF
  1.  D:(XBVX=XBV0) ^XBCLS ;displaying current line
  1.  D:XBVX=XBV0 DISPROU
  1.  S DX=0,DY=0
  1.  X XBXY
  1.  W ?5,"routine ",XBROU,?35,"line ",XBLN,!!
  1.  I XBVX=XBV1 W ! ;displaying new line
  1.  W XBD(6)
  1.  F XBI=1:1:$L(XBLINX) D
  1.  . I '(XBI#80) W !!!
  1.  . I $D(XB("B",XBI)) W XBD(XB(XB("B",XBI),"M")*2)
  1.  . W $E(XBLINX,XBI)
  1.  . I $D(XB("E",XBI)) W XBD(XB(XB("E",XBI),"M")*2+1)
  1.  .Q
  1.  W XBD(7)
  1.  Q:(XBVX=XBV1)  ;no tab marker when displaying new line
  1. TAB ;
  1.  S DY=+3,DX=XB(XBT,0)#80-1,DY=DY+(XB(XBT,0)\80*3)
  1.  S:DY>8 DX=DX+1
  1. TAB1 ;
  1.  X XBXY
  1.  W XBD(2),"|",XBD(3)
  1.  Q
  1.  ;
  1. UPT ; SET TAB     
  1.  S XBT=$G(XBT),XBT=$O(XB(XBT))
  1.  I XBT'>0 S XBT=0 G UPT
  1.  KILL XB("T")
  1.  S XB("T",XB(XBT,0))=""
  1.  Q
  1.  ;
  1. BLDLIN1 ;
  1.  S XBLIN0=XBLIN,XBSUB=XBV0_":"_XBV1,XBLIN1=""
  1.  F XBI=1:1 Q:'$D(XB(XBI))  S XBLIN1=XBLIN1_$E(XBLIN,$G(XB(XBI-1,"E"))+1,XB(XBI,0)-1)_$S(XB(XBI,"M"):XBV1,1:XBV0)
  1.  S XBI=XBI-1
  1.  S XBLIN1=XBLIN1_$E(XBLIN,XB(XBI,"E")+1,999)
  1.  Q
  1.  ;
  1. ACCEPT ;
  1.  D DISP0,BLDLIN1,SCAN1,DISP1
  1.  KILL DIR
  1.  S DIR(0)="S^Y:ACCEPT;E:EDIT;S:SKIP;N:NEXT ROUTINE;Q:QUIT",DIR("B")="Y"
  1.  S X=$P(XBLINX," ",2,999)
  1.  F  Q:$E(X)'=" "  S X=$E(X,2,999)
  1.  F  Q:$E(X)'="."  S X=$E(X,2,999)
  1.  D ^DIM
  1.  I '$D(X) W *7,!,XBD(2),"FM DIM checker does not like this line !",XBD(3),!,XBD(2),XBLINX,XBD(3),! S DIR("B")="E"
  1.  D ^DIR
  1.  KILL DIR
  1.  I Y="N" S XBLN=999 Q
  1.  I Y="S" Q
  1.  I Y="E" D SCAN0,EDIT,CHKMK G:$G(XBMK) ACCEPT Q
  1.  I Y="Q" S XBOUT=1 Q
  1.  I Y'="Y" G ACCEPT
  1.  S XBEDIT=1 ; set edit markers
  1.  S XBLIN=XBLIN1,^XBVROU(XBJ,"R",XBROU,XBLN,0)=XBLIN ;set new line
  1.  Q
  1.  ;
  1. %EDIT ; USE %E EDITOR
  1.  X "ZL @XBROU X ^%E"
  1.  KILL ^XBVROU(XBJ,"R",XBROU)
  1.  S X=XBROU,DIF="^XBVROU(XBJ,""R"","""_XBROU_""",",(XCNP,%N)=0
  1.  X ^%ZOSF("LOAD")
  1.  S XBLIN=0
  1.  Q
  1.  ;
  1. SAVE ; SAVE NEW ROUTINE TO DISK
  1.  D ^XBCLS
  1.  X ^%ZOSF("UCI")
  1.  I Y["DEV," W !,"you are in DEV .. NO CHANGES" H 2 Q
  1.  I Y["PRD," W !,"you are in PRD .. NO CHANGES" H 2 Q
  1.  KILL DIR
  1.  S DIR(0)="Y",DIR("A")=XBROU_" has been changed. Save with Changes ?",DIR("B")="Y"
  1.  D ^DIR
  1.  KILL DIR
  1.  I 'Y W !?5,XBROU," NOT CHANGED" H 3 D ^XBCLS Q
  1.  W !?5,XBROU,"is being saved with changes",!
  1.  S XBSAV1="ZR",XBSAV2="F XBI=1:1 S XBX=$G(^XBVROU(XBJ,""R"",XBROU,XBI,0)) Q:'$L(XBX)  ZI XBX",XBSAV3="ZS @XBROU"
  1.  X "X XBSAV1,XBSAV2,XBSAV3"
  1.  S ^XBVROU("PRT",$J,"VCHG",XBSUB,XBROU)=""
  1.  S ^XBVROU("PRT",$J,"RCHG",XBROU,XBSUB)=""
  1.  S ^XBVROU(XBJ,"NV",XBV1)=""
  1.  W !?5,XBROU,"SAVED WITH CHANGES" H 2
  1.  Q
  1.  ;