- %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=""
