| [641] | 1 | %RSEL ;DJM;ROUTINE SELECTOR;
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;COPYRIGHT MICRONETICS DESIGN CORP. @1985
|
|---|
| 4 | ;IHS/THL MODIFIED TO ALLOW ROUTINE SELECTION BY DATE LAST EDITED
|
|---|
| 5 | S $ZT="ERROR^%RSEL"
|
|---|
| 6 | INT ;
|
|---|
| 7 | N %P,%RN,%RS,%RSN,FIRST,LAST,X S %RSN=0
|
|---|
| 8 | L0 ;
|
|---|
| 9 | R !!,"Routine selector: ",%RS:$S($D(DTIME):DTIME,1:999)
|
|---|
| 10 | I %RS="."!(%RS=" "),%RSN=0 D LIST S %RSN=1 G L0
|
|---|
| 11 | I %RS="^L"!(%RS="^l") D:%RSN LIST G L0
|
|---|
| 12 | I %RS="^"!(%RS="^Q")!(%RS="^q") K ^UTILITY($J) G EXIT
|
|---|
| 13 | I %RS="" K:%RSN=0 ^UTILITY($J) G EXIT
|
|---|
| 14 | I %RS="^D"!(%RS="^d") D DISPLAY G L0
|
|---|
| 15 | I %RS="?" D HELP G L0
|
|---|
| 16 | L1 ;
|
|---|
| 17 | I %RSN=0 K ^UTILITY($J) S %RSN=1
|
|---|
| 18 | G:$E(%RS)="-" DEL
|
|---|
| 19 | S %P=$$%SRCHPAT^%SRCHPAT(%RS)
|
|---|
| 20 | I $D(FIRST)=0 W *7," ...Invalid routine name selection criteria, Specify '?' for help" G L0
|
|---|
| 21 | S %RN=0,X=FIRST D:FIRST'=""
|
|---|
| 22 | .Q:$D(^ (X))=0 Q:X]LAST X %P S:$T %RN=%RN+1,^UTILITY($J,FIRST)=""
|
|---|
| 23 | F S X=$O(^ (X)) Q:X=""!(X]LAST) X %P S:$T %RN=%RN+1,^UTILITY($J,X)=""
|
|---|
| 24 | W !!,?10,%RN," routine",$S(%RN=1:"",1:"s")," selected." W:%RN=0 *7
|
|---|
| 25 | G L0
|
|---|
| 26 | DEL ;
|
|---|
| 27 | S %P=$$%SRCHPAT^%SRCHPAT($E(%RS,2,$L(%RS))),%RN=0
|
|---|
| 28 | I $D(FIRST)=0 W *7," ...Invalid routine name selection criteria, Specify '?' for help" G L0
|
|---|
| 29 | S %RN=0,X=FIRST D:FIRST'=""
|
|---|
| 30 | .Q:$D(^UTILITY($J,X))=0 Q:X]LAST X %P I $T S %RN=%RN+1 K ^UTILITY($J,X)
|
|---|
| 31 | F S X=$O(^UTILITY($J,X)) Q:X=""!(X]LAST) X %P I $T S %RN=%RN+1 K ^UTILITY($J,X)
|
|---|
| 32 | W !!,?10,%RN," routine",$S(%RN=1:"",1:"s")," de-selected." W:%RN=0 *7
|
|---|
| 33 | G L0
|
|---|
| 34 | DOTS W $E("..............................",1,24-$X) Q
|
|---|
| 35 | EXIT ;
|
|---|
| 36 | IHS1 I $D(^UTILITY($J)) D DATE I $D(XB) X XB W !!?10,%RN," routines edited after ",XBDAT D OUT ;IHS/THL ALLOWS SELECTION OF ROUTINES BY DATE LAST EDITED
|
|---|
| 37 | S:'$D(^UTILITY($J)) QUIT="" Q
|
|---|
| 38 | LIST ;
|
|---|
| 39 | I $D(^UTILITY($J))<10 W !,"No routines selected" Q
|
|---|
| 40 | W !! S %RN=0,%RS=-1 F X=1:1 S %RS=$N(^UTILITY($J,%RS)) Q:%RS<0 W:'(X-1#8) ! W ?(X-1)#8*10,%RS S %RN=%RN+1
|
|---|
| 41 | W !!,?10,%RN," routine",$S(%RN=1:"",1:"s")," selected so far.",!
|
|---|
| 42 | Q
|
|---|
| 43 | DISPLAY ;
|
|---|
| 44 | W !! S %RN=0,%RS="" F X=1:1 S %RS=$O(^ (%RS)) Q:%RS="" W:'(X-1#8) ! W ?(X-1)#8*10,%RS S %RN=%RN+1
|
|---|
| 45 | W !!,?10,%RN," routine",$S(%RN=1:"",1:"s"),"."
|
|---|
| 46 | Q
|
|---|
| 47 | ERROR ;
|
|---|
| 48 | I $F($ZE,"<INRPT>") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2
|
|---|
| 49 | ZQ
|
|---|
| 50 | HELP ;
|
|---|
| 51 | W !,"Respond with routine selection criteria.",!,"Valid responses:"
|
|---|
| 52 | W !?5,"Routine name" D DOTS W "Eg: ABC"
|
|---|
| 53 | W !?5,"Routine range" D DOTS W "Eg: AAA-HZZZ"
|
|---|
| 54 | W !?5,"Routine pattern" D DOTS W "Eg: PROG? PRG*AA A*C?D *XYZ ?"
|
|---|
| 55 | W !?24,"Where '?' matches any single character,"
|
|---|
| 56 | W !?24,"and '*' matches zero or more characters"
|
|---|
| 57 | W !?5,"All routines" D DOTS W " * (selects ALL routines)"
|
|---|
| 58 | W !,"Precede any of the above with a '-' to unselect previously selected routines."
|
|---|
| 59 | W:%RSN=0 !,"Enter '.' or ' ' to retain previously selected range(s)."
|
|---|
| 60 | W !,"Enter '^L' for display of previously selected routines."
|
|---|
| 61 | W !,"Enter '^D' to display all routine names."
|
|---|
| 62 | W !,"Enter '^' or '^Q' to exit."
|
|---|
| 63 | Q
|
|---|
| 64 | DATE ;IHS/THL ALLOWS SELECTION OF ROUTINES BY DATE LAST EDITED
|
|---|
| 65 | R !!,"Screen ROUTINES by date last edited? NO// ",X:300 Q:'$T
|
|---|
| 66 | I "^N"[$E(X)!(X="") W !!,"No date selected." Q
|
|---|
| 67 | I "^Y?N"'[$E(X)!("?"[$E(X)) W !!,"Type 'Y'es to select ROUTINES edited on or after a specified date.",!,"Type '^' or strike <RETURN> to continue without selecting by date." G DATE
|
|---|
| 68 | I X'="" D Q
|
|---|
| 69 | .S %DN=$H
|
|---|
| 70 | .D ^%DO
|
|---|
| 71 | .S %DT("B")=%DS,%DT="AEQ",%DT("A")="ROUTINES last edited on or after: "
|
|---|
| 72 | .W ! D ^%DT
|
|---|
| 73 | .I Y<1 D OUT Q
|
|---|
| 74 | .S XBX=$T(XBX),XBX=$P(XBX,";;",2)
|
|---|
| 75 | .X XBX
|
|---|
| 76 | .S (XBDAT,%DS)=Y D ^%DI
|
|---|
| 77 | .D:%DN&'$D(%ER)
|
|---|
| 78 | ..S DN1=%DN
|
|---|
| 79 | ..S XB=$T(XB),XB=$P(XB,";;",2)
|
|---|
| 80 | ..S XB1=$T(XB1),XB1=$P(XB1,";;",2)
|
|---|
| 81 | .D:$D(%ER) OUT
|
|---|
| 82 | Q
|
|---|
| 83 | XB ;;S %RN=0,(RTN,%DN)="" F S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" ZL @RTN X XB1 D:%DS?1.2N1"/"1.2N1"/"2N ^%DI K:$D(%ER)!'%DN!(%DN<(DN1)) ^UTILITY($J,RTN) K %ER I %DN>(DN1-1) D ^%DO W !,RTN,?10,"last edited on ",%DS S %RN=%RN+1
|
|---|
| 84 | XB1 ;;S X=$T(@RTN),X=$P($P(X,";",2,99)," ",2,99) F I=1:1:$L(X," ") S %DS=$P(X," ",I) Q:%DS?1.2N1"/"1.2N1"/"2N
|
|---|
| 85 | XBX ;;S:Y Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)
|
|---|
| 86 | OUT K %DT,XB,XB1,%RN,XBX,DN1,RTN,X,Y,%DA,%DN,%DS,I,XBDAT Q
|
|---|
