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