AZHLSCS ; IHS/ADC/GTH:KEU - DSM SPELL CHECKER FOR VARIOUS FILES/FIELDS ; [ 11/24/97 10:55 AM ]
;;5.0;AZHLSC;;JUL 10, 1996
;
0 W !!!?4,$P($P($T(+1),";",2),"-",2)," v ",$P($T(+2),";",3),!
I 'AZHLPIEN D NPKG^AZHLSC Q
;
1 W !!?10 D PKG^AZHLSC
F %=1:1:$P($T(SELS),";",3) W !?10,$J(%,3)," ",$P($T(@"SELS"+%),";",3)
R !!?15,"Select : [A]ll // ",AZHLOPTN:300 G:'$T!(AZHLOPTN=U) END S:AZHLOPTN="" AZHLOPTN="A"
;
DEVICE W !!,"Report will be QUEUE'd if device other than HOME selected.",! K IOP,%ZIS S %ZIS="NQM",%ZIS("B")="" D ^%ZIS K %ZIS I POP W !,*7,"No device specified." G END
S AZHLTERM=0,IOP=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
I IO=IO(0),"C"[$E(IOST),$D(IO("Q"))#2 W !,"Can't Q to home device." K IO("Q") G DEVICE
I IO'=IO(0),'$D(IO("Q")) W !!,"Report being QUEUE'd to run now for you." S IO("Q")=1,ZTDTH=$H
I '$D(IO("Q")) S AZHLTERM=('$D(IO("S"))&(IO=IO(0))) D ^%ZIS G START
S ZTRTN="START^AZHLSCS",ZTIO=IOP,ZTDESC="SPELL CHECK of "_AZHLNMSP_" package." F G="AZHLOPTN","AZHLPIEN","AZHLNMSP","AZHLTERM" S ZTSAVE(G)=""
K IO("Q") D ^%ZTLOAD D HOME^%ZIS
DEVEND K AZHLNMSP,AZHLPIEN,AZHLTERM,G,IOP,ZTSK G END
START ;EP - From TaskMan.
U IO W !!,"<<<<<<< DSM SPELL CHECKER >>>>>>>",! D PKG^AZHLSC,BEG^AZHLSC
NEW AZHLX,AZHLX1,B,C,D,E,F,G,I,L,Q,W D END S Q=0
I AZHLOPTN="A" D G QEND
.F AZHLOPTN=1:1:$P($T(SELS),";",3) K D D @($P($T(SELS+AZHLOPTN),";",4)) Q:Q
.Q
D @($P($T(SELS+AZHLOPTN),";",4))
QEND W !!!,"<< DSM SPELL CHECKER >>" D FIN^AZHLSC,END
Q
;
END K ^TMP($J)
Q
;
CHECK ;EP
Q:'$D(@(AZHLROOT(1))) S C=+$P(@(AZHLROOT(1)),U,4)
F AZHL=1:1:C I $D(@(AZHLROOT_AZHLROOT(2)_AZHL_",0)")) S AZHLX=^(0) D CHK Q:Q
Q
;
CHK ;EP
S (B,E)=0,L=$L(AZHLX)
F D GETWORD Q:X=""!Q W:AZHLTERM "." D
.I $D(^AZHLWDIC("B",X)) Q
.I $L(X)>2,$S($E(X,$L(X))'="S":0,$D(^($E(X,1,$L(X)-1))):1,1:0) Q
.I $L(X)>3,$S($E(X,$L(X)-1,$L(X))'="ED":0,$D(^($E(X,1,$L(X)-2))):1,1:0) Q
.I $L(X)>4,$S($E(X,$L(X)-2,$L(X))'="ING":0,$D(^($E(X,1,$L(X)-3))):1,1:0) Q
.I $D(^TMP($J,X))!$D(@("^"_X)) Q
.X ^%ZOSF("TEST") I Q
.D NOHIT
.Q
Q
GETWORD ;
Q:Q S G=0,X=" "
F S:B>L X="" Q:X=""!G S B=B+1 I $E(AZHLX,B)?1A S E=B F S E=E+1 I $E(AZHLX,E)'?1A S X=$E(AZHLX,B,E-1),G=1 Q
S:X]"" X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S B=E
Q
NOHIT ;
I '$D(D(3)) W !!,"*** '",AZHLNMSP,"'; ",D," ",D(1)," " W:$D(AZHLROOT) AZHLROOT W:$D(AZHLROOT(2)) AZHLROOT(2) W "; ",$S($D(D(2)):"; "_D(2),1:""),! S D(3)=1 ;IHS/JN 11/21/97
W !,AZHLX,!,?10,"'",X,"' not found ",! ;IHS/JN 11/21/97
; I $D(ZTSK)!$D(IO("S")) W:($X>(IOM-19)) ! W X,$E(" ",1,20-$L(X)) G IGNORE ;IHS/JN 11/21/97
I $D(ZTSK)!$D(IO("S")) G IGNORE ;IHS/JN 11/17/97
NOHIT1 W *7,!,AZHLX,!,"'",X,"' not found in ",$P(^AZHLWDIC(0),U),"""",!!
F R "[A]dd, [C]orrect, [I]gnore, [S]uggestions, [Q]uit : ",*AZHL(2):300 S AZHL(2)=$C(AZHL(2)) Q:"AaCcIiSsQq"[$E(AZHL(2)) W !,"Please enter an 'A', 'C', 'I', 'S', or 'Q'.",!
I "Qq"[AZHL(2) S Q=1 Q
D ADD:"Aa"[AZHL(2),CORRECT:"Cc"[AZHL(2),IGNORE:"Ii"[AZHL(2)
Q:"Ss"'[AZHL(2)
D SUGGEST
G NOHIT1
;
ADD L +^AZHLWDIC(0):10 Q:'$T S $P(^(0),U,3)=$P(^AZHLWDIC(0),U,3)+1,$P(^(0),U,4)=$P(^(0),U,4)+1 L ^AZHLWDIC($P(^(0),U,3),0) S ^AZHLWDIC($P(^(0),U,3),0)=X,^AZHLWDIC("B",X,$P(^AZHLWDIC(0),U,3))="" L Q
CORRECT W !!,AZHLX,! F R " Replace ",AZHLX1:300 Q:AZHLX1="" Q:$F(AZHLX,AZHLX1) W *7,"??"
G:AZHLX1="" CORREND R " With ",AZHLX2:300
S AZHLX=$P(AZHLX,AZHLX1)_AZHLX2_$P(AZHLX,AZHLX1,2,99)
G CORRECT
CORREND S @(AZHLROOT_AZHLROOT(2)_AZHL_","_AZHLROOT(3)_")")=AZHLX,B=0 W !
Q
IGNORE S ^TMP($J,X)=""
Q
SUGGEST N B,C,D,DIC,DUOUT,E,F,G,I,L,W S DIC="^AZHLWDIC(",DIC(0)="EF",%=X
N X S X=% F Q:'$L(X)!($D(DUOUT)) D ^DIC Q:Y>0 S X=$E(X,1,$L(X)-1)
Q
SELS ;;10
;;PACKAGE: DESCRIPTION & WP Fields in 22;94^AZHLSCS1
;;HELP FRAMES: TEXT;92^AZHLSCS1
;;BULLETINS: SUBJECT/DESCRIPTION/MESSAGE;36^AZHLSCS1
;;OPTIONS: DESCRIPTION;19^AZHLSCS1
;;SECURITY KEY: DESCRIPTION;191^AZHLSCS1
;;INPUT TEMPLATEs: DESCRIPTION;INPUT^AZHLSCS1
;;SORT TEMPLATEs: DESCRIPTION;SORT^AZHLSCS1
;;PRINT TEMPLATEs: DESCRIPTION;PRINT^AZHLSCS1
;;FILE: DESCRIPTION;FILEDESC^AZHLSCS1
;;DDs: FIELD 'HELP'-PROMPT, DESCRIPTION, & TECH DESC.;DD^AZHLSCS1
AZHLSCS ; IHS/ADC/GTH:KEU - DSM SPELL CHECKER FOR VARIOUS FILES/FIELDS ; [ 11/24/97 10:55 AM ]
+1 ;;5.0;AZHLSC;;JUL 10, 1996
+2 ;
0 WRITE !!!?4,$PIECE($PIECE($TEXT(+1),";",2),"-",2)," v ",$PIECE($TEXT(+2),";",3),!
+1 IF 'AZHLPIEN
DO NPKG^AZHLSC
QUIT
+2 ;
1 WRITE !!?10
DO PKG^AZHLSC
+1 FOR %=1:1:$PIECE($TEXT(SELS),";",3)
WRITE !?10,$JUSTIFY(%,3)," ",$PIECE($TEXT(@"SELS"+%),";",3)
+2 READ !!?15,"Select : [A]ll // ",AZHLOPTN:300
IF '$TEST!(AZHLOPTN=U)
GOTO END
IF AZHLOPTN=""
SET AZHLOPTN="A"
+3 ;
DEVICE WRITE !!,"Report will be QUEUE'd if device other than HOME selected.",!
KILL IOP,%ZIS
SET %ZIS="NQM"
SET %ZIS("B")=""
DO ^%ZIS
KILL %ZIS
IF POP
WRITE !,*7,"No device specified."
GOTO END
+1 SET AZHLTERM=0
SET IOP=ION_";"_IOST_$SELECT($DATA(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
+2 IF IO=IO(0)
IF "C"[$EXTRACT(IOST)
IF $DATA(IO("Q"))#2
WRITE !,"Can't Q to home device."
KILL IO("Q")
GOTO DEVICE
+3 IF IO'=IO(0)
IF '$DATA(IO("Q"))
WRITE !!,"Report being QUEUE'd to run now for you."
SET IO("Q")=1
SET ZTDTH=$HOROLOG
+4 IF '$DATA(IO("Q"))
SET AZHLTERM=('$DATA(IO("S"))&(IO=IO(0)))
DO ^%ZIS
GOTO START
+5 SET ZTRTN="START^AZHLSCS"
SET ZTIO=IOP
SET ZTDESC="SPELL CHECK of "_AZHLNMSP_" package."
FOR G="AZHLOPTN","AZHLPIEN","AZHLNMSP","AZHLTERM"
SET ZTSAVE(G)=""
+6 KILL IO("Q")
DO ^%ZTLOAD
DO HOME^%ZIS
DEVEND KILL AZHLNMSP,AZHLPIEN,AZHLTERM,G,IOP,ZTSK
GOTO END
START ;EP - From TaskMan.
+1 USE IO
WRITE !!,"<<<<<<< DSM SPELL CHECKER >>>>>>>",!
DO PKG^AZHLSC
DO BEG^AZHLSC
+2 NEW AZHLX,AZHLX1,B,C,D,E,F,G,I,L,Q,W
DO END
SET Q=0
+3 IF AZHLOPTN="A"
Begin DoDot:1
+4 FOR AZHLOPTN=1:1:$PIECE($TEXT(SELS),";",3)
KILL D
DO @($PIECE($TEXT(SELS+AZHLOPTN),";",4))
IF Q
QUIT
+5 QUIT
End DoDot:1
GOTO QEND
+6 DO @($PIECE($TEXT(SELS+AZHLOPTN),";",4))
QEND WRITE !!!,"<< DSM SPELL CHECKER >>"
DO FIN^AZHLSC
DO END
+1 QUIT
+2 ;
END KILL ^TMP($JOB)
+1 QUIT
+2 ;
CHECK ;EP
+1 IF '$DATA(@(AZHLROOT(1)))
QUIT
SET C=+$PIECE(@(AZHLROOT(1)),U,4)
+2 FOR AZHL=1:1:C
IF $DATA(@(AZHLROOT_AZHLROOT(2)_AZHL_",0)"))
SET AZHLX=^(0)
DO CHK
IF Q
QUIT
+3 QUIT
+4 ;
CHK ;EP
+1 SET (B,E)=0
SET L=$LENGTH(AZHLX)
+2 FOR
DO GETWORD
IF X=""!Q
QUIT
IF AZHLTERM
WRITE "."
Begin DoDot:1
+3 IF $DATA(^AZHLWDIC("B",X))
QUIT
+4 IF $LENGTH(X)>2
IF $SELECT($EXTRACT(X,$LENGTH(X))'="S":0,$DATA(^($EXTRACT(X,1,$LENGTH(X)-1))):1,1:0)
QUIT
+5 IF $LENGTH(X)>3
IF $SELECT($EXTRACT(X,$LENGTH(X)-1,$LENGTH(X))'="ED":0,$DATA(^($EXTRACT(X,1,$LENGTH(X)-2))):1,1:0)
QUIT
+6 IF $LENGTH(X)>4
IF $SELECT($EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))'="ING":0,$DATA(^($EXTRACT(X,1,$LENGTH(X)-3))):1,1:0)
QUIT
+7 IF $DATA(^TMP($JOB,X))!$DATA(@("^"_X))
QUIT
+8 XECUTE ^%ZOSF("TEST")
IF $TEST
QUIT
+9 DO NOHIT
+10 QUIT
End DoDot:1
+11 QUIT
GETWORD ;
+1 IF Q
QUIT
SET G=0
SET X=" "
+2 FOR
IF B>L
SET X=""
IF X=""!G
QUIT
SET B=B+1
IF $EXTRACT(AZHLX,B)?1A
SET E=B
FOR
SET E=E+1
IF $EXTRACT(AZHLX,E)'?1A
SET X=$EXTRACT(AZHLX,B,E-1)
SET G=1
QUIT
+3 IF X]""
SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+4 SET B=E
+5 QUIT
NOHIT ;
+1 ;IHS/JN 11/21/97
IF '$DATA(D(3))
WRITE !!,"*** '",AZHLNMSP,"'; ",D," ",D(1)," "
IF $DATA(AZHLROOT)
WRITE AZHLROOT
IF $DATA(AZHLROOT(2))
WRITE AZHLROOT(2)
WRITE "; ",$SELECT($DATA(D(2)):"; "_D(2),1:""),!
SET D(3)=1
+2 ;IHS/JN 11/21/97
WRITE !,AZHLX,!,?10,"'",X,"' not found ",!
+3 ; I $D(ZTSK)!$D(IO("S")) W:($X>(IOM-19)) ! W X,$E(" ",1,20-$L(X)) G IGNORE ;IHS/JN 11/21/97
+4 ;IHS/JN 11/17/97
IF $DATA(ZTSK)!$DATA(IO("S"))
GOTO IGNORE
NOHIT1 WRITE *7,!,AZHLX,!,"'",X,"' not found in ",$PIECE(^AZHLWDIC(0),U),"""",!!
+1 FOR
READ "[A]dd, [C]orrect, [I]gnore, [S]uggestions, [Q]uit : ",*AZHL(2):300
SET AZHL(2)=$CHAR(AZHL(2))
IF "AaCcIiSsQq"[$EXTRACT(AZHL(2))
QUIT
WRITE !,"Please enter an 'A', 'C', 'I', 'S', or 'Q'.",!
+2 IF "Qq"[AZHL(2)
SET Q=1
QUIT
+3 IF "Aa"[AZHL(2)
DO ADD
IF "Cc"[AZHL(2)
DO CORRECT
IF "Ii"[AZHL(2)
DO IGNORE
+4 IF "Ss"'[AZHL(2)
QUIT
+5 DO SUGGEST
+6 GOTO NOHIT1
+7 ;
ADD LOCK +^AZHLWDIC(0):10
IF '$TEST
QUIT
SET $PIECE(^(0),U,3)=$PIECE(^AZHLWDIC(0),U,3)+1
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
LOCK ^AZHLWDIC($PIECE(^(0),U,3),0)
SET ^AZHLWDIC($PIECE(^(0),U,3),0)=X
SET ^AZHLWDIC("B",X,$PIECE(^AZHLWDIC(0),U,3))=""
LOCK
QUIT
CORRECT WRITE !!,AZHLX,!
FOR
READ " Replace ",AZHLX1:300
IF AZHLX1=""
QUIT
IF $FIND(AZHLX,AZHLX1)
QUIT
WRITE *7,"??"
+1 IF AZHLX1=""
GOTO CORREND
READ " With ",AZHLX2:300
+2 SET AZHLX=$PIECE(AZHLX,AZHLX1)_AZHLX2_$PIECE(AZHLX,AZHLX1,2,99)
+3 GOTO CORRECT
CORREND SET @(AZHLROOT_AZHLROOT(2)_AZHL_","_AZHLROOT(3)_")")=AZHLX
SET B=0
WRITE !
+1 QUIT
IGNORE SET ^TMP($JOB,X)=""
+1 QUIT
SUGGEST NEW B,C,D,DIC,DUOUT,E,F,G,I,L,W
SET DIC="^AZHLWDIC("
SET DIC(0)="EF"
SET %=X
+1 NEW X
SET X=%
FOR
IF '$LENGTH(X)!($DATA(DUOUT))
QUIT
DO ^DIC
IF Y>0
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+2 QUIT
SELS ;;10
+1 ;;PACKAGE: DESCRIPTION & WP Fields in 22;94^AZHLSCS1
+2 ;;HELP FRAMES: TEXT;92^AZHLSCS1
+3 ;;BULLETINS: SUBJECT/DESCRIPTION/MESSAGE;36^AZHLSCS1
+4 ;;OPTIONS: DESCRIPTION;19^AZHLSCS1
+5 ;;SECURITY KEY: DESCRIPTION;191^AZHLSCS1
+6 ;;INPUT TEMPLATEs: DESCRIPTION;INPUT^AZHLSCS1
+7 ;;SORT TEMPLATEs: DESCRIPTION;SORT^AZHLSCS1
+8 ;;PRINT TEMPLATEs: DESCRIPTION;PRINT^AZHLSCS1
+9 ;;FILE: DESCRIPTION;FILEDESC^AZHLSCS1
+10 ;;DDs: FIELD 'HELP'-PROMPT, DESCRIPTION, & TECH DESC.;DD^AZHLSCS1
