AZHLSC.m

AZHLSC ; IHS/ADC/GTH:KEU:JN - DRIVER FOR SAC CHECKER ;  [ 07/01/1999  7:05 AM ]

 ;;5.0;AZHLSC;;JUL 10, 1996

 ;

 ; New to 4.3X:

 ; 1) Changed message in techniques:

 ;   ;If checking for background, $D(ZTQUEUED) recommended instead of $D(ZTSK).

 ; 2) Added check of 4-slash-stuff of .01 field to AZHLSCT.

 ;

 NEW AZHL,AZHLNMSP,AZHLPIEN,AZHLROOT,AZHLTERM,AZHLOPTN,DIC,DIK

 ;

 D HOME^%ZIS

 S:$D(DUZ)#2-1 DUZ=0 S:$D(DUZ(0))#2-1 DUZ(0)=""

 I '$D(DTIME) S DTIME=999

 K %DT D NOW^%DTC S DT=X,U="^"

 ;

0 W !!!?4,$P($T(@"AZHLSC"+1),";",4)," v ",$P($T(@"AZHLSC"+1),";",3),!

 D EN^AZHLSCA I AZHLSC4I=1 G 01

 X ^%ZOSF("RSEL")

01 K AZHLSC4I S Y=0 I $D(^DIC(9.4)) S DIC=9.4,DIC(0)="AEMNQZ" D ^DIC

 I Y<1,$O(^UTILITY($J,""))="" Q

 S (AZHLROOT,AZHLNMSP,AZHLPIEN)=""

 I Y>0 S AZHLROOT=DIC_+Y_",",AZHLNMSP=$P(Y(0),U,2),AZHLPIEN=+Y

 ;

1 W !!?10 D PKG

2 F I=1:1:3,16:1:19 W !?10,$J(I,3),"   ",$P($T(@"RTNS"+I),";",4)

 R !!?15,"Select :  16 // ",AZHLOPTN:DTIME G:'$T!(AZHLOPTN=U) END S:AZHLOPTN="" AZHLOPTN=16

 F AZHLOPTN(1)=1:1:3,16:1:19 I AZHLOPTN=AZHLOPTN(1) G DEVICE:AZHLOPTN(1)<17 D ^AZHLSCS:AZHLOPTN(1)=17,^AZHLSCFV:AZHLOPTN(1)=18,^AZHLSCT:AZHLOPTN(1)=19 G 0

 W "  ??",*7 G 0

 ;

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^AZHLSC",ZTIO=IOP,ZTDESC="SAC of "_AZHLNMSP_" package." F G="AZHLOPTN","AZHLPIEN","AZHLNMSP","AZHLTERM","^UTILITY($J," S ZTSAVE(G)=""

 K IO("Q") D ^%ZTLOAD,HOME^%ZIS

END K ^UTILITY($J),AZHLGFCX,ZTSK,IOP,%ZIS,^TMP($J)

 Q

START ;EP - From TaskMan

 D GFCX

 U IO W !!,"*+*+*+*   IHS STANDARDS AND CONVENTIONS (SAC)   *+*+*+*",! D PKG,BEG

 I AZHLOPTN=16 D  G ST1

 .F AZHLOPTN=1:1:3 D @("^AZHLSC"_AZHLOPTN)

 .Q

 D @("^AZHLSC"_AZHLOPTN)

ST1 W !!!,$P($T(@"AZHLSC"+1),";",4)," v ",$P($T(@"AZHLSC"+1),";",3) D FIN

 I $D(ZTSK) S ZTREQ="@" K AZHLGFCX Q

 D END

 G 0

GFCX ;EP

 S AZHLGFCX="I $T(+1)'[""GENERATED FROM"",$T(+1)'[""COMPILED XREF"",$P($T(+1),"" "",2,99)'?1""; ;""2N1""/""2N1""/""2N.E"

 Q

PKG ;EP

 G:'$D(AZHLPIEN) P1 I 'AZHLPIEN W !,"PACKAGE not selected.",!

 E  W !,"Package : ",AZHLNMSP," - ",$P(^DIC(9.4,$O(^DIC(9.4,"C",AZHLNMSP,0)),0),U),", v ",$S($D(^DIC(9.4,$O(^DIC(9.4,"C",AZHLNMSP,0)),"VERSION")):^("VERSION"),1:"none"),!

P1 W ! S %="" F  S %=$O(^UTILITY($J,%)) Q:%=""  W $E(%_"          ",1,10) W:$X>(IOM-9) !

 Q

BEG ;EP

 W !,"Beginning " D DD W !!

 Q

FIN ;EP

 W " completed " D DD

 W:"C"'[$E(IOST) @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 Q

NPKG ;EP

 W !?10,"Not checked.  No PACKAGE selected."

 Q

NRTN ;EP

 W !?10,"Not checked.  No routines selected."

 Q

TTL(X) ;EP

 W !!,X,!,$E("------------------------------------------------------------------",1,$L(X))

 Q

DD D NOW^%DTC S Y=$P("JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"," ",$S($E(%,4,5):$E(%,4,5),1:0))_" "_$S($E(%,6,7):$E(%,6,7)_", ",1:"")_($E(%,1,3)+1700)_$S(%[".":"."_$P(%,".",2),1:"")

 I Y["." S Y=$P(Y,".")_"@"_$E(Y_0,14,15)_":"_$E(Y_"000",16,17)_$S($E(Y,18,19):":"_$E(Y_0,18,19),1:"")

 W Y,!

 Q

RTNS ;

 ;;1;GENERAL PROGRAMMING STANDARDS & CONVENTIONS

 ;;2;M LANGUAGE PROGRAMMING STANDARDS & CONVENTIONS

 ;;3;INTERFACE PROGRAMMING STANDARDS & CONVENTIONS

 ;;4;;

 ;;5;;

 ;;6;

 ;;7;

 ;;8;

 ;;9;

 ;;10;

 ;;11;

 ;;12;

 ;;13;

 ;;14;

 ;;

 ;;;ALL SACs (All The Above)

 ;;;Spell Checker

 ;;;Q-Able Field Verifier

 ;;;Techniques

AZHLSC    ; IHS/ADC/GTH:KEU:JN - DRIVER FOR SAC CHECKER ;  [ 07/01/1999  7:05 AM ]

 +1       ;;5.0;AZHLSC;;JUL 10, 1996

 +2       ;

 +3       ; New to 4.3X:

 +4       ; 1) Changed message in techniques:

 +5       ;   ;If checking for background, $D(ZTQUEUED) recommended instead of $D(ZTSK).

 +6       ; 2) Added check of 4-slash-stuff of .01 field to AZHLSCT.

 +7       ;

 +8        NEW AZHL,AZHLNMSP,AZHLPIEN,AZHLROOT,AZHLTERM,AZHLOPTN,DIC,DIK

 +9       ;

 +10       DO HOME^%ZIS

 +11       IF $DATA(DUZ)#2-1

               SET DUZ=0

           IF $DATA(DUZ(0))#2-1

               SET DUZ(0)=""

 +12       IF '$DATA(DTIME)

               SET DTIME=999

 +13       KILL %DT

           DO NOW^%DTC

           SET DT=X

           SET U="^"

 +14      ;

0          WRITE !!!?4,$PIECE($TEXT(@"AZHLSC"+1),";",4)," v ",$PIECE($TEXT(@"AZHLSC"+1),";",3),!

 +1        DO EN^AZHLSCA

           IF AZHLSC4I=1

               GOTO 01

 +2        XECUTE ^%ZOSF("RSEL")

01         KILL AZHLSC4I

           SET Y=0

           IF $DATA(^DIC(9.4))

               SET DIC=9.4

               SET DIC(0)="AEMNQZ"

               DO ^DIC

 +1        IF Y<1

               IF $ORDER(^UTILITY($JOB,""))=""

                   QUIT 

 +2        SET (AZHLROOT,AZHLNMSP,AZHLPIEN)=""

 +3        IF Y>0

               SET AZHLROOT=DIC_+Y_","

               SET AZHLNMSP=$PIECE(Y(0),U,2)

               SET AZHLPIEN=+Y

 +4       ;

1          WRITE !!?10

           DO PKG

2          FOR I=1:1:3,16:1:19

               WRITE !?10,$JUSTIFY(I,3),"   ",$PIECE($TEXT(@"RTNS"+I),";",4)

 +1        READ !!?15,"Select :  16 // ",AZHLOPTN:DTIME

           IF '$TEST!(AZHLOPTN=U)

               GOTO END

           IF AZHLOPTN=""

               SET AZHLOPTN=16

 +2        FOR AZHLOPTN(1)=1:1:3,16:1:19

               IF AZHLOPTN=AZHLOPTN(1)

                   IF AZHLOPTN(1)<17

                       GOTO DEVICE

                   IF AZHLOPTN(1)=17

                       DO ^AZHLSCS

                   IF AZHLOPTN(1)=18

                       DO ^AZHLSCFV

                   IF AZHLOPTN(1)=19

                       DO ^AZHLSCT

                   GOTO 0

 +3        WRITE "  ??",*7

           GOTO 0

 +4       ;

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^AZHLSC"

           SET ZTIO=IOP

           SET ZTDESC="SAC of "_AZHLNMSP_" package."

           FOR G="AZHLOPTN","AZHLPIEN","AZHLNMSP","AZHLTERM","^UTILITY($J,"

               SET ZTSAVE(G)=""

 +6        KILL IO("Q")

           DO ^%ZTLOAD

           DO HOME^%ZIS

END        KILL ^UTILITY($JOB),AZHLGFCX,ZTSK,IOP,%ZIS,^TMP($JOB)

 +1        QUIT 

START     ;EP - From TaskMan

 +1        DO GFCX

 +2        USE IO

           WRITE !!,"*+*+*+*   IHS STANDARDS AND CONVENTIONS (SAC)   *+*+*+*",!

           DO PKG

           DO BEG

 +3        IF AZHLOPTN=16

               Begin DoDot:1

 +4                FOR AZHLOPTN=1:1:3

                       DO @("^AZHLSC"_AZHLOPTN)

 +5                QUIT 

               End DoDot:1

               GOTO ST1

 +6        DO @("^AZHLSC"_AZHLOPTN)

ST1        WRITE !!!,$PIECE($TEXT(@"AZHLSC"+1),";",4)," v ",$PIECE($TEXT(@"AZHLSC"+1),";",3)

           DO FIN

 +1        IF $DATA(ZTSK)

               SET ZTREQ="@"

               KILL AZHLGFCX

               QUIT 

 +2        DO END

 +3        GOTO 0

GFCX      ;EP

 +1        SET AZHLGFCX="I $T(+1)'[""GENERATED FROM"",$T(+1)'[""COMPILED XREF"",$P($T(+1),"" "",2,99)'?1""; ;""2N1""/""2N1""/""2N.E"

 +2        QUIT 

PKG       ;EP

 +1        IF '$DATA(AZHLPIEN)

               GOTO P1

           IF 'AZHLPIEN

               WRITE !,"PACKAGE not selected.",!

 +2       IF '$TEST

               WRITE !,"Package : ",AZHLNMSP," - ",$PIECE(^DIC(9.4,$ORDER(^DIC(9.4,"C",AZHLNMSP,0)),0),U),", v ",$SELECT($DATA(^DIC(9.4,$ORDER(^DIC(9.4,"C",AZHLNMSP,0)),"VERSION")):^("VERSION"),1:"none"),!

P1         WRITE !

           SET %=""

           FOR 

               SET %=$ORDER(^UTILITY($JOB,%))

               IF %=""

                   QUIT 

               WRITE $EXTRACT(%_"          ",1,10)

               IF $X>(IOM-9)

                   WRITE !

 +1        QUIT 

BEG       ;EP

 +1        WRITE !,"Beginning "

           DO DD

           WRITE !!

 +2        QUIT 

FIN       ;EP

 +1        WRITE " completed "

           DO DD

 +2        IF "C"'[$EXTRACT(IOST)

               WRITE @IOF

           DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT 

NPKG      ;EP

 +1        WRITE !?10,"Not checked.  No PACKAGE selected."

 +2        QUIT 

NRTN      ;EP

 +1        WRITE !?10,"Not checked.  No routines selected."

 +2        QUIT 

TTL(X)    ;EP

 +1        WRITE !!,X,!,$EXTRACT("------------------------------------------------------------------",1,$LENGTH(X))

 +2        QUIT 

DD         DO NOW^%DTC

           SET Y=$PIECE("JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"," ",$SELECT($EXTRACT(%,4,5):$EXTRACT(%,4,5),1:0))_" "_$SELECT($EXTRACT(%,6,7):$EXTRACT(%,6,7)_", ",1:"")_($EXTRACT(%,1,3)+1700)_$SELECT(%[".":"."_$PIECE(%,".",2),1:"")

 +1        IF Y["."

               SET Y=$PIECE(Y,".")_"@"_$EXTRACT(Y_0,14,15)_":"_$EXTRACT(Y_"000",16,17)_$SELECT($EXTRACT(Y,18,19):":"_$EXTRACT(Y_0,18,19),1:"")

 +2        WRITE Y,!

 +3        QUIT 

RTNS      ;

 +1       ;;1;GENERAL PROGRAMMING STANDARDS & CONVENTIONS

 +2       ;;2;M LANGUAGE PROGRAMMING STANDARDS & CONVENTIONS

 +3       ;;3;INTERFACE PROGRAMMING STANDARDS & CONVENTIONS

 +4       ;;4;;

 +5       ;;5;;

 +6       ;;6;

 +7       ;;7;

 +8       ;;8;

 +9       ;;9;

 +10      ;;10;

 +11      ;;11;

 +12      ;;12;

 +13      ;;13;

 +14      ;;14;

 +15      ;;

 +16      ;;;ALL SACs (All The Above)

 +17      ;;;Spell Checker

 +18      ;;;Q-Able Field Verifier

 +19      ;;;Techniques