Routine: AZHLRER

AZHLRER ; DSM/GTH - REMOTE ERROR REPORTING ;  [ 04/07/93  1:01 PM ]

 ;;1.9X;DSM REMOTE ERROR REPORTING;;FEB 19, 1993

 I $P(^%ZOSF("OS"),"^")'="MSM-UNIX" W !!,"SORRY.  MSM-UNIX only.",! Q

 W *7,!?10,"Please read the internal documentation in this routine",!?10,"before running the utility."

 ; Read thru ^UTILITY("%ER", extracting errors from the past

 ; AZHLFREQ days for selected namespace(s).  Write the errors to a

 ; unix file, with abbreviated global notation, pack the unix

 ; file, and uucp to a user at the identified destination.

 ; uucp to systems, according to parameter (ENTRY ACTION of option).

 ; Remove errors in ^("%ER" more than 180 days old.

 ; This routine is non-interactive.  It is designed to run in

 ; background from TaskMan, only.

 ; Entry point OPT is used to set an option into the OPTION file,

 ; which is scheduled for each day at 6 PM, which begins the process

 ; at START.  The value of the argument of the IF statement in the

 ; ENTRY ACTION of the option determines if the errors get sent to

 ; (1) system id at SYTM; (2) area office, or (3) both.

 ; Use entry point DEOPT to unschedule the option in the OPTION

 ; file set with entry point OPT.

 ; cmbsyb Any Timeplex 9600 .30-30 n:--n:--n: uucpb word: 10sne1

 ; cmbsyb Any ACU 2400 FTS-999-999-9999 n:--n:--n: uucpb word: 10sne1

 ; dpssyg Any Timeplex 9600 .00-15 n:--n:--n: uucpdps word: uucpdps

 ; dpssyg Any ACU2400 FTS-999-999-9999 n:--n:--n: uucpdps word: uucpdps

OPT ;EP - Set option in OPTION file.

 I $P(^%ZOSF("OS"),"^")'="MSM-UNIX" W !!,"SORRY.  MSM-UNIX only.",! Q

 S:'$D(DUZ(0)) DUZ(0)="@" D HOME^%ZIS,DT^DICRW,00:'$L($P(^AUTTSITE(1,0),U,14))

 NEW AZHLAREA,AZHLSYTM,DA,DIC,DIE,DR S AZHLSYTM=$P($T(SYTM),";;",2),%=1

 I $L($P(^AUTTSITE(1,0),U,14)) F  D  Q:(%=U)!(0<%&(4>%))

 .W !,"Do you want the errors sent to :",!?10,"1.  ",AZHLSYTM," only",!?10,"2.  ",$P(^(0),U,14)," only",!?10,"3.  both",?40,"=> " R %:DTIME

 .I '$T!(%[U) S %=U Q

 .S %=+% I %<1!(%>3) W *7," ??   1, 2, or 3, please.",!!

.Q

 Q:%=U  S AZHLAREA="20///I "_%

 S DIC="^DIC(19,",DIC(0)="",X="AZHL REMOTE ERROR REPORTING",DIC("DR")="1///Remote Error Reporting;4///R;"_AZHLAREA_";25///START^AZHLRER;200///T@1800;202///1D"

 I $D(^DIC(19,"B",X)) S DIE=DIC,DA=$O(^DIC(19,"B",X,0)),DR=AZHLAREA D ^DIE I 1

 E  K DD,DO D FILE^DICN

 W !!,"Done."

START ;EP - From TaskMan.

 ; Open a HFS.  QUIT if unsuccessful.

 NEW AZHLIOP

 F AZHLIOP=0:0 S AZHLIOP=$O(^%ZIS(1,AZHLIOP)) Q:'AZHLIOP  I ^(AZHLIOP,"TYPE")="HFS" S IOP=$P(^%ZIS(1,AZHLIOP,0),U) D ^%ZIS Q:'POP

 Q:POP!('AZHLIOP)  S AZHLIOP=$P(^%ZIS(1,AZHLIOP,0),U)

 NEW AZHL,AZHLAREA,AZHLFILE,AZHLFREQ,AZHLJUDT,AZHLLOC,AZHLNMSP,AZHLSYTM,C,D,E,F,G,I,V,Y

 ; rm xmit files over 2 weeks old.

 S AZHLLOC=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10),X=$$JOBWAIT^%HOSTCMD("ls -l /usr/spool/uucppublic/*"_$E(AZHLLOC,3,6)_"z* > azhlrer.wrk"),IOP=AZHLIOP,%ZIS("IOPAR")="(""azhlrer.wrk"":""R"")" D ^%ZIS,JDT U IO

 F  R % Q:%=""  S %=$P(%,"/",5),X=+$E(%,$F(%,"z"),$F(%,"z")+2) I ((%?2.4U4N1"z"3N.1".z")!(%?1"%"4N1"z"3N.1".z")),$E(AZHLLOC,3,6)=$E(%,$F(%,"z")-5,$F(%,"z")-2),((+X>+AZHLJUDT)!(+X<(+AZHLJUDT-14))) D

 . S X=$$JOBWAIT^%HOSTCMD("rm /usr/spool/uucppublic/"_%)

. Q

 S X=$$JOBWAIT^%HOSTCMD("rm azhlrer.wrk")

 ; Set C x-ref with namespaces not in PACKAGE file.

 F %=2:1 Q:$P($T(C),U,%)=""  I '$D(^DIC(9.4,"C",$P($T(C),U,%))) S ^DIC(9.4,"C",$P($T(C),U,%),0)=""

 ; Initialize namespace, systems, and frequency.

 S AZHLNMSP="",%=0+$P(^DIC(19,$O(^DIC(19,"B","AZHL REMOTE ERROR REPORTING",0)),20)," ",2)

 I %>1 S AZHLAREA=$P(^AUTTSITE(1,0),U,14)

 I '(%=2) S AZHLSYTM=$P($T(SYTM),";;",2)

 S AZHLFREQ=$P(^DIC(19,$O(^DIC(19,"B","AZHL REMOTE ERROR REPORTING",0)),200),U,3),AZHLFREQ=+AZHLFREQ*$S(AZHLFREQ["S":0,AZHLFREQ["H":0,AZHLFREQ["M":30,1:1) I AZHLFREQ<1 S AZHLFREQ=1

 K ^TMP($J)

MAIN ;

 F  S AZHLNMSP=$O(^DIC(9.4,"C",AZHLNMSP)) Q:(AZHLNMSP="")!POP  D

 .S AZHLFILE="/usr/spool/uucppublic/"_AZHLNMSP_$E(AZHLLOC,3,6)_"z"_AZHLJUDT

 .; KILL single-char vars before call to %ZIS.

 .KILL C,D,E,F,G,I,V,Y

 .; Open specific file.

 .S IOP=AZHLIOP,%ZIS("IOPAR")="("""_AZHLFILE_""":""W"")" D ^%ZIS

 .Q:POP  U IO

 .; Get version and date installed.

 .S V="none",I=$O(^DIC(9.4,"C",AZHLNMSP,0)) I I S V=$S($D(^DIC(9.4,I,"VERSION")):^("VERSION"),1:"unk"),%=$O(^DIC(9.4,I,22,"B",V,0)) I % S I=$P(^DIC(9.4,I,22,%,0),U,3)

 .W ?5,"<<< BEGIN '",AZHLNMSP,"' v ",V,", ",I,", REMOTE ERROR REPORTING FOR '",AZHLLOC,"' >>>",!

 .; $O thru ^("%ER" for last AZHLFREQ days.

 .S C=+$H-AZHLFREQ-1,Y=0 F  S C=$O(^UTILITY("%ER",C)) Q:'C  S D=^(C,0) F E=1:1:D I $E($P($P(^UTILITY("%ER",C,E,0),U,2),":"),1,$L(AZHLNMSP))=AZHLNMSP S Y=1 D

 ..; Record 9 system vars.

 ..F F=0:1:9 I $D(^UTILITY("%ER",C,E,F)) W "^(,"_C_","_E_","_F_")=",^(F),!

 ..; Record routine's patch piece.

 ..S X=$P($P(^UTILITY("%ER",C,E,0),U,2),":") X ^%ZOSF("TEST") I  X "ZL @X S %=$T(+2)" W "^(,"_C_","_E_",10)=PATCH PIECE=",$P(%,";",5),!

 ..; Record application vars.

 ..I $D(^UTILITY("%ER",C,E,100)) S G=^(100) F F=100:1:G+100 W "^(,"_C_","_E_","_F_")=",^(F),!

..Q

 .; If no errors found for ns, rm file and quit to next $O.

 .I 'Y S X=$$JOBWAIT^%HOSTCMD("rm "_AZHLFILE) Q

 .W ?5,">>> END '",AZHLNMSP,"' REMOTE ERROR REPORTING FOR '",AZHLLOC,"' <<<",!

 .S ^TMP($J,"RER",AZHLFILE)=""

.Q

ENDMAIN ;

 KILL C,D,E,F,G,I,V,Y S IOP=AZHLIOP,%ZIS("IOPAR")="(""azhlrer.wrk"":""W"")" D ^%ZIS,^%ZISC S X=$$JOBWAIT^%HOSTCMD("rm azhlrer.wrk")

 ; pack files and uucp to appropriate sys ids.

 S AZHLFILE="" F  S AZHLFILE=$O(^TMP($J,"RER",AZHLFILE)) Q:AZHLFILE=""  D

 .S X=$$JOBWAIT^%HOSTCMD("pack "_AZHLFILE)

 .I $D(AZHLSYTM) S X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_".z "_AZHLSYTM_"!~"),X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_" "_AZHLSYTM_"!~")

 .I $D(AZHLAREA) S X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_".z "_AZHLAREA_"!~"),X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_" "_AZHLAREA_"!~")

.Q

 ; Remove non-PACKAGE namespaces from C x-ref.

 F %=2:1 Q:$P($T(C),U,%)=""  K ^DIC(9.4,"C",$P($T(C),U,%),0)

 ; Remove entries from ^("%ER" more than 180 days old.

 F %=0:0 S %=$O(^UTILITY("%ER",%)) Q:('%)!((+$H-%)<180)  K ^(%)

 K ^TMP($J) S ZTREQ="@"

Q Q

JDT S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S X=X+1,X="00"_X,AZHLJUDT=$E(X,$L(X)-2,$L(X)) Q

C ;;^%^DI^XB^XQ^ZIB^ZU

SYTM ;;cmbsyb

10 ;;abr-ab

30 ;;akarea

20 ;;albtrn

40 ;;bilcsy

11 ;;bji-ao

61 ;;cao-as

80 ;;nav-aa

51 ;;nsa-oa

50 ;;okc-ao

60 ;;phx-ed

70 ;;pordps

00 ;;tucdev

 NEW DIE,DR,DA S DR="W $J("""",IOM-$L(X)\2)_X,!!"

 S DA=$P($T(@($P(^AUTTAREA($P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,4),0),U,2))),";;",2) W !

 F X="A system id for your area computer does not exist in the RPMS SITE file.","Based on your area code, it should probably be '"_DA_"'.","Please enter an area system id into the RPMS SITE file, now.","(Calling DIE for you)." X DR

 S DIE="^AUTTSITE(",DR=".14//"_DA,DA=1 D ^DIE

AZHLRER   ; DSM/GTH - REMOTE ERROR REPORTING ;  [ 04/07/93  1:01 PM ]

 +1       ;;1.9X;DSM REMOTE ERROR REPORTING;;FEB 19, 1993

 +2       ;

 +3        IF $PIECE(^%ZOSF("OS"),"^")'="MSM-UNIX"

               WRITE !!,"SORRY.  MSM-UNIX only.",!

               QUIT

 +4        WRITE *7,!?10,"Please read the internal documentation in this routine",!?10,"before running the utility."

 +5        QUIT

 +6       ;

 +7       ; Read thru ^UTILITY("%ER", extracting errors from the past

 +8       ; AZHLFREQ days for selected namespace(s).  Write the errors to a

 +9       ; unix file, with abbreviated global notation, pack the unix

 +10      ; file, and uucp to a user at the identified destination.

 +11      ; uucp to systems, according to parameter (ENTRY ACTION of option).

 +12      ; Remove errors in ^("%ER" more than 180 days old.

 +13      ;

 +14      ; This routine is non-interactive.  It is designed to run in

 +15      ; background from TaskMan, only.

 +16      ;

 +17      ; Entry point OPT is used to set an option into the OPTION file,

 +18      ; which is scheduled for each day at 6 PM, which begins the process

 +19      ; at START.  The value of the argument of the IF statement in the

 +20      ; ENTRY ACTION of the option determines if the errors get sent to

 +21      ; (1) system id at SYTM; (2) area office, or (3) both.

 +22      ;

 +23      ; Use entry point DEOPT to unschedule the option in the OPTION

 +24      ; file set with entry point OPT.

 +25      ;

 +26      ; cmbsyb Any Timeplex 9600 .30-30 n:--n:--n: uucpb word: 10sne1

 +27      ; cmbsyb Any ACU 2400 FTS-999-999-9999 n:--n:--n: uucpb word: 10sne1

 +28      ; dpssyg Any Timeplex 9600 .00-15 n:--n:--n: uucpdps word: uucpdps

 +29      ; dpssyg Any ACU2400 FTS-999-999-9999 n:--n:--n: uucpdps word: uucpdps

 +30      ;

OPT       ;EP - Set option in OPTION file.

 +1        IF $PIECE(^%ZOSF("OS"),"^")'="MSM-UNIX"

               WRITE !!,"SORRY.  MSM-UNIX only.",!

               QUIT

 +2        IF '$DATA(DUZ(0))

               SET DUZ(0)="@"

           DO HOME^%ZIS

           DO DT^DICRW

           IF '$LENGTH($PIECE(^AUTTSITE(1,0),U,14))

               DO 00

 +3        NEW AZHLAREA,AZHLSYTM,DA,DIC,DIE,DR

           SET AZHLSYTM=$PIECE($TEXT(SYTM),";;",2)

           SET %=1

 +4        IF $LENGTH($PIECE(^AUTTSITE(1,0),U,14))

FOR

                   Begin DoDot:1

 +5                    WRITE !,"Do you want the errors sent to :",!?10,"1.  ",AZHLSYTM," only",!?10,"2.  ",$PIECE(^(0),U,14)," only",!?10,"3.  both",?40,"=> "

                       READ %:DTIME

 +6                    IF '$TEST!(%[U)

                           SET %=U

                           QUIT

 +7                    SET %=+%

                       IF %<1!(%>3)

                           WRITE *7," ??   1, 2, or 3, please.",!!

 +8                    QUIT

                   End DoDot:1

                   IF (%=U)!(0<%&(4>%))

                       QUIT

 +9        IF %=U

               QUIT

           SET AZHLAREA="20///I "_%

 +10       SET DIC="^DIC(19,"

           SET DIC(0)=""

           SET X="AZHL REMOTE ERROR REPORTING"

           SET DIC("DR")="1///Remote Error Reporting;4///R;"_AZHLAREA_";25///START^AZHLRER;200///T@1800;202///1D"

 +11       IF $DATA(^DIC(19,"B",X))

               SET DIE=DIC

               SET DA=$ORDER(^DIC(19,"B",X,0))

               SET DR=AZHLAREA

               DO ^DIE

               IF 1

 +12      IF '$TEST

               KILL DD,DO

               DO FILE^DICN

 +13       WRITE !!,"Done."

 +14       QUIT

 +15      ;

START     ;EP - From TaskMan.

 +1       ; Open a HFS.  QUIT if unsuccessful.

 +2        NEW AZHLIOP

 +3        FOR AZHLIOP=0:0

               SET AZHLIOP=$ORDER(^%ZIS(1,AZHLIOP))

               IF 'AZHLIOP

                   QUIT

               IF ^(AZHLIOP,"TYPE")="HFS"

                   SET IOP=$PIECE(^%ZIS(1,AZHLIOP,0),U)

                   DO ^%ZIS

                   IF 'POP

                       QUIT

 +4        IF POP!('AZHLIOP)

               QUIT

           SET AZHLIOP=$PIECE(^%ZIS(1,AZHLIOP,0),U)

 +5       ;

 +6        NEW AZHL,AZHLAREA,AZHLFILE,AZHLFREQ,AZHLJUDT,AZHLLOC,AZHLNMSP,AZHLSYTM,C,D,E,F,G,I,V,Y

 +7       ; rm xmit files over 2 weeks old.

 +8        SET AZHLLOC=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,10)

           SET X=$$JOBWAIT^%HOSTCMD("ls -l /usr/spool/uucppublic/*"_$EXTRACT(AZHLLOC,3,6)_"z* > azhlrer.wrk")

           SET IOP=AZHLIOP

           SET %ZIS("IOPAR")="(""azhlrer.wrk"":""R"")"

           DO ^%ZIS

           DO JDT

           USE IO

 +9        FOR

               READ %

               IF %=""

                   QUIT

               SET %=$PIECE(%,"/",5)

               SET X=+$EXTRACT(%,$FIND(%,"z"),$FIND(%,"z")+2)

               IF ((%?2.4U4N1"z"3N.1".z")!(%?1"%"4N1"z"3N.1".z"))

                   IF $EXTRACT(AZHLLOC,3,6)=$EXTRACT(%,$FIND(%,"z")-5,$FIND(%,"z")-2)

                       IF ((+X>+AZHLJUDT)!(+X<(+AZHLJUDT-14)))

                           Begin DoDot:1

 +10                           SET X=$$JOBWAIT^%HOSTCMD("rm /usr/spool/uucppublic/"_%)

 +11                           QUIT

                           End DoDot:1

 +12       SET X=$$JOBWAIT^%HOSTCMD("rm azhlrer.wrk")

 +13      ; Set C x-ref with namespaces not in PACKAGE file.

 +14       FOR %=2:1

               IF $PIECE($TEXT(C),U,%)=""

                   QUIT

               IF '$DATA(^DIC(9.4,"C",$PIECE($TEXT(C),U,%)))

                   SET ^DIC(9.4,"C",$PIECE($TEXT(C),U,%),0)=""

 +15      ; Initialize namespace, systems, and frequency.

 +16       SET AZHLNMSP=""

           SET %=0+$PIECE(^DIC(19,$ORDER(^DIC(19,"B","AZHL REMOTE ERROR REPORTING",0)),20)," ",2)

 +17       IF %>1

               SET AZHLAREA=$PIECE(^AUTTSITE(1,0),U,14)

 +18       IF '(%=2)

               SET AZHLSYTM=$PIECE($TEXT(SYTM),";;",2)

 +19       SET AZHLFREQ=$PIECE(^DIC(19,$ORDER(^DIC(19,"B","AZHL REMOTE ERROR REPORTING",0)),200),U,3)

           SET AZHLFREQ=+AZHLFREQ*$SELECT(AZHLFREQ["S":0,AZHLFREQ["H":0,AZHLFREQ["M":30,1:1)

           IF AZHLFREQ<1

               SET AZHLFREQ=1

 +20       KILL ^TMP($JOB)

MAIN      ;

 +1        FOR

               SET AZHLNMSP=$ORDER(^DIC(9.4,"C",AZHLNMSP))

               IF (AZHLNMSP="")!POP

                   QUIT

               Begin DoDot:1

 +2                SET AZHLFILE="/usr/spool/uucppublic/"_AZHLNMSP_$EXTRACT(AZHLLOC,3,6)_"z"_AZHLJUDT

 +3       ; KILL single-char vars before call to %ZIS.

 +4                KILL C,D,E,F,G,I,V,Y

 +5       ; Open specific file.

 +6                SET IOP=AZHLIOP

                   SET %ZIS("IOPAR")="("""_AZHLFILE_""":""W"")"

                   DO ^%ZIS

 +7                IF POP

                       QUIT

                   USE IO

 +8       ; Get version and date installed.

 +9                SET V="none"

                   SET I=$ORDER(^DIC(9.4,"C",AZHLNMSP,0))

                   IF I

                       SET V=$SELECT($DATA(^DIC(9.4,I,"VERSION")):^("VERSION"),1:"unk")

                       SET %=$ORDER(^DIC(9.4,I,22,"B",V,0))

                       IF %

                           SET I=$PIECE(^DIC(9.4,I,22,%,0),U,3)

 +10               WRITE ?5,"<<< BEGIN '",AZHLNMSP,"' v ",V,", ",I,", REMOTE ERROR REPORTING FOR '",AZHLLOC,"' >>>",!

 +11      ; $O thru ^("%ER" for last AZHLFREQ days.

 +12               SET C=+$HOROLOG-AZHLFREQ-1

                   SET Y=0

FOR

                       SET C=$ORDER(^UTILITY("%ER",C))

                       IF 'C

                           QUIT

                       SET D=^(C,0)

                       FOR E=1:1:D

                           IF $EXTRACT($PIECE($PIECE(^UTILITY("%ER",C,E,0),U,2),":"),1,$LENGTH(AZHLNMSP))=AZHLNMSP

                               SET Y=1

                               Begin DoDot:2

 +13      ; Record 9 system vars.

 +14                               FOR F=0:1:9

                                       IF $DATA(^UTILITY("%ER",C,E,F))

                                           WRITE "^(,"_C_","_E_","_F_")=",^(F),!

 +15      ; Record routine's patch piece.

 +16                               SET X=$PIECE($PIECE(^UTILITY("%ER",C,E,0),U,2),":")

                                   XECUTE ^%ZOSF("TEST")

                                  IF $TEST

                                       XECUTE "ZL @X S %=$T(+2)"

                                       WRITE "^(,"_C_","_E_",10)=PATCH PIECE=",$PIECE(%,";",5),!

 +17      ; Record application vars.

 +18                               IF $DATA(^UTILITY("%ER",C,E,100))

                                       SET G=^(100)

                                       FOR F=100:1:G+100

                                           WRITE "^(,"_C_","_E_","_F_")=",^(F),!

 +19                               QUIT

                               End DoDot:2

 +20      ; If no errors found for ns, rm file and quit to next $O.

 +21               IF 'Y

                       SET X=$$JOBWAIT^%HOSTCMD("rm "_AZHLFILE)

                       QUIT

 +22               WRITE ?5,">>> END '",AZHLNMSP,"' REMOTE ERROR REPORTING FOR '",AZHLLOC,"' <<<",!

 +23               SET ^TMP($JOB,"RER",AZHLFILE)=""

 +24               QUIT

               End DoDot:1

ENDMAIN   ;

 +1        KILL C,D,E,F,G,I,V,Y

           SET IOP=AZHLIOP

           SET %ZIS("IOPAR")="(""azhlrer.wrk"":""W"")"

           DO ^%ZIS

           DO ^%ZISC

           SET X=$$JOBWAIT^%HOSTCMD("rm azhlrer.wrk")

 +2       ; pack files and uucp to appropriate sys ids.

 +3        SET AZHLFILE=""

FOR

               SET AZHLFILE=$ORDER(^TMP($JOB,"RER",AZHLFILE))

               IF AZHLFILE=""

                   QUIT

               Begin DoDot:1

 +4                SET X=$$JOBWAIT^%HOSTCMD("pack "_AZHLFILE)

 +5                IF $DATA(AZHLSYTM)

                       SET X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_".z "_AZHLSYTM_"!~")

                       SET X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_" "_AZHLSYTM_"!~")

 +6                IF $DATA(AZHLAREA)

                       SET X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_".z "_AZHLAREA_"!~")

                       SET X=$$JOBWAIT^%HOSTCMD("uucp -r "_AZHLFILE_" "_AZHLAREA_"!~")

 +7                QUIT

               End DoDot:1

 +8       ; Remove non-PACKAGE namespaces from C x-ref.

 +9        FOR %=2:1

               IF $PIECE($TEXT(C),U,%)=""

                   QUIT

               KILL ^DIC(9.4,"C",$PIECE($TEXT(C),U,%),0)

 +10      ; Remove entries from ^("%ER" more than 180 days old.

 +11       FOR %=0:0

               SET %=$ORDER(^UTILITY("%ER",%))

               IF ('%)!((+$HOROLOG-%)<180)

                   QUIT

               KILL ^(%)

 +12       KILL ^TMP($JOB)

           SET ZTREQ="@"

Q          QUIT

 +1       ;

JDT        SET X2=$EXTRACT(DT,1,3)_"0101"

           SET X1=DT

           DO ^%DTC

           SET X=X+1

           SET X="00"_X

           SET AZHLJUDT=$EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))

           QUIT

C         ;;^%^DI^XB^XQ^ZIB^ZU

SYTM      ;;cmbsyb

10        ;;abr-ab

30        ;;akarea

20        ;;albtrn

40        ;;bilcsy

11        ;;bji-ao

61        ;;cao-as

80        ;;nav-aa

51        ;;nsa-oa

50        ;;okc-ao

60        ;;phx-ed

70        ;;pordps

00        ;;tucdev

 +1        NEW DIE,DR,DA

           SET DR="W $J("""",IOM-$L(X)\2)_X,!!"

 +2        SET DA=$PIECE($TEXT(@($PIECE(^AUTTAREA($PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,4),0),U,2))),";;",2)

           WRITE !

 +3        FOR X="A system id for your area computer does not exist in the RPMS SITE file.","Based on your area code, it should probably be '"_DA_"'.","Please enter an area system id into the RPMS SITE file, now.","(Calling DIE for you)."

               XECUTE DR

 +4        SET DIE="^AUTTSITE("

           SET DR=".14//"_DA

           SET DA=1

           DO ^DIE

 +5        QUIT

AZHLRER.m