AIBCVT4.m

AIBCVT4 ;IHS/DDPS/DFM-IBM STAT RECORDS INITIALIZE  [ 01/28/89  1:05 PM ]

 ;1.3; 3/28/88

INIT ;HOUSEKEEPING INITIALIZE FIELDS ROUTINE

 S (AIBCT2,AIBCTB,AIBCTW,AIBCTE,AIBCTH,AIBCTI,AIBCTJ,AIBCTO,AIBCDV)=0

 S (AIBRLN,AIBAGI,AIBAGO,AIBCRG1)=0

 S (AIBGCT2,AIBGCTB,AIBGCTI,AIBGCTO,AIBGCTE,AIBFSQ)=0

 S (AIBA,AIBMSG,AIBG,AIBTDV,AIBOT,AIBOT(1),AIBH2)=""

 S AIB2ND="",AIBT2="W",(AIBSEQ,AIBTC)=1

 S AIBOS="M" I ^%ZOSF("OS")["DSM" S AIBOS="D"

 S AIBZRS="0000000000000000000000000",U="^",AIBDSH="-",WARN="W",YES="Y"

 S %DT="",X="T" D ^%DT S AIBYMD=$E(Y,2,7)

 S AIBH1="|||",AIBH2=""

 S AIBH3="RRD01   "_$E(AIBYMD,3,6)_$E(AIBYMD,1,2)

 S AIBH5="   DELETE RECORDS REGISTRATION"

 S AIBH4="   HEALTH REC ADD REGISTRATION"

 S:'$D(DTIME) DTIME=300

 I $D(AIBGBLP) G SELPRINT

 R !!,"Enter first 4 characters of global to process ",AIBGBLP:DTIME

SELPRINT ;SELECT PRINTER TO USE

 I $D(AIBPDV) S IOP=AIBPDV

 S %IS("B")="LP",%IS("A")="Select Printer " D ^%ZIS S AIBPDV=IO

CKTYPE ;CHECK TYPE OF FILE TO WRITE - keytap=TAPE, ibmjob=RJE CARDS

 S:AIBOS="D" AIBFILE="keytap" G:'$D(AIBFILE) RDTYPE

 G:AIBFILE="keytap" CKGLOB G:AIBFILE="ibmjob" CKGLOB

 I AIBFILE="^" S AIBA="A" D OPCANCL^AIBCVT6 G RETURN

RDTYPE ;GET TYPE FROM OPERATOR

 U AIBCDV W !!,"Choose Filetype to Generate :"

 W !,"    K - Keytape"

 W !,"    I - Ibmjob"

 W !,"    ^ - Abort run"

 R !!,"Enter Choice: ",AIBFILE:DTIME

 S:"KEYTAPEkeytape"[AIBFILE AIBFILE="keytap"

 S:"IBMJOBibmjob"[AIBFILE AIBFILE="ibmjob"

 G CKTYPE

CKGLOB ;CHECK IF GLOBAL EXISTS

 S (AIBZ,AIBZ(0),AIBZZ,AIBTZ,AIBTZ(0))="",AIBGBL=U_AIBGBLP_"GLOB"

 S:'$D(AIBDIR) AIBDIR="/usr/mumps/"

 U AIBCDV W !

 I $D(@AIBGBL) G GLOBOK

 S AIBMSG="Global "_AIBGBL_" Does'nt Exist" S AIBA="A" G RETURN

GLOBOK ;GLOBAL WAS FOUND

 S AIBGBLT=AIBGBL_"(AIBZ)",AIBZ="COUNT",AIBGBFT=AIBGBL_"(AIBZ,AIBZZ)"

 K @AIBGBLT S AIBZ=""

 S AIBZ=$O(@AIBGBLT)

 I AIBZ>0 S AIBMSG="Global Header Record Missing" S AIBA="A" G RETURN

 S AIBIN=@AIBGBLT

RETURN ;RETURN TO CALLING ROUTINE

 Q

AIBCVT4   ;IHS/DDPS/DFM-IBM STAT RECORDS INITIALIZE  [ 01/28/89  1:05 PM ]

 +1       ;1.3; 3/28/88

INIT      ;HOUSEKEEPING INITIALIZE FIELDS ROUTINE

 +1        SET (AIBCT2,AIBCTB,AIBCTW,AIBCTE,AIBCTH,AIBCTI,AIBCTJ,AIBCTO,AIBCDV)=0

 +2        SET (AIBRLN,AIBAGI,AIBAGO,AIBCRG1)=0

 +3        SET (AIBGCT2,AIBGCTB,AIBGCTI,AIBGCTO,AIBGCTE,AIBFSQ)=0

 +4        SET (AIBA,AIBMSG,AIBG,AIBTDV,AIBOT,AIBOT(1),AIBH2)=""

 +5        SET AIB2ND=""

           SET AIBT2="W"

           SET (AIBSEQ,AIBTC)=1

 +6        SET AIBOS="M"

           IF ^%ZOSF("OS")["DSM"

               SET AIBOS="D"

 +7        SET AIBZRS="0000000000000000000000000"

           SET U="^"

           SET AIBDSH="-"

           SET WARN="W"

           SET YES="Y"

 +8        SET %DT=""

           SET X="T"

           DO ^%DT

           SET AIBYMD=$EXTRACT(Y,2,7)

 +9        SET AIBH1="|||"

           SET AIBH2=""

 +10       SET AIBH3="RRD01   "_$EXTRACT(AIBYMD,3,6)_$EXTRACT(AIBYMD,1,2)

 +11       SET AIBH5="   DELETE RECORDS REGISTRATION"

 +12       SET AIBH4="   HEALTH REC ADD REGISTRATION"

 +13       IF '$DATA(DTIME)

               SET DTIME=300

 +14       IF $DATA(AIBGBLP)

               GOTO SELPRINT

 +15       READ !!,"Enter first 4 characters of global to process ",AIBGBLP:DTIME

SELPRINT  ;SELECT PRINTER TO USE

 +1        IF $DATA(AIBPDV)

               SET IOP=AIBPDV

 +2        SET %IS("B")="LP"

           SET %IS("A")="Select Printer "

           DO ^%ZIS

           SET AIBPDV=IO

CKTYPE    ;CHECK TYPE OF FILE TO WRITE - keytap=TAPE, ibmjob=RJE CARDS

 +1        IF AIBOS="D"

               SET AIBFILE="keytap"

           IF '$DATA(AIBFILE)

               GOTO RDTYPE

 +2        IF AIBFILE="keytap"

               GOTO CKGLOB

           IF AIBFILE="ibmjob"

               GOTO CKGLOB

 +3        IF AIBFILE="^"

               SET AIBA="A"

               DO OPCANCL^AIBCVT6

               GOTO RETURN

RDTYPE    ;GET TYPE FROM OPERATOR

 +1        USE AIBCDV

           WRITE !!,"Choose Filetype to Generate :"

 +2        WRITE !,"    K - Keytape"

 +3        WRITE !,"    I - Ibmjob"

 +4        WRITE !,"    ^ - Abort run"

 +5        READ !!,"Enter Choice: ",AIBFILE:DTIME

 +6        IF "KEYTAPEkeytape"[AIBFILE

               SET AIBFILE="keytap"

 +7        IF "IBMJOBibmjob"[AIBFILE

               SET AIBFILE="ibmjob"

 +8        GOTO CKTYPE

CKGLOB    ;CHECK IF GLOBAL EXISTS

 +1        SET (AIBZ,AIBZ(0),AIBZZ,AIBTZ,AIBTZ(0))=""

           SET AIBGBL=U_AIBGBLP_"GLOB"

 +2        IF '$DATA(AIBDIR)

               SET AIBDIR="/usr/mumps/"

 +3        USE AIBCDV

           WRITE !

 +4        IF $DATA(@AIBGBL)

               GOTO GLOBOK

 +5        SET AIBMSG="Global "_AIBGBL_" Does'nt Exist"

           SET AIBA="A"

           GOTO RETURN

GLOBOK    ;GLOBAL WAS FOUND

 +1        SET AIBGBLT=AIBGBL_"(AIBZ)"

           SET AIBZ="COUNT"

           SET AIBGBFT=AIBGBL_"(AIBZ,AIBZZ)"

 +2        KILL @AIBGBLT

           SET AIBZ=""

 +3        SET AIBZ=$ORDER(@AIBGBLT)

 +4        IF AIBZ>0

               SET AIBMSG="Global Header Record Missing"

               SET AIBA="A"

               GOTO RETURN

 +5        SET AIBIN=@AIBGBLT

RETURN    ;RETURN TO CALLING ROUTINE

 +1        QUIT