Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AFSHARC0

AFSHARC0.m

Go to the documentation of this file. 
  1. AFSHARC0 ; IHS/OIRM/DSD/JDM-ARCHIVE & JULIAN DATE CONVERSION RTN;    [ 10/27/2004   4:20 PM ]
  1.  ;;3.0T1;PERSONNEL C.A.N. CORRECTION;**1,13**;FEB 02, 1999
  1.  ;;MODIFIED FOR CACHE' COMPLIANCE ; ACR*2.1*9
  1.  W !!,"NOT AN ENTRY POINT" Q
  1. TARBKUP ;EP; DO 'TAR' BACKUP OF OPERATING SYSTEM FILE
  1.  ;;%FN  = INPUT FILE NAME
  1.  ;;%SDIR = UNIX SUBDIRECTORY LOCATION OF INPUT FILE
  1.  ;;AFSHDTYE =  (Cartridge(C) or Tape (T) - default="C"
  1. MEDIA ;
  1.  I '$D(AFSHOPT(3)) S AFSHOPT(3)=$P(^AFSHPARM(DUZ(2),0),"^",4)
  1.  I AFSHOPT(3)="N" S AFSHRTCD=0 Q
  1.  I '$D(AFSHDTYE) S AFSHDTYE="C"
  1.  ;I '$D(%SDIR) S %DIR="/usr/spool/afsdata" ;   ;ACR*2.1*13.06 IM14144
  1.  I '$D(%SDIR) S %SDIR=$$ARMSDIR^ACRFSYS(1)      ;ACR*2.1*13.06 IM14144
  1.  Q:%SDIR']""                                    ;ACR*2.1*13.06 IM14144
  1.  S AFSHDTYP=$S(AFSHDTYE="C":"rmt0",AFSHDTYE="T":"rmt1")
  1.  S AFSHDNME=$S(AFSHDTYE="C":"Cartridge Tape",AFSHDTYE="T":"9-Track Tape")
  1.  I '$D(%FN) G ERROR
  1.  S AFSHFNLN=$L(%FN)
  1. TRYBK ;
  1.  U IO(0) W !!,?10,"Backing up ",AFSHEXFN," to ",AFSHDNME,!
  1.  S AFSHCMDR="cd "_%SDIR_"; tar -cvft /dev/"_AFSHDTYP_" "_%FN
  1.  D HOSTCMD^AFSHCKZC U IO(0)
  1.  S AFSHRTCD=X
  1.  I X=0 W !!,?10,"Backup to ",AFSHDNME," was SUCCESSFUL" G TAREXIT
  1. ERROR W *7,!!?10,"Backup to ",AFSHDNME," was NOT SUCCESSFUL -- NOTIFY SUPERVISOR"
  1. TAREXIT ;S AFSHCMDR="cd /usr/spool/afsdata" D TCMD^ACRFUTL G ENDX^AFSHARC1 ;ACR*2.1*13.06 IM14144
  1.  S AFSHCMDR="cd "_%SDIR D TCMD^ACRFUTL G ENDX^AFSHARC1 ;ACR*2.1*13.06 IM14144
  1.  ;
  1. ARCHLIST ;EP; LIST APPROPRIATE FILES IN OPERATING SYSTEM
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  ;;%DEV =HFS (INITIALLY 51)
  1.  ;;%FN  =INPUT FILE NAME
  1.  ;;%OPT=0 -- NO OPERATOR INTERACTION (DEFAULT)
  1.  ;;%OPT=1 -- ASK OPERATOR QUESTIONS
  1. SETUP ;
  1.  U IO(0) W !,"FILE: ",%FN
  1.  I '$D(%FN) U IO(0) W "FILE NAME ERROR" G ENDX^AFSHARC1
  1.  S AFSHFNLN=$L(%FN) K AFSHJFLG
  1.  I '$D(%OPT) S %OPT=0
  1.  S %FNSAV=%FN
  1.  K AFSHFLES
  1.  ;I '$D(%SDIR) S %DIR="/usr/spool/afsdata"         ;ACR*2.1*13.06 IM14144
  1.  I '$D(%SDIR) S %SDIR=$$ARMSDIR^ACRFSYS(1)         ;ACR*2.1*13.06 IM14144
  1.  Q:%SDIR']""
  1.  S X1=DT,X2=$E(DT,1,3)_"0101" D ^%DTC S AFSHDTJL=$E(DT,2,3)_$E("000",1,3-$L(X+1))_(X+1)
  1. LISTEM ;
  1.  S AFSHCMDR="cd "_%SDIR_";rm afs.files; ls -l "_%FN_"*"_" | awk '{print $5,$9}' > afs.files"
  1.  D TCMD^ACRFUTL(AFSHCMDR)
  1.  ;S %FN=%SDIR_"/afs.files"                     ;ACR*2.1*13.06 IM14144
  1.  S %FN="afs.files"                             ;ACR*2.1*13.06 IM14144
  1.  ;S Y=0 D OPENHFS^AFSHCK1 I Y>0 D ERROR^AFSHCK1 G ABEND^AFSHARC1 ;ACR*2.1*13.06 IM14144
  1.  S Y=0                                         ;ACR*2.1*13.06 IM14144
  1.  D OPENHFS^AFSHCK1(%SDIR,%FN,.%DEV)            ;ACR*2.1*13.06 IM14144
  1.  I $G(%DEV)']"" D ERROR^AFSHCK1 G ABEND^AFSHARC1  ;ACR*2.1*13.01 IM13574
  1.  S AFSHFCNT=0,AFSHDCNT=0 F AFSHI=1:1 U %DEV R AFSHX:1 G DEVEOF:'$T G DEVEOF:$$STATUS^%ZISH=-1 D SUB1
  1. DEVEOF S AFSHR=0
  1.  G ENDX^AFSHARC1:%OPT=0
  1.  U IO(0) W !!,"NUMBER OF PREVIOUSLY EXPORTED FILES = ",AFSHFCNT
  1.  D SUB2
  1.  I AFSHLDAT=0 G FILEDSP
  1.  ;
  1.  W ! K DIR S DIR("B")="N",DIR(0)="Y",DIR("A")="Delete ALL Previously EXPORTED Files Processed BEFORE "_Y D ^DIR
  1.  I Y=1 G FILEDEL
  1.  G:$D(DUOUT)!$D(DTOUT) ARCHLIST
  1. FILEDSP W ! K DIR S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to LIST Previously EXPORTED FILES?" D ^DIR
  1.  G:$D(DUOUT)!$D(DTOUT) ARCHLIST
  1.  I Y'=1 G ENDX^AFSHARC1
  1. A20 S AFSHR=0,AFSHRR=0,AFSHSEQ=0
  1.  W !!,"SEQ #  ","# RCDS    EXPORT - DATE  FILE NAME - SFX  OK-TX?  COLOR",!!
  1. FILEDSPA S AFSHR=$O(AFSHFLES("C",AFSHR)) G LISTEND:+AFSHR=0
  1. FILEDSPB S AFSHRR=$O(AFSHFLES("C",AFSHR,AFSHRR)) G FILEDSPA:+AFSHRR=0
  1.  S AFSHFNME=$P(AFSHFLES(AFSHRR),"^",2),AFSHXPT=0,AFSHXPT=$O(^AFSTXLOG(DUZ(2),1,"B",AFSHFNME,AFSHXPT))
  1.  ;I +AFSHXPT<1 S AFSHEMSG="ERROR IN TX/EXPORT DATA STRUCTURE  -- NOTIFY SUPERVISOR",AFSHJFLG=1 G JCANCEL^AFSHARC1
  1.  S AFSHXST="N",$P(AFSHFLES(AFSHRR),"^",3)="N" S:+AFSHXPT>0 AFSHXST=$P(^AFSTXLOG(DUZ(2),1,AFSHXPT,0),"^",4),AFSHCLRN=$P(^(0),"^",5),$P(AFSHFLES(AFSHRR),"^",3)=AFSHXST
  1.  ;S AFSHCLRN=$S(AFSHCLRN="R":"RED",AFSHCLRN="B":"BLUE",1:"")
  1.  S X=$P($P(AFSHFLES(AFSHRR),".",2),"^",1) D JDATECV
  1.  S X=$P(AFSHFLES(AFSHRR),"^",1),AFSHSZ=X/81,X=$J(AFSHSZ,0,0)
  1.  S AFSHSEQ=AFSHSEQ+1 W !,$J(AFSHSEQ,3),?6,$J(X,6),?17,Y
  1.  S AFSHSZ=$P(AFSHFLES(AFSHRR),"^",2)
  1.  S X=$P(AFSHSZ,".",1) W ?33,$E(X,1,AFSHFNLN),?45,$E(X,AFSHFNLN+1,AFSHFNLN+1),?51,AFSHXST
  1.  G FILEDSPB
  1. LISTEND W !,"****       END OF LIST        **** ",! H 3 K DIR S DIR(0)="E" D ^DIR I Y=0 S AFSHEMSG=$P($T(M9^AFSHCK1),";;",2),AFSHJFLG=1 G JCANCEL^AFSHARC1
  1.  G ENDX^AFSHARC1
  1.  ;
  1. SUB1 ;
  1.  S AFSHFCNT=AFSHFCNT+1
  1.  S AFSHFLES(AFSHI)=$P(AFSHX," ",1)_"^"_$P(AFSHX," ",2),AFSHY=$P($P(AFSHX," ",2),".",2) Q:+AFSHY<1  I '$D(AFSHFLES("C",AFSHY)) S AFSHDCNT=AFSHDCNT+1
  1.  S AFSHFLES("C",99999-AFSHY,AFSHI)=""
  1.  S AFSHZ=$P($P(AFSHX," ",2),".",1)
  1.  S AFSHFLES("N",AFSHY,AFSHZ,AFSHI)=""
  1.  Q
  1. SUB2 ;
  1.  S AFSHR=0,AFSHLDAT=0,AFSHDCNT=0
  1. SUB2A S AFSHR=$O(AFSHFLES("C",AFSHR)) G SUB2END:+AFSHR=0
  1.  S AFSHDCNT=AFSHDCNT+1 S:AFSHDCNT=3 AFSHLDAT=99999-AFSHR
  1.  G SUB2A
  1. SUB2END S X=AFSHLDAT D JDATECV S AFSHDLDT=X
  1.  Q
  1.  ;
  1. FILEDEL ;
  1.  S AFSHR=0 W !
  1. FILEDELA S AFSHR=$O(AFSHFLES(AFSHR)) G FILEDEX:+AFSHR=0
  1.  S AFSHSZ=AFSHFLES(AFSHR)
  1.  S (AFSHXSAV,X)=$P(AFSHSZ,".",2) D JDATECV S AFSHDSVE=X
  1.  I $E(X,1,3)>280&(X<AFSHDLDT) G ZDEL
  1.  G FILEDELA
  1. ZDEL S AFSHFILN=$P(AFSHFLES(AFSHR),"^",2)
  1.  ;S AFSHCMD="rm "_%SDIR_"/"_AFSHFILN              ;ACR*2.1*13.06 IM14144
  1.  S X=$$DEL^%ZISH(%SDIR,AFSHFILN)                  ;ACR*2.1*13.06 IM14144
  1.  I X'=0 G FILEDELA
  1.  W !,AFSHFILN," UNIX FILE DELETED" K AFSHFLES("C",99999-AFSHXSAV,AFSHR),AFSHFLES("N",AFSHXSAV,$P(AFSHFILN,".",1),AFSHR),AFSHFLES(AFSHR)
  1.  S AFSHXPT=0,AFSHXPT=$O(^AFSTXLOG(DUZ(2),1,"B",AFSHFILN,AFSHXPT))
  1.  I +AFSHXPT>0 S DIK="^AFSTXLOG("_DUZ(2)_",1,",DA(1)=DUZ(2),DA=AFSHXPT D ^DIK
  1.  G FILEDELA
  1. FILEDEX G ENDX^AFSHARC1
  1.  ;
  1. JDATECV ;EP; JULIAN DATE CONVERSION
  1.  ; beginning Y2K fix block
  1.  ;S AFSHSZ=X ; X shoud be in the format YYJJJ where YY is a two digit year and JJJ is the julian date in the year. ;AFSH*3.0T1*1
  1.  ;S AFSHSZ=$E("00000",1,5-$L(AFSHSZ))_AFSHSZ ;pad with zeroes if less than 5 digits ;AFSH*3.0T1*1
  1.  ;I $L(X)=3 S X=$E(DT,1,3)-200_AFSHSZ S:AFSHSZ>AFSHDTJL X=$E(DT,1,3)-201_AFSHSZ
  1.  ;S AFSHSZ=X
  1.  ;I $L(X)'=5 S Y=-1 G JDATEQ
  1.  ;S AFSHJYR=$E(X,1,2),AFSHJDD=$E(X,3,5)
  1.  ;S AFSHZDT="0^31^59^90^120^151^181^212^243^273^304^334^365"
  1.  ;I (1700+200_AFSHJYR)#4=0 F I=4:1:13 S $P(AFSHZDT,"^",I)=$P(AFSHZDT,"^",I)+1
  1.  ;F I=1:1:13 Q:$P(AFSHZDT,"^",I)'<AFSHJDD
  1.  ;S AFSHDA=AFSHJDD-$P(AFSHZDT,"^",I-1),AFSHDA=$E("00",1,2-$L(AFSHDA))_AFSHDA
  1.  ;S AFSHMM=I-1,AFSHMM=$E("00",1,2-$L(AFSHMM))_AFSHMM,AFSHJYR=$E(DT,1,1)*100+AFSHJYR
  1.  ;S (X,Y)=AFSHJYR_AFSHMM_AFSHDA D DD^%DT
  1.  S AFSHSZ=X ;Y2000;AEF;AFSH*3.0T1*1
  1.  I $L(X)=3 S AFSHSZ=$E(DT,2,3)_X ;Y2000;AEF;AFSH*3.0T1*1
  1.  I $L(AFSHSZ)'=5 S Y=-1 G JDATEQ ;Y2000;AEF;AFSH*3.0T1*1
  1.  S AFSHJYR=$E(AFSHSZ,1,2) ;Y2000 YY
  1.  N %DT S X="0101"_AFSHJYR D ^%DT ;Y2000 get century
  1.  S X=$$FMADD^XLFDT(Y,AFSHSZ-(AFSHJYR_"000")-1) ;Y2000 X-AFSHJYR = JJJ
  1.  S Y=$$FMTE^XLFDT(X) ;Y2000 X is the internal date Y is the external
  1.  ; end Y2K fix Block
  1. JDATEQ K AFSHJYR,AFSHZDT,AFSHDA,AFSHMM,AFSHJDD,I Q
  1.  Q