Routine: AIBCVT6

AIBCVT6 ;IHS/DDPS/DFM-IBM STAT RECORD ERROR/EOJ [ 02/01/89  8:54 AM ]

 ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE

 ;1.0; 3/28/88

 ;1.1; 5/30/88 ; ADD DSM LOGIC

ERRMSG ;PRINT ERROR MESSAGE TO CONSOLE AND PRINTER

 U AIBCDV W !,AIBMSG

ERRMSP ; WRITE ERROR MESSAGE TO PRINTER ONLY

 G:'$D(AIBPDV) RETURN U AIBPDV W !,AIBMSG S AIBMSG="" G RETURN

OPCANCL ;OPERATOR CANCLED JOB

 D:$L(AIBMSG)>0 ERRMSG S AIBMSG="Operator Canceled Job"

 G ABEND

MTERR ;ERROR WRITEING MAGTAPE

 S AIBMSG="Write Error" D ERRMSG

ABEND ;ABNORMAL END OF JOB

 D:$L(AIBMSG)>0 ERRMSG S AIBMSG="ABNORMAL END OF JOB"

 D ERRMSG S AIBOK="N" G RETURN

CLOSEND ;EOJ OF JOB PROCESSING

 D DATIME W ! S AIBMSG="Processing Ended "_AIBDT_" "_AIBTI D ERRMSG

 G:'$D(AIBT1) CLOSPRNT I AIBOS="M" S AIBMSG="File Created : "_AIBT1 D ERRMSG

CLOSPRNT ;

 U AIBCDV S (IO,AIBDEV)=AIBPDV D CLOSE^AIBSDEV

 G:AIBTDV="" KILLALL S (IO,AIBDEV)=AIBTDV D CLOSE^AIBSDEV

KILLALL ;KILL ALL LOCAL VARIABLES AND INPUT DATA GLOBAL

 K:'$D(AIBOK) @AIBGBL

 K AIB2ND,AIBA,AIBAGI,AIBAGO,AIBB,AIBB1,AIBB2,AIBB3

 K AIBC,AIBCDV,AIBCF,AIBCF1,AIBCF2,AIBCF3,AIBCK,AIBCL

 K AIBCN1,AIBCN2,AIBCN3,AIBCNM,AIBCRG1,AIBCS

 K AIBCT2,AIBCTB,AIBCTE,AIBCTH,AIBCTI,AIBCTJ,AIBCTO,AIBCTW

 K AIBD0,AIBDIR,AIBDSH,AIBDT,AIBE,AIBED,AIBER

 K AIBFNR,AIBFBD,AIBFC,AIBFCD,AIBFCH,AIBFCT,AIBFED,AIBFILE,AIBFSQ

 K AIBG,AIBGBFT,AIBGBL,AIBGBLP,AIBGBLT,AIBGBD

 K AIBGCTH,AIBGCT2,AIBGCTB,AIBGCTI,AIBGCTO,AIBGCTE,AIBGED

 K AIBH1,AIBH2,AIBH3,AIBH4,AIBH5

 K AIBI,AIBI2,AIBI3,AIBIN,AIBJ,AIBJC,AIBJSA,AIBJSAC,AIBJSAN,AIBJSAP,AIBJSL,AIBJSRD,AIBJSRN,AIBJSRP,AIBL,AIBLE,AIBLK

 K AIBMSG,AIBN,AIBNK,AIBOK,AIBOL,AIBOT,AIBOR,AIBOS,AIBOW,AIBPDV,AIBPID

 K AIBR,AIBRB,AIBRE,AIBRLN,AIBRG2,AIBRG4,AIBRG5

 K AIBRK,AIBRKB,AIBRL,AIBRM,AIBRRR

 K AIBT1,AIBT2,AIBTAP,AIBTC,AIBTDV,AIBTMP,AIBTONL

 K AIBTGBL,AIBTGFT,AIBTGLT,AIBTH,AIBTI,AIBTM,AIBTS,AIBTT,AIBTZ

 K AIBV,AIBYMD,AIBZ,AIBZR,AIBZRS,AIBZZ

 K U,WARN,X,Y,YES,AIBDEV,AIBFN,AIBFFN,%IS,%MT,AIBSEQ

RETURN ;RETURN TO CALLING PROGRAM

DATIME ;COMPUTE DATE AND TIME

 S %H=$H D YMD^%DTC S Y=X X ^DD("DD") S AIBDT=Y

 S AIBTT=$P(%H,",",2),AIBTS=AIBTT#60

 S AIBTM=((AIBTT-AIBTS)\60)#60,AIBTH=AIBTT\3600

 S AIBTAP="AM" S:AIBTH>12 AIBTAP="PM",AIBTH=AIBTH-12

 S:$L(AIBTM)<2 AIBTM="0"_AIBTM S:$L(AIBTS)<2 AIBTS="0"_AIBTS

 S AIBTI=AIBTH_":"_AIBTM_":"_AIBTS_" "_AIBTAP Q

AIBCVT6   ;IHS/DDPS/DFM-IBM STAT RECORD ERROR/EOJ [ 02/01/89  8:54 AM ]

 +1       ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE

 +2       ;1.0; 3/28/88

 +3       ;1.1; 5/30/88 ; ADD DSM LOGIC

ERRMSG    ;PRINT ERROR MESSAGE TO CONSOLE AND PRINTER

 +1        USE AIBCDV

           WRITE !,AIBMSG

ERRMSP    ; WRITE ERROR MESSAGE TO PRINTER ONLY

 +1        IF '$DATA(AIBPDV)

               GOTO RETURN

           USE AIBPDV

           WRITE !,AIBMSG

           SET AIBMSG=""

           GOTO RETURN

OPCANCL   ;OPERATOR CANCLED JOB

 +1        IF $LENGTH(AIBMSG)>0

               DO ERRMSG

           SET AIBMSG="Operator Canceled Job"

 +2        GOTO ABEND

MTERR     ;ERROR WRITEING MAGTAPE

 +1        SET AIBMSG="Write Error"

           DO ERRMSG

ABEND     ;ABNORMAL END OF JOB

 +1        IF $LENGTH(AIBMSG)>0

               DO ERRMSG

           SET AIBMSG="ABNORMAL END OF JOB"

 +2        DO ERRMSG

           SET AIBOK="N"

           GOTO RETURN

CLOSEND   ;EOJ OF JOB PROCESSING

 +1        DO DATIME

           WRITE !

           SET AIBMSG="Processing Ended "_AIBDT_" "_AIBTI

           DO ERRMSG

 +2        IF '$DATA(AIBT1)

               GOTO CLOSPRNT

           IF AIBOS="M"

               SET AIBMSG="File Created : "_AIBT1

               DO ERRMSG

CLOSPRNT  ;

 +1        USE AIBCDV

           SET (IO,AIBDEV)=AIBPDV

           DO CLOSE^AIBSDEV

 +2        IF AIBTDV=""

               GOTO KILLALL

           SET (IO,AIBDEV)=AIBTDV

           DO CLOSE^AIBSDEV

KILLALL   ;KILL ALL LOCAL VARIABLES AND INPUT DATA GLOBAL

 +1        IF '$DATA(AIBOK)

               KILL @AIBGBL

 +2        KILL AIB2ND,AIBA,AIBAGI,AIBAGO,AIBB,AIBB1,AIBB2,AIBB3

 +3        KILL AIBC,AIBCDV,AIBCF,AIBCF1,AIBCF2,AIBCF3,AIBCK,AIBCL

 +4        KILL AIBCN1,AIBCN2,AIBCN3,AIBCNM,AIBCRG1,AIBCS

 +5        KILL AIBCT2,AIBCTB,AIBCTE,AIBCTH,AIBCTI,AIBCTJ,AIBCTO,AIBCTW

 +6        KILL AIBD0,AIBDIR,AIBDSH,AIBDT,AIBE,AIBED,AIBER

 +7        KILL AIBFNR,AIBFBD,AIBFC,AIBFCD,AIBFCH,AIBFCT,AIBFED,AIBFILE,AIBFSQ

 +8        KILL AIBG,AIBGBFT,AIBGBL,AIBGBLP,AIBGBLT,AIBGBD

 +9        KILL AIBGCTH,AIBGCT2,AIBGCTB,AIBGCTI,AIBGCTO,AIBGCTE,AIBGED

 +10       KILL AIBH1,AIBH2,AIBH3,AIBH4,AIBH5

 +11       KILL AIBI,AIBI2,AIBI3,AIBIN,AIBJ,AIBJC,AIBJSA,AIBJSAC,AIBJSAN,AIBJSAP,AIBJSL,AIBJSRD,AIBJSRN,AIBJSRP,AIBL,AIBLE,AIBLK

 +12       KILL AIBMSG,AIBN,AIBNK,AIBOK,AIBOL,AIBOT,AIBOR,AIBOS,AIBOW,AIBPDV,AIBPID

 +13       KILL AIBR,AIBRB,AIBRE,AIBRLN,AIBRG2,AIBRG4,AIBRG5

 +14       KILL AIBRK,AIBRKB,AIBRL,AIBRM,AIBRRR

 +15       KILL AIBT1,AIBT2,AIBTAP,AIBTC,AIBTDV,AIBTMP,AIBTONL

 +16       KILL AIBTGBL,AIBTGFT,AIBTGLT,AIBTH,AIBTI,AIBTM,AIBTS,AIBTT,AIBTZ

 +17       KILL AIBV,AIBYMD,AIBZ,AIBZR,AIBZRS,AIBZZ

 +18       KILL U,WARN,X,Y,YES,AIBDEV,AIBFN,AIBFFN,%IS,%MT,AIBSEQ

RETURN    ;RETURN TO CALLING PROGRAM

 +1        QUIT

DATIME    ;COMPUTE DATE AND TIME

 +1        SET %H=$HOROLOG

           DO YMD^%DTC

           SET Y=X

           XECUTE ^DD("DD")

           SET AIBDT=Y

 +2        SET AIBTT=$PIECE(%H,",",2)

           SET AIBTS=AIBTT#60

 +3        SET AIBTM=((AIBTT-AIBTS)\60)#60

           SET AIBTH=AIBTT\3600

 +4        SET AIBTAP="AM"

           IF AIBTH>12

               SET AIBTAP="PM"

               SET AIBTH=AIBTH-12

 +5        IF $LENGTH(AIBTM)<2

               SET AIBTM="0"_AIBTM

           IF $LENGTH(AIBTS)<2

               SET AIBTS="0"_AIBTS

 +6        SET AIBTI=AIBTH_":"_AIBTM_":"_AIBTS_" "_AIBTAP

           QUIT

AIBCVT6.m