| 1 | DBARO ; Routine Method for Standard Extraction of Routines ;9/23/06 14:10
|
|---|
| 2 | N EXIT,ODIR,OFN,RTN
|
|---|
| 3 | I '$D(DTIME) N DTIME S DTIME=300
|
|---|
| 4 | ; Routine Selector
|
|---|
| 5 | X ^%ZOSF("RSEL")
|
|---|
| 6 | ;Output in ^UTILITY($J,rtn)
|
|---|
| 7 | S RTN=$O(^UTILITY($J,9)),EXIT=0 ;
|
|---|
| 8 | D:$L(RTN)
|
|---|
| 9 | . F D IFILE Q:$L($G(IO))
|
|---|
| 10 | . D:$L($G(IO))&('EXIT)
|
|---|
| 11 | . . U $P
|
|---|
| 12 | . . W !,"Enter a Comment for the Routine Set.",!
|
|---|
| 13 | . . R ">>",COM:DTIME,!
|
|---|
| 14 | . . I '$T!($E(ODIR)="^") S EXIT=1 Q
|
|---|
| 15 | . . ;
|
|---|
| 16 | . . U IO
|
|---|
| 17 | . . W COM,!,$$HTE^XLFDT($H),!
|
|---|
| 18 | . . D RGET
|
|---|
| 19 | . . U $P
|
|---|
| 20 | . .QUIT
|
|---|
| 21 | .QUIT
|
|---|
| 22 | QUIT
|
|---|
| 23 | ; ==============
|
|---|
| 24 | IFILE ; Prompt and accept the Directory and File Combination
|
|---|
| 25 | N X
|
|---|
| 26 | W !,"Enter a valid directory path and file name for the receiving file"
|
|---|
| 27 | W !," enter '?' for Help, or '^' to exit now."
|
|---|
| 28 | W !," such as: /tmp/ and OUTRTNS.RO",!
|
|---|
| 29 | R !,"Directory > ",ODIR:DTIME,!
|
|---|
| 30 | I ('$T)!($E(ODIR)="^") S EXIT=1 Q
|
|---|
| 31 | R !,"Output File > ",OFNM:DTIME,!
|
|---|
| 32 | I ('$T)!($E(OFNM)="^") S EXIT=1 Q
|
|---|
| 33 | D OPEN^%ZISH("",ODIR,OFNM,"W") U $P
|
|---|
| 34 | QUIT
|
|---|
| 35 | ; ==============
|
|---|
| 36 | RGET ; The file and the list of routines has been selected,
|
|---|
| 37 | ; now go load the File.
|
|---|
| 38 | N XCNP,DIF,TMP,X,I,L,S,V
|
|---|
| 39 | I '$D(IORM) N IORM S IORM=255
|
|---|
| 40 | S S=$J("",12)
|
|---|
| 41 | ; RTN already has the first name.
|
|---|
| 42 | F D S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""
|
|---|
| 43 | . K TMP S XCNP=0,DIF="TMP(",X=RTN X ^%ZOSF("LOAD")
|
|---|
| 44 | . U IO W RTN,!
|
|---|
| 45 | . F I=1:1:XCNP-1 W TMP(I,0),!
|
|---|
| 46 | . W !
|
|---|
| 47 | . U $P W:(($X+10)>80) ! W $E(RTN_S,1,10)
|
|---|
| 48 | . Q
|
|---|
| 49 | U IO
|
|---|
| 50 | W !!
|
|---|
| 51 | F I=1:1:5 W "#########",!
|
|---|
| 52 | I IOT="HFS" D ^%ZISC
|
|---|
| 53 | QUIT
|
|---|
| 54 | ; ==============
|
|---|
