AZHLSCA.m

AZHLSCA ;IHS/ADC/GTH:KEU:JGN - SELECT INSTALL FILE ROUTINES ;  [ 10/05/1999  2:16 PM ]

 ;;5.0;AZHLSC;;JUNE 29, 1999

 ; DIC WILL SELECT THE INSTALL FILE, ROUTINES ARE RETREIVED AND PLACED IN THE ^UTILITY($J,ROUTINE)="" FILE

EN K ^UTILITY($J),^TMP($J,"Z"),I,AZHLSCRE,AZHLSCR2,AZHLSCR3,AZHLPAT,AZHLPATS,DTOUT,DUOUT,AZHLNF S (AZHLSCR1,AZHLSC4I)=0

 ;DIR TO READ INSTALL FILE OR USE %RSEL TO READ ALL ROUTINES

 ;

 S DIR(0)="Y",DIR("A")="SAC CHK, SELECT INSTALL FILE ROUTINES //YES ",DIR("B")="Y" D ^DIR G:Y="^"!(Y="") SELROUTI I Y(0)="NO" G SELROUTI I $D(DTOUT)!$D(DUOUT) G SELROUTI

 W !

 K DIC("A"),Y,DIR("B")

 S DIC(0)="EAQ",DIC="^XPD(9.7," D ^DIC S AZHLSCRE=$P(Y,"^",1)

 I Y=-1!($P(Y,"^",1)="") G SELROUTI

 W !

 ;SELECT BY PATCH NUMBER OR HIT RETURN SELECTS ALL ROUTINES IN INSTALL FILE

 ;

 S DIR(0)="NO^1:9999",DIR("A")="ENTER ONE PATCH NUMBER OR HIT RETURN(ALL ROUTINES)" D ^DIR I Y="" G ALLROUTI

 I Y="^" G SELROUTI

 W !

PATCHROU I Y>0 S AZHLPAT=Y D SELPATCH I AZHLSC4I=1 G SELROUTI

 I Y=0 G ALLROUTI

 ;AZHLNF  = 1 PATCH FOUND

 I '$D(AZHLNF) G SELPATI

 ;

ALLROUTI K DIC("A"),Y,DIR("B")

 ;USE COUNT OF ROUTINES IN  O NODE PIECE 4 TO TERMINATE LOOP

 S AZHLSCR3=$P($G(^XPD(9.7,AZHLSCRE,"RTN",0)),"^",4) G:AZHLSCR3=0 SELROUTI

 ;SEARCH FOR ALL ROUTINES IN INSTALL FILE

 ;

 F I=1:1:AZHLSCR3 S AZHLSCR1=$O(^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1)) Q:AZHLSCR1="B"  S AZHLSCR2=^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1,0),^UTILITY($J,AZHLSCR2)="" 

 I AZHLSCRE="" G SELROUTI ; DO NOT SET AZHLSC4I IF ROUTINES NOT SELECTED

 ;          AZHLSC4I = 0 SELECT ROUTINES %RSEL 

 ;          AZHLSC4I = 1 SELECTED ROUTINES FROM INSTALL FILE

 S AZHLSC4I=1

SELROUTI ;

 K DIC("A"),Y,DIR("B"),AZHLSCREC,AZHLSCR2,AZHLSCR3,AZHLSCR1,DTOUT,DUOUT,AZHLSCNF

 Q

SELPATCH ; SELECT ROUTINES BY PATCH NUMBER FROM INSTALL FILE

 ;USE COUNT OF ROUTINES O NODE PIECE 4 TO TERMINATE LOOP

 S AZHLSCR3=$P($G(^XPD(9.7,AZHLSCRE,"RTN",0)),"^",4) Q:AZHLSCR3=0 

 ;SELECT ROUTINES IN INSTALL FILES TO SEARCH FOR PATCH NUMBER

 ;

 F I=1:1:AZHLSCR3 S AZHLSCR1=$O(^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1)) Q:AZHLSCR1="B"  S AZHLSCR2=^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1,0) D SECLINE

 Q

SELPATI ;

 I AZHLSC4I=1 G ENDPATCH

 W !,"PATCH NUMBER (",AZHLPAT,") NOT FOUND, TO CONTINUE SELECT ROUTINES",!

ENDPATCH Q

 ;READ ROUTINE INTO ^TMP($J,"Z") TO CHECK SEC LINE FOR PATCH NUMBER

 ;

SECLINE ;SEARCH FOR PATCH NUMBER IN SECOND LINE OF ROUTINE

 S X=AZHLSCR2,XCNP=0,DIF="^TMP($J,""Z"","

 X ^%ZOSF("LOAD")

 ;VARIABLE AZHLPATS IS SET TO PATCH NUMBERS IN PIECE FIVE OF RECORD

 S AZHLPATS=$P($G(^TMP($J,"Z",2,0)),";",5) G:AZHLPATS="" PATEND S AZHLPATS=$P(AZHLPATS,"**",2)_",0"

 F II=1:1 D:AZHLPAT=$P(AZHLPATS,",",II) UTILIREC Q:$P(AZHLPATS,",",II)=0

PATEND ;NO PATCH FOUND IN PATCH PIECE

 ; AZHLSCNF = 1 PATCH NOT FOUND

 ;

 I AZHLSC4I=0 S AZHLSCNF=1

 Q

 ;

 ;SET ROUTINE NAME IN ^UTILITY($J,ROUTINE NAME) TO PASS TO SAC CHECKER

 ;

UTILIREC ;  SET ROUTINE RECORD TO BE PASSED TO ^AZHLSC

 ;          AZHLSC4I = 0 SELECT ROUTINES %RSEL 

 ;          AZHLSC4I = 1 SELECTED ROUTINES FROM INSTALL FILE

 S ^UTILITY($J,AZHLSCR2)="",AZHLSC4I=1 Q

AZHLSCA   ;IHS/ADC/GTH:KEU:JGN - SELECT INSTALL FILE ROUTINES ;  [ 10/05/1999  2:16 PM ]

 +1       ;;5.0;AZHLSC;;JUNE 29, 1999

 +2       ; DIC WILL SELECT THE INSTALL FILE, ROUTINES ARE RETREIVED AND PLACED IN THE ^UTILITY($J,ROUTINE)="" FILE

EN         KILL ^UTILITY($JOB),^TMP($JOB,"Z"),I,AZHLSCRE,AZHLSCR2,AZHLSCR3,AZHLPAT,AZHLPATS,DTOUT,DUOUT,AZHLNF

           SET (AZHLSCR1,AZHLSC4I)=0

 +1       ;DIR TO READ INSTALL FILE OR USE %RSEL TO READ ALL ROUTINES

 +2       ;

 +3        SET DIR(0)="Y"

           SET DIR("A")="SAC CHK, SELECT INSTALL FILE ROUTINES //YES "

           SET DIR("B")="Y"

           DO ^DIR

           IF Y="^"!(Y="")

               GOTO SELROUTI

           IF Y(0)="NO"

               GOTO SELROUTI

               IF $DATA(DTOUT)!$DATA(DUOUT)

                   GOTO SELROUTI

 +4        WRITE !

 +5        KILL DIC("A"),Y,DIR("B")

 +6        SET DIC(0)="EAQ"

           SET DIC="^XPD(9.7,"

           DO ^DIC

           SET AZHLSCRE=$PIECE(Y,"^",1)

 +7        IF Y=-1!($PIECE(Y,"^",1)="")

               GOTO SELROUTI

 +8        WRITE !

 +9       ;SELECT BY PATCH NUMBER OR HIT RETURN SELECTS ALL ROUTINES IN INSTALL FILE

 +10      ;

 +11       SET DIR(0)="NO^1:9999"

           SET DIR("A")="ENTER ONE PATCH NUMBER OR HIT RETURN(ALL ROUTINES)"

           DO ^DIR

           IF Y=""

               GOTO ALLROUTI

 +12       IF Y="^"

               GOTO SELROUTI

 +13       WRITE !

PATCHROU   IF Y>0

               SET AZHLPAT=Y

               DO SELPATCH

               IF AZHLSC4I=1

                   GOTO SELROUTI

 +1        IF Y=0

               GOTO ALLROUTI

 +2       ;AZHLNF  = 1 PATCH FOUND

 +3        IF '$DATA(AZHLNF)

               GOTO SELPATI

 +4       ;

ALLROUTI   KILL DIC("A"),Y,DIR("B")

 +1       ;USE COUNT OF ROUTINES IN  O NODE PIECE 4 TO TERMINATE LOOP

 +2        SET AZHLSCR3=$PIECE($GET(^XPD(9.7,AZHLSCRE,"RTN",0)),"^",4)

           IF AZHLSCR3=0

               GOTO SELROUTI

 +3       ;SEARCH FOR ALL ROUTINES IN INSTALL FILE

 +4       ;

 +5        FOR I=1:1:AZHLSCR3

               SET AZHLSCR1=$ORDER(^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1))

               IF AZHLSCR1="B"

                   QUIT 

               SET AZHLSCR2=^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1,0)

               SET ^UTILITY($JOB,AZHLSCR2)=""

 +6       ; DO NOT SET AZHLSC4I IF ROUTINES NOT SELECTED

           IF AZHLSCRE=""

               GOTO SELROUTI

 +7       ;          AZHLSC4I = 0 SELECT ROUTINES %RSEL 

 +8       ;          AZHLSC4I = 1 SELECTED ROUTINES FROM INSTALL FILE

 +9        SET AZHLSC4I=1

SELROUTI  ;

 +1        KILL DIC("A"),Y,DIR("B"),AZHLSCREC,AZHLSCR2,AZHLSCR3,AZHLSCR1,DTOUT,DUOUT,AZHLSCNF

 +2        QUIT 

SELPATCH  ; SELECT ROUTINES BY PATCH NUMBER FROM INSTALL FILE

 +1       ;USE COUNT OF ROUTINES O NODE PIECE 4 TO TERMINATE LOOP

 +2        SET AZHLSCR3=$PIECE($GET(^XPD(9.7,AZHLSCRE,"RTN",0)),"^",4)

           IF AZHLSCR3=0

               QUIT 

 +3       ;SELECT ROUTINES IN INSTALL FILES TO SEARCH FOR PATCH NUMBER

 +4       ;

 +5        FOR I=1:1:AZHLSCR3

               SET AZHLSCR1=$ORDER(^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1))

               IF AZHLSCR1="B"

                   QUIT 

               SET AZHLSCR2=^XPD(9.7,AZHLSCRE,"RTN",AZHLSCR1,0)

               DO SECLINE

 +6        QUIT 

SELPATI   ;

 +1        IF AZHLSC4I=1

               GOTO ENDPATCH

 +2        WRITE !,"PATCH NUMBER (",AZHLPAT,") NOT FOUND, TO CONTINUE SELECT ROUTINES",!

ENDPATCH   QUIT 

 +1       ;READ ROUTINE INTO ^TMP($J,"Z") TO CHECK SEC LINE FOR PATCH NUMBER

 +2       ;

SECLINE   ;SEARCH FOR PATCH NUMBER IN SECOND LINE OF ROUTINE

 +1        SET X=AZHLSCR2

           SET XCNP=0

           SET DIF="^TMP($J,""Z"","

 +2        XECUTE ^%ZOSF("LOAD")

 +3       ;VARIABLE AZHLPATS IS SET TO PATCH NUMBERS IN PIECE FIVE OF RECORD

 +4        SET AZHLPATS=$PIECE($GET(^TMP($JOB,"Z",2,0)),";",5)

           IF AZHLPATS=""

               GOTO PATEND

           SET AZHLPATS=$PIECE(AZHLPATS,"**",2)_",0"

 +5        FOR II=1:1

               IF AZHLPAT=$PIECE(AZHLPATS,",",II)

                   DO UTILIREC

               IF $PIECE(AZHLPATS,",",II)=0

                   QUIT 

PATEND    ;NO PATCH FOUND IN PATCH PIECE

 +1       ; AZHLSCNF = 1 PATCH NOT FOUND

 +2       ;

 +3        IF AZHLSC4I=0

               SET AZHLSCNF=1

 +4        QUIT 

 +5       ;

 +6       ;SET ROUTINE NAME IN ^UTILITY($J,ROUTINE NAME) TO PASS TO SAC CHECKER

 +7       ;

UTILIREC  ;  SET ROUTINE RECORD TO BE PASSED TO ^AZHLSC

 +1       ;          AZHLSC4I = 0 SELECT ROUTINES %RSEL 

 +2       ;          AZHLSC4I = 1 SELECTED ROUTINES FROM INSTALL FILE

 +3        SET ^UTILITY($JOB,AZHLSCR2)=""

           SET AZHLSC4I=1

           QUIT