- ENARGO ;(WIRMFO)/JED,SAB-MOVE ARCHIVE GLOBAL TO STORAGE MEDIA ;4.29.97
- ;;7.0;ENGINEERING;**40**;Aug 17, 1993
- Q
- A ; Archive global to media
- ; called by ENAR1
- ; input
- ; ENGBL - global subscript in ^ENAR to be archived (e.g. 6919.1)
- ; ENTIME - date/time of archive session (internal format)
- ; ENERR - error message text (should be 0 for no error)
- ; output
- ; ENERR - error message text or 0 when no error
- D DT^DICRW
- ;
- S ENHFSM="W",ENHFSIO="" D ARDEV I ENERR'=0 G OUT
- I IOT="MT" D MTSETUP I ENERR'=0 G CLOUT
- I IOT="MT" D MTCHECK I ENERR'=0 G CLOUT
- I IOT="MT" X ENWPROT I Y D G A
- . D CLOSE
- . W $C(7),!!,"But your tape is write protected!!" D MSG
- ;
- U IO(0) W !,"Beginning output"
- ; determine header info
- S ENHD(1)=$$FMTE^XLFDT(ENTIME)
- S ENHD(2)=$P(^ENAR(ENGBL,0),"^",1)_", ID# "_$P(^(-1),",",3)_", "_$P(^(0),"^",3)_" RECORDS SAVED"
- S ENHD(3)="^ENAR("_ENGBL_",-1)"
- S ENHD(4)=@ENHD(3)
- ; write data to archive device
- U IO S ENSTART=$P($H,",",2)
- ; - write header info
- W ENHD(1) W:IOT'="MT" ! W ENHD(2) W:IOT'="MT" !
- ; - write nodes and content of nodes
- S ENX="^ENAR("_ENGBL_")",ENC=0
- F S ENX=$Q(@ENX) Q:ENX="" Q:$QS(ENX,1)'=ENGBL D
- . W ENX W:IOT'="MT" ! W @ENX W:IOT'="MT" !
- . S ENC=ENC+1 I '(ENC#100) U IO(0) W "." U IO
- ; - write footer info
- W "**EOF**" W:IOT'="MT" ! W "**EOF**" W:IOT'="MT" !
- U IO(0)
- W !,"Elapsed time: ",$J($P($H,",",2)-ENSTART/60,6,2)," minutes.",!
- ;
- S DIR(0)="Y",DIR("A")="Archive complete, care to verify",DIR("B")="YES"
- S DIR("?",1)="This process reads archived records and compares them to"
- S DIR("?",2)="the source global."
- S DIR("?",3)=" "
- S DIR("?")="Enter YES or No"
- D ^DIR K DIR
- I 'Y S ENERR="VERIFY DECLINED" K ^ENAR(ENGBL,"LOCK") G CLOUT
- ;
- S DIR(0)="SB^F:FULL;H:HEADER-ONLY"
- S DIR("A")="Select type of verify to perform",DIR("B")="FULL"
- S DIR("?",3)="FULL - Every record is read from the archive media and"
- S DIR("?",4)=" compared to the source global."
- S DIR("?",1)="HEADER-ONLY - The header data (4 lines) is read from the"
- S DIR("?",2)=" archive media and compared to expected values."
- S DIR("?",5)=" "
- S DIR("?")="Enter H or F"
- D ^DIR K DIR I $D(DIRUT) S ENERR="USER VERIFY ABORT" G CLOUT
- S ENVT=Y
- ;
- VRF ; Verify
- ; rewind (or close and reopen) device
- W !,"Please wait while I rewind (or reopen) the archive device."
- S Y=$S("^MT^HFS^SDP^"[(U_IOT_U):$$REWIND^%ZIS(IO,IOT,IOPAR),1:0)
- I 'Y D CLOSE S IOP=ENION,ENHFSM="R" D ARDEV G:ENERR'=0 OUT
- I IOT="MT" D MTCHECK I ENERR'=0 G CLOUT
- ;
- S ENREDO=0,ENSTART=$P($H,",",2)
- D VHDR G:ENREDO VRF I ENERR'=0 G CLOUT
- I ENVT="F" D VREC G:ENREDO VRF I ENERR'=0 G CLOUT
- ;
- D CLOSE
- W !,"Elapsed time: ",$J($P($H,",",2)-ENSTART/60,6,2)," minutes."
- K ^ENAR(ENGBL,"LOCK")
- G OUT
- ;
- VHDR ; verify header
- U IO(0) W !!,"Verifying Header..."
- U IO R ENX(1):15,ENX(2):15,ENX(3):15,ENX(4):15
- U IO(0)
- F ENI=1:1:4 Q:ENX(ENI)'=ENHD(ENI)
- I ENX(ENI)'=ENHD(ENI) D
- . W $C(7),!!,"Expected: ",ENHD(ENI),!,"Found: ",ENX(ENI)
- . S DIR(0)="Y",DIR("A")="Try again",DIR("B")="YES"
- . D ^DIR K DIR I Y S ENREDO=1 Q
- . S ENERR="BAD HEADER VERIFY"
- I ENX(ENI)=ENHD(ENI) W "Header OK"
- Q
- ;
- VREC ; verify records
- U IO(0) W !,"Continuing with full verify"
- S (ENC,ENC("VERR"))=0
- U IO
- F R ENX:15,ENX(1):15 Q:ENX="**EOF**" D:ENX(1)'=@ENX Q:ENC("VERR")>5 S ENC=ENC+1 I '(ENC#100) U IO(0) W "." U IO
- . U IO(0)
- . S ENC("VERR")=ENC("VERR")+1
- . W $C(7),!,"WARNING: ",ENX,!,"Expected: ",@ENX,!,"Found: ",ENX(1)
- . I ENC("VERR")'>5 W !!,"continuing"
- . U IO
- U IO(0)
- I ENC("VERR")>5 D
- . W $C(7),!,"Sorry, the verify doesn't look good"
- . S DIR(0)="Y",DIR("A")="Try again",DIR("B")="YES"
- . D ^DIR K DIR I Y S ENREDO=1 Q
- . S ENERR="BAD VERIFY"
- Q
- ;
- CLOUT ; Close archive device and exit
- D CLOSE
- OUT ; Exit
- K ENBOT,ENC,ENEOT,ENHD,ENHFSIO,ENHFSM,ENI,ENION,ENMTERR
- K ENONLINE,ENR,ENREDO,ENREW,ENSTART,ENVT,ENWPROT,ENX
- K DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- Q
- ;
- MSG W !,"Press <RETURN> to continue" R ENR:DTIME S:'$T ENR="^" Q
- ;
- ARDEV ; Select and open archival device
- ; called from ENARGO, ENARGR
- ; input
- ; ENHFSM - host file access mode ('W'rite-only or 'R'ead-only)
- ; ENERR - error message text (should be 0 for no error)
- ; IOP - (optional) name of device to use
- ; ENHFSIO - (optional) name of host file to open
- ; output
- ; ENERR - 0 or error message text
- ; ENION - ION of selected device
- ; ENHFSIO - name of host file opened (only defined when IOT="HFS")
- I '$D(IOP) W $C(7),!!,"If using tape, please load ",$S(ENHFSM="W":"WRITE ENABLED ",ENHFSM="R":"WRITE PROTECTED ",1:""),"tape and bring on-line now",!
- S %ZIS("A")="ARCHIVAL DEVICE: ",%ZIS("B")="",%ZIS("HFSMODE")=ENHFSM
- I $G(ENHFSIO)]"" S %ZIS("HFSNAME")=ENHFSIO
- S %ZIS("S")="I ""^VTRM^TRM^""'[(U_$G(^(""TYPE""))_U)"
- D ^%ZIS I POP S ENERR="ARCHIVAL DEVICE NOT SELECTED" Q
- S ENION=ION
- S ENHFSIO=$S(IOT="HFS":IO,1:"")
- Q
- ;
- CLOSE ; Close archival device
- ; called from ENARGO, ENARGR
- D ^%ZISC
- Q
- ;
- MTSETUP ; Mag Tape Variables Setup
- ; called from ENARGO, ENARGR
- I '$D(^%ZOSF("MAGTAPE"))!('$D(^("EOT")))!('$D(^("MTBOT")))!('$D(^("MTERR")))!('$D(^("MTONLINE")))!('$D(^("MTWPROT"))) S ENERR="YOUR %ZOSF GLOBAL NODES FOR MAGTAPE ARE NOT SET UP. CANNOT PROCEED." Q
- X ^%ZOSF("MAGTAPE") S ENREW=%MT("REW") K %MT
- S ENEOT=^%ZOSF("EOT"),ENBOT=^%ZOSF("MTBOT")
- S ENMTERR=^%ZOSF("MTERR"),ENONLINE=^%ZOSF("MTONLINE")
- S ENWPROT=^%ZOSF("MTWPROT")
- Q
- ;
- MTCHECK ; Mag Tape Check
- ; called from ENARGO, ENARGR
- ; Checks if Mag Tape is online and rewind if at BOT
- U IO X ENONLINE G:Y MTC1
- U IO(0) W !,"Tape off-line, please make ready" D MSG
- I ENR="^" S ENERR="USER INTERUPT @TAPE STATUS" Q
- G MTCHECK
- MTC1 U IO X ENBOT Q:Y
- U IO(0) W !,"Rewinding tape" U IO W @ENREW
- Q
- ;ENARGO
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENARGO 5844 printed Feb 18, 2025@23:18:01 Page 2
- ENARGO ;(WIRMFO)/JED,SAB-MOVE ARCHIVE GLOBAL TO STORAGE MEDIA ;4.29.97
- +1 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
- +2 QUIT
- A ; Archive global to media
- +1 ; called by ENAR1
- +2 ; input
- +3 ; ENGBL - global subscript in ^ENAR to be archived (e.g. 6919.1)
- +4 ; ENTIME - date/time of archive session (internal format)
- +5 ; ENERR - error message text (should be 0 for no error)
- +6 ; output
- +7 ; ENERR - error message text or 0 when no error
- +8 DO DT^DICRW
- +9 ;
- +10 SET ENHFSM="W"
- SET ENHFSIO=""
- DO ARDEV
- IF ENERR'=0
- GOTO OUT
- +11 IF IOT="MT"
- DO MTSETUP
- IF ENERR'=0
- GOTO CLOUT
- +12 IF IOT="MT"
- DO MTCHECK
- IF ENERR'=0
- GOTO CLOUT
- +13 IF IOT="MT"
- XECUTE ENWPROT
- IF Y
- Begin DoDot:1
- +14 DO CLOSE
- +15 WRITE $CHAR(7),!!,"But your tape is write protected!!"
- DO MSG
- End DoDot:1
- GOTO A
- +16 ;
- +17 USE IO(0)
- WRITE !,"Beginning output"
- +18 ; determine header info
- +19 SET ENHD(1)=$$FMTE^XLFDT(ENTIME)
- +20 SET ENHD(2)=$PIECE(^ENAR(ENGBL,0),"^",1)_", ID# "_$PIECE(^(-1),",",3)_", "_$PIECE(^(0),"^",3)_" RECORDS SAVED"
- +21 SET ENHD(3)="^ENAR("_ENGBL_",-1)"
- +22 SET ENHD(4)=@ENHD(3)
- +23 ; write data to archive device
- +24 USE IO
- SET ENSTART=$PIECE($HOROLOG,",",2)
- +25 ; - write header info
- +26 WRITE ENHD(1)
- if IOT'="MT"
- WRITE !
- WRITE ENHD(2)
- if IOT'="MT"
- WRITE !
- +27 ; - write nodes and content of nodes
- +28 SET ENX="^ENAR("_ENGBL_")"
- SET ENC=0
- +29 FOR
- SET ENX=$QUERY(@ENX)
- if ENX=""
- QUIT
- if $QSUBSCRIPT(ENX,1)'=ENGBL
- QUIT
- Begin DoDot:1
- +30 WRITE ENX
- if IOT'="MT"
- WRITE !
- WRITE @ENX
- if IOT'="MT"
- WRITE !
- +31 SET ENC=ENC+1
- IF '(ENC#100)
- USE IO(0)
- WRITE "."
- USE IO
- End DoDot:1
- +32 ; - write footer info
- +33 WRITE "**EOF**"
- if IOT'="MT"
- WRITE !
- WRITE "**EOF**"
- if IOT'="MT"
- WRITE !
- +34 USE IO(0)
- +35 WRITE !,"Elapsed time: ",$JUSTIFY($PIECE($HOROLOG,",",2)-ENSTART/60,6,2)," minutes.",!
- +36 ;
- +37 SET DIR(0)="Y"
- SET DIR("A")="Archive complete, care to verify"
- SET DIR("B")="YES"
- +38 SET DIR("?",1)="This process reads archived records and compares them to"
- +39 SET DIR("?",2)="the source global."
- +40 SET DIR("?",3)=" "
- +41 SET DIR("?")="Enter YES or No"
- +42 DO ^DIR
- KILL DIR
- +43 IF 'Y
- SET ENERR="VERIFY DECLINED"
- KILL ^ENAR(ENGBL,"LOCK")
- GOTO CLOUT
- +44 ;
- +45 SET DIR(0)="SB^F:FULL;H:HEADER-ONLY"
- +46 SET DIR("A")="Select type of verify to perform"
- SET DIR("B")="FULL"
- +47 SET DIR("?",3)="FULL - Every record is read from the archive media and"
- +48 SET DIR("?",4)=" compared to the source global."
- +49 SET DIR("?",1)="HEADER-ONLY - The header data (4 lines) is read from the"
- +50 SET DIR("?",2)=" archive media and compared to expected values."
- +51 SET DIR("?",5)=" "
- +52 SET DIR("?")="Enter H or F"
- +53 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET ENERR="USER VERIFY ABORT"
- GOTO CLOUT
- +54 SET ENVT=Y
- +55 ;
- VRF ; Verify
- +1 ; rewind (or close and reopen) device
- +2 WRITE !,"Please wait while I rewind (or reopen) the archive device."
- +3 SET Y=$SELECT("^MT^HFS^SDP^"[(U_IOT_U):$$REWIND^%ZIS(IO,IOT,IOPAR),1:0)
- +4 IF 'Y
- DO CLOSE
- SET IOP=ENION
- SET ENHFSM="R"
- DO ARDEV
- if ENERR'=0
- GOTO OUT
- +5 IF IOT="MT"
- DO MTCHECK
- IF ENERR'=0
- GOTO CLOUT
- +6 ;
- +7 SET ENREDO=0
- SET ENSTART=$PIECE($HOROLOG,",",2)
- +8 DO VHDR
- if ENREDO
- GOTO VRF
- IF ENERR'=0
- GOTO CLOUT
- +9 IF ENVT="F"
- DO VREC
- if ENREDO
- GOTO VRF
- IF ENERR'=0
- GOTO CLOUT
- +10 ;
- +11 DO CLOSE
- +12 WRITE !,"Elapsed time: ",$JUSTIFY($PIECE($HOROLOG,",",2)-ENSTART/60,6,2)," minutes."
- +13 KILL ^ENAR(ENGBL,"LOCK")
- +14 GOTO OUT
- +15 ;
- VHDR ; verify header
- +1 USE IO(0)
- WRITE !!,"Verifying Header..."
- +2 USE IO
- READ ENX(1):15,ENX(2):15,ENX(3):15,ENX(4):15
- +3 USE IO(0)
- +4 FOR ENI=1:1:4
- if ENX(ENI)'=ENHD(ENI)
- QUIT
- +5 IF ENX(ENI)'=ENHD(ENI)
- Begin DoDot:1
- +6 WRITE $CHAR(7),!!,"Expected: ",ENHD(ENI),!,"Found: ",ENX(ENI)
- +7 SET DIR(0)="Y"
- SET DIR("A")="Try again"
- SET DIR("B")="YES"
- +8 DO ^DIR
- KILL DIR
- IF Y
- SET ENREDO=1
- QUIT
- +9 SET ENERR="BAD HEADER VERIFY"
- End DoDot:1
- +10 IF ENX(ENI)=ENHD(ENI)
- WRITE "Header OK"
- +11 QUIT
- +12 ;
- VREC ; verify records
- +1 USE IO(0)
- WRITE !,"Continuing with full verify"
- +2 SET (ENC,ENC("VERR"))=0
- +3 USE IO
- +4 FOR
- READ ENX:15,ENX(1):15
- if ENX="**EOF**"
- QUIT
- if ENX(1)'=@ENX
- Begin DoDot:1
- +5 USE IO(0)
- +6 SET ENC("VERR")=ENC("VERR")+1
- +7 WRITE $CHAR(7),!,"WARNING: ",ENX,!,"Expected: ",@ENX,!,"Found: ",ENX(1)
- +8 IF ENC("VERR")'>5
- WRITE !!,"continuing"
- +9 USE IO
- End DoDot:1
- if ENC("VERR")>5
- QUIT
- SET ENC=ENC+1
- IF '(ENC#100)
- USE IO(0)
- WRITE "."
- USE IO
- +10 USE IO(0)
- +11 IF ENC("VERR")>5
- Begin DoDot:1
- +12 WRITE $CHAR(7),!,"Sorry, the verify doesn't look good"
- +13 SET DIR(0)="Y"
- SET DIR("A")="Try again"
- SET DIR("B")="YES"
- +14 DO ^DIR
- KILL DIR
- IF Y
- SET ENREDO=1
- QUIT
- +15 SET ENERR="BAD VERIFY"
- End DoDot:1
- +16 QUIT
- +17 ;
- CLOUT ; Close archive device and exit
- +1 DO CLOSE
- OUT ; Exit
- +1 KILL ENBOT,ENC,ENEOT,ENHD,ENHFSIO,ENHFSM,ENI,ENION,ENMTERR
- +2 KILL ENONLINE,ENR,ENREDO,ENREW,ENSTART,ENVT,ENWPROT,ENX
- +3 KILL DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- +4 QUIT
- +5 ;
- MSG WRITE !,"Press <RETURN> to continue"
- READ ENR:DTIME
- if '$TEST
- SET ENR="^"
- QUIT
- +1 ;
- ARDEV ; Select and open archival device
- +1 ; called from ENARGO, ENARGR
- +2 ; input
- +3 ; ENHFSM - host file access mode ('W'rite-only or 'R'ead-only)
- +4 ; ENERR - error message text (should be 0 for no error)
- +5 ; IOP - (optional) name of device to use
- +6 ; ENHFSIO - (optional) name of host file to open
- +7 ; output
- +8 ; ENERR - 0 or error message text
- +9 ; ENION - ION of selected device
- +10 ; ENHFSIO - name of host file opened (only defined when IOT="HFS")
- +11 IF '$DATA(IOP)
- WRITE $CHAR(7),!!,"If using tape, please load ",$SELECT(ENHFSM="W":"WRITE ENABLED ",ENHFSM="R":"WRITE PROTECTED ",1:""),"tape and bring on-line now",!
- +12 SET %ZIS("A")="ARCHIVAL DEVICE: "
- SET %ZIS("B")=""
- SET %ZIS("HFSMODE")=ENHFSM
- +13 IF $GET(ENHFSIO)]""
- SET %ZIS("HFSNAME")=ENHFSIO
- +14 SET %ZIS("S")="I ""^VTRM^TRM^""'[(U_$G(^(""TYPE""))_U)"
- +15 DO ^%ZIS
- IF POP
- SET ENERR="ARCHIVAL DEVICE NOT SELECTED"
- QUIT
- +16 SET ENION=ION
- +17 SET ENHFSIO=$SELECT(IOT="HFS":IO,1:"")
- +18 QUIT
- +19 ;
- CLOSE ; Close archival device
- +1 ; called from ENARGO, ENARGR
- +2 DO ^%ZISC
- +3 QUIT
- +4 ;
- MTSETUP ; Mag Tape Variables Setup
- +1 ; called from ENARGO, ENARGR
- +2 IF '$DATA(^%ZOSF("MAGTAPE"))!('$DATA(^("EOT")))!('$DATA(^("MTBOT")))!('$DATA(^("MTERR")))!('$DATA(^("MTONLINE")))!('$DATA(^("MTWPROT")))
- SET ENERR="YOUR %ZOSF GLOBAL NODES FOR MAGTAPE ARE NOT SET UP. CANNOT PROCEED."
- QUIT
- +3 XECUTE ^%ZOSF("MAGTAPE")
- SET ENREW=%MT("REW")
- KILL %MT
- +4 SET ENEOT=^%ZOSF("EOT")
- SET ENBOT=^%ZOSF("MTBOT")
- +5 SET ENMTERR=^%ZOSF("MTERR")
- SET ENONLINE=^%ZOSF("MTONLINE")
- +6 SET ENWPROT=^%ZOSF("MTWPROT")
- +7 QUIT
- +8 ;
- MTCHECK ; Mag Tape Check
- +1 ; called from ENARGO, ENARGR
- +2 ; Checks if Mag Tape is online and rewind if at BOT
- +3 USE IO
- XECUTE ENONLINE
- if Y
- GOTO MTC1
- +4 USE IO(0)
- WRITE !,"Tape off-line, please make ready"
- DO MSG
- +5 IF ENR="^"
- SET ENERR="USER INTERUPT @TAPE STATUS"
- QUIT
- +6 GOTO MTCHECK
- MTC1 USE IO
- XECUTE ENBOT
- if Y
- QUIT
- +1 USE IO(0)
- WRITE !,"Rewinding tape"
- USE IO
- WRITE @ENREW
- +2 QUIT
- +3 ;ENARGO