Routine: AUM9115

AUM9115 ; IHS/RPMSDBA/GTH - STANDARD TABLE UPDATES, 2000JUL21 ; [ 07/27/2000  10:47 AM ]

 ;;99.1;TABLE MAINTENANCE;**15**;NOV 6,1998

 I '$G(DUZ) W !,"DUZ UNDEFINED OR ZERO.",! Q

 D HOME^%ZIS,DT^DICRW,VP,HELP("INTRO")

 S (DIR(0),DIR("B"))="Y"

 S DIR("A")="Do you want to queue the update to TaskMan"

 S DIR("??")="^D HELP^AUM9115(""Q2"")"

 D ^DIR

 KILL DIR

 I $D(DIRUT) D HELP("Q2") Q

 G START:'Y

QUE ;

 S %DT="AERSX",%DT("A")="Requested Start Time: ",%DT("B")="T@2015",%DT(0)="NOW"

 D ^%DT

 I Y<1 W !,"QUEUE INFORMATION MISSING - NOT QUEUED" D HELP("Q2") G AUM9115

 S X=+Y

 D H^%DTC

 S ZTDTH=%H_","_%T

 S ZTRTN="START^AUM9115",ZTIO="",ZTDESC=$P($P($T(+1),";",2)," ",4,99)

 D ^%ZTLOAD,HOME^%ZIS

 I $D(ZTSK) W !!,"QUEUED TO TASK ",ZTSK,!!,"A mail message with the results will be sent to your MailMan 'IN' basket.",!

 E  W !!,*7,"QUEUE UNSUCCESSFUL.  RESTART UTILITY."

START ;EP - From Taskman

 NEW XMSUB,XMDUZ,XMTEXT,XMY

 KILL ^TMP("AUM9115",$J)

 D START^AUM91151

 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$G(DUZ,.5),XMTEXT="^TMP(""AUM9115"",$J,",XMY(DUZ)=""

 F %="XUPROGMODE","AG TM MENU","ABMDZ TABLE MAINTENANCE","APCCZMGR" D SINGLE(%)

 D ^XMD

 KILL ^TMP("AUM9115",$J)

 I $D(ZTQUEUED) S ZTREQ="@" G DEL^A9AUM15

 W !!,"The results are in your MailMan 'IN' basket.",!

 I $L($T(DIR^XBDIR)),$$DIR^XBDIR("Y","Want me to delete the routines in this patch","Y") G DEL^A9AUM15

INTRO ;EP - To write to mail message, too.

 ;;This updates standard tables according to the changes specified in

 ;;the message from Joe Herrera, with subject "Standard Code Book

 ;;modifications", released on Fri 7/21/00.  Please consult that

 ;;message, and the local RPMS mail message produced by this update.

;;

 ;;Additionally, a domain name is added to the DOMAIN file.

;;

 ;;###;NOTE:  This line indicates the end of the message.

Q2 ;

 ;;Answer "Y" if you want to queue this standard table update to TaskMan.

 ;;Answer "N" if you want to run this update interactively.

;;

 ;;If you run interactively, results will be displayed on your screen,

 ;;as well as in the mail message sent to you and user 1.  If you queue

 ;;to TaskMan, please read the mail message for results of this update.

 ;;###;NOTE:  This line indicates the end of the message.

HELP(L) ;EP - Display text at label L.

W !

 F %=1:1 W !?4,$P($T(@L+%),";",3) Q:$P($T(@L+%+1),";",3)="###"

SINGLE(K) ; Get holders of a single key K.

 NEW Y

 S Y=0

 Q:'$D(^XUSEC(K))

 F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""

VP ;

 W !?4,"****    AUM Version ",$P($T(+2),";",3)," Patch ",$P($P($T(+2),";",5),"*",3),?65,"****"

 W !?4,"****   ",$P($P($T(+1),";",2),"-",2),?65,"****"

GREET ;;EP - To add to mail message.

;;

 ;;Greetings.

;;

 ;;Standard tables on your RPMS system have been updated.

;;

 ;;You are receiving this message because of the particular RPMS

 ;;security keys that you hold.  This is for your information, only.

 ;;You need do nothing in response to this message.

;;

 ;;Requests for modifications or additions to RPMS standard tables,

 ;;whether they are or are not reflected in the IHS Standard Code

 ;;Book (SCB), can be submitted to your Area Information System

 ;;Coordinator (ISC).

;;

 ;;Questions about this patch, which is a product of the RPMS/DBA

 ;;Team, can be directed to the Help Desk

 ;;.  Please

 ;;refer to patch "AUM*99.1*15".

;;

 ;;###;NOTE: This line indicates the end of text in this message.

AUM9115   ; IHS/RPMSDBA/GTH - STANDARD TABLE UPDATES, 2000JUL21 ; [ 07/27/2000  10:47 AM ]

 +1       ;;99.1;TABLE MAINTENANCE;**15**;NOV 6,1998

 +2       ;

 +3        IF '$GET(DUZ)

               WRITE !,"DUZ UNDEFINED OR ZERO.",!

               QUIT

 +4        DO HOME^%ZIS

           DO DT^DICRW

           DO VP

           DO HELP("INTRO")

 +5        SET (DIR(0),DIR("B"))="Y"

 +6        SET DIR("A")="Do you want to queue the update to TaskMan"

 +7        SET DIR("??")="^D HELP^AUM9115(""Q2"")"

 +8        DO ^DIR

 +9        KILL DIR

 +10       IF $DATA(DIRUT)

               DO HELP("Q2")

               QUIT

 +11       IF 'Y

               GOTO START

QUE       ;

 +1        SET %DT="AERSX"

           SET %DT("A")="Requested Start Time: "

           SET %DT("B")="T@2015"

           SET %DT(0)="NOW"

 +2        DO ^%DT

 +3        IF Y<1

               WRITE !,"QUEUE INFORMATION MISSING - NOT QUEUED"

               DO HELP("Q2")

               GOTO AUM9115

 +4        SET X=+Y

 +5        DO H^%DTC

 +6        SET ZTDTH=%H_","_%T

 +7        SET ZTRTN="START^AUM9115"

           SET ZTIO=""

           SET ZTDESC=$PIECE($PIECE($TEXT(+1),";",2)," ",4,99)

 +8        DO ^%ZTLOAD

           DO HOME^%ZIS

 +9        IF $DATA(ZTSK)

               WRITE !!,"QUEUED TO TASK ",ZTSK,!!,"A mail message with the results will be sent to your MailMan 'IN' basket.",!

 +10      IF '$TEST

               WRITE !!,*7,"QUEUE UNSUCCESSFUL.  RESTART UTILITY."

 +11       QUIT

 +12      ;

START     ;EP - From Taskman

 +1       ;

 +2        NEW XMSUB,XMDUZ,XMTEXT,XMY

 +3        KILL ^TMP("AUM9115",$JOB)

 +4        DO START^AUM91151

 +5        SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",4,99)

           SET XMDUZ=$GET(DUZ,.5)

           SET XMTEXT="^TMP(""AUM9115"",$J,"

           SET XMY(DUZ)=""

 +6        FOR %="XUPROGMODE","AG TM MENU","ABMDZ TABLE MAINTENANCE","APCCZMGR"

               DO SINGLE(%)

 +7        DO ^XMD

 +8        KILL ^TMP("AUM9115",$JOB)

 +9        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               GOTO DEL^A9AUM15

 +10       WRITE !!,"The results are in your MailMan 'IN' basket.",!

 +11       IF $LENGTH($TEXT(DIR^XBDIR))

               IF $$DIR^XBDIR("Y","Want me to delete the routines in this patch","Y")

                   GOTO DEL^A9AUM15

 +12       QUIT

 +13      ;

INTRO     ;EP - To write to mail message, too.

 +1       ;;This updates standard tables according to the changes specified in

 +2       ;;the message from Joe Herrera, with subject "Standard Code Book

 +3       ;;modifications", released on Fri 7/21/00.  Please consult that

 +4       ;;message, and the local RPMS mail message produced by this update.

 +5       ;;

 +6       ;;Additionally, a domain name is added to the DOMAIN file.

 +7       ;;

 +8       ;;###;NOTE:  This line indicates the end of the message.

 +9       ;

Q2        ;

 +1       ;;Answer "Y" if you want to queue this standard table update to TaskMan.

 +2       ;;Answer "N" if you want to run this update interactively.

 +3       ;;

 +4       ;;If you run interactively, results will be displayed on your screen,

 +5       ;;as well as in the mail message sent to you and user 1.  If you queue

 +6       ;;to TaskMan, please read the mail message for results of this update.

 +7       ;;###;NOTE:  This line indicates the end of the message.

 +8       ;

HELP(L)   ;EP - Display text at label L.

 +1        WRITE !

 +2        FOR %=1:1

               WRITE !?4,$PIECE($TEXT(@L+%),";",3)

               IF $PIECE($TEXT(@L+%+1),";",3)="###"

                   QUIT

 +3        QUIT

 +4       ;

SINGLE(K) ; Get holders of a single key K.

 +1        NEW Y

 +2        SET Y=0

 +3        IF '$DATA(^XUSEC(K))

               QUIT

 +4        FOR

               SET Y=$ORDER(^XUSEC(K,Y))

               IF 'Y

                   QUIT

               SET XMY(Y)=""

 +5        QUIT

 +6       ;

VP        ;

 +1        WRITE !?4,"****    AUM Version ",$PIECE($TEXT(+2),";",3)," Patch ",$PIECE($PIECE($TEXT(+2),";",5),"*",3),?65,"****"

 +2        WRITE !?4,"****   ",$PIECE($PIECE($TEXT(+1),";",2),"-",2),?65,"****"

 +3        QUIT

 +4       ;

GREET     ;;EP - To add to mail message.

 +1       ;;

 +2       ;;Greetings.

 +3       ;;

 +4       ;;Standard tables on your RPMS system have been updated.

 +5       ;;

 +6       ;;You are receiving this message because of the particular RPMS

 +7       ;;security keys that you hold.  This is for your information, only.

 +8       ;;You need do nothing in response to this message.

 +9       ;;

 +10      ;;Requests for modifications or additions to RPMS standard tables,

 +11      ;;whether they are or are not reflected in the IHS Standard Code

 +12      ;;Book (SCB), can be submitted to your Area Information System

 +13      ;;Coordinator (ISC).

 +14      ;;

 +15      ;;Questions about this patch, which is a product of the RPMS/DBA

 +16      ;;Team, can be directed to the Help Desk

 +17      ;;.  Please

 +18      ;;refer to patch "AUM*99.1*15".

 +19      ;;

 +20      ;;###;NOTE: This line indicates the end of text in this message.

 +21      ;

AUM9115.m