Routine: AZHLSCS

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

END K ^TMP($J)

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

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

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

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 !

IGNORE S ^TMP($J,X)=""

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)

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

AZHLSCS.m