AUFGS.m

%AUFGS ; Fast Global Save ; V1.0 ; Utilities ; 03-Apr-84 ; LLK,MVB [ 01/08/86  12:29 PM ]

 ; For use only in conjunction with %AUFGR

 S $ZT="ERR^%AUFGS",%QTY=2 K ^UTILITY($J) W !,"IHS Fast Global Save",! D ^%IOS G:'$D(%IOD) EXIT

 U %IOD I $D(%MTBOT),@(%MTBOT_"=0") U 0 R !,"Rewind tape? <N> ",%,! I $L(%),"Yy"[$E(%) U %IOD W *5

 U 0 R !,"Header: ",H,! D ^%GSEL G:'$D(%GO) EXIT W ! D INT^%D,INT^%T S TIM=%DAT1_" "_%TIM,WTH="TIM,!,H,!"

 S %V=0 I $D(%MTM),%MTM["V" S %V=1

 I $D(%P),%P["V" S %V=1

 I %V S WTH="TIM,H"

 U %IOD W @WTH S $P(WTH,",")="""*""",%=$F(WTH,"H"),WTH=$E(WTH,1,%-2)_"""*"""_$E(WTH,%,255),%=""

SAVE S %=$O(^UTILITY($J,%)) I $L(%) D  G SAVE

 .S %1="^"_% U 0 W !,%1 Q:'$D(@%1)  U %IOD

 .I %V W @$ZR,$ZR F B=0:0 W $ZO,$ZR U 0 R *a:0 W:$T !,$ZR U %IOD

 .I '%V W @$ZR,!,$ZR,! F B=0:0 W $ZO,!,$ZR,! U 0 R *a:0 W:$T !,$ZR U %IOD

EXIT I $O(^UTILITY($J,""))'="",$D(%DTY),%DTY'="MT" U %IOD W @WTH

 I $O(^UTILITY($J,""))'="",$D(%DTY),%DTY="MT" W *3

EXIT1 U 0 I $D(%IOD),%IOD'=$I C %IOD

 S $ZT="" Q

ERR I $ZE["<UNDEF" U %IOD W @$S(%DTY="MT":"*3",1:WTH) S $ZT="ERR^%AUFGS" G SAVE

 I $ZE["<MTERR" U %IOD D ^%MTCHK C %IOD S $ZT="" ZQ

 I $ZE["<INRPT" U 0 W !,"** Unexpected Interrupt **",! G EXIT1

 U 0 I $D(%IOD) C:%IOD'=$I %IOD

 ZQ

ENT S %="",$ZT="ERR^%AUFGS" G SAVE

%AUFGS    ; Fast Global Save ; V1.0 ; Utilities ; 03-Apr-84 ; LLK,MVB [ 01/08/86  12:29 PM ]

 +1       ; For use only in conjunction with %AUFGR

 +2        SET $ZT="ERR^%AUFGS"

           SET %QTY=2

           KILL ^UTILITY($JOB)

           WRITE !,"IHS Fast Global Save",!

           DO ^%IOS

           IF '$DATA(%IOD)

               GOTO EXIT

 +3        USE %IOD

           IF $DATA(%MTBOT)

               IF @(%MTBOT_"=0")

                   USE 0

                   READ !,"Rewind tape? <N> ",%,!

                   IF $LENGTH(%)

                       IF "Yy"[$EXTRACT(%)

                           USE %IOD

                           WRITE *5

 +4        USE 0

           READ !,"Header: ",H,!

           DO ^%GSEL

           IF '$DATA(%GO)

               GOTO EXIT

           WRITE !

           DO INT^%D

           DO INT^%T

           SET TIM=%DAT1_" "_%TIM

           SET WTH="TIM,!,H,!"

 +5        SET %V=0

           IF $DATA(%MTM)

               IF %MTM["V"

                   SET %V=1

 +6        IF $DATA(%P)

               IF %P["V"

                   SET %V=1

 +7        IF %V

               SET WTH="TIM,H"

 +8        USE %IOD

           WRITE @WTH

           SET $PIECE(WTH,",")="""*"""

           SET %=$FIND(WTH,"H")

           SET WTH=$EXTRACT(WTH,1,%-2)_"""*"""_$EXTRACT(WTH,%,255)

           SET %=""

SAVE       SET %=$ORDER(^UTILITY($JOB,%))

           IF $LENGTH(%)

               Begin DoDot:1

 +1                SET %1="^"_%

                   USE 0

                   WRITE !,%1

                   IF '$DATA(@%1)

                       QUIT 

                   USE %IOD

 +2                IF %V

                       WRITE @$ZR,$ZR

                       FOR B=0:0

                           WRITE $ZO,$ZR

                           USE 0

                           READ *a:0

                           IF $TEST

                               WRITE !,$ZR

                           USE %IOD

 +3                IF '%V

                       WRITE @$ZR,!,$ZR,!

                       FOR B=0:0

                           WRITE $ZO,!,$ZR,!

                           USE 0

                           READ *a:0

                           IF $TEST

                               WRITE !,$ZR

                           USE %IOD

               End DoDot:1

               GOTO SAVE

EXIT       IF $ORDER(^UTILITY($JOB,""))'=""

               IF $DATA(%DTY)

                   IF %DTY'="MT"

                       USE %IOD

                       WRITE @WTH

 +1        IF $ORDER(^UTILITY($JOB,""))'=""

               IF $DATA(%DTY)

                   IF %DTY="MT"

                       WRITE *3

EXIT1      USE 0

           IF $DATA(%IOD)

               IF %IOD'=$IO

                   CLOSE %IOD

 +1        SET $ZT=""

           QUIT 

ERR        IF $ZE["<UNDEF"

               USE %IOD

               WRITE @$SELECT(%DTY="MT":"*3",1:WTH)

               SET $ZT="ERR^%AUFGS"

               GOTO SAVE

 +1        IF $ZE["<MTERR"

               USE %IOD

               DO ^%MTCHK

               CLOSE %IOD

               SET $ZT=""