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

ACHSARCH.m

Go to the documentation of this file.
  1. ACHSARCH ; IHS/ITSC/PMF - GENERIC BACKUP/ARCHIEVE UTILITY ; [ 10/31/2003 11:35 AM ]
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,7**;JUNE 11,2001
  1. ;Y2000 No fix required. Suspected data calculations are for file names
  1. ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Clarify error message; replace data retrieval from non-package global.
  1. ;ITSC/SET/JVK ACHS*3.1*7 7/21/2003 - Removed mode change for Cache
  1. Q
  1. ;
  1. TARBKUP ;EP
  1. ;;ACHSZFN = INPUT FILE NAME
  1. ;;ACHSZDIR = UNIX SUBDIRECTORY LOCATION OF INPUT FILE
  1. ;;ACHSDTYP = (Cartridge(C) or Tape (T) - default="C"
  1. ;
  1. I '$D(ACHSDTYP) S ACHSDTYP="C"
  1. I '$D(ACHSZDIR) S ACHSZDIR="/usr/mumps"
  1. S ACHSDTTP=$S(ACHSDTYP="C":"rct",ACHSDTYP="T":"rmt0")
  1. S ACHSDNAM=$S(ACHSDTYP="C":"Cartridge Tape",ACHSDTYP="T":"9-Track Tape")
  1. I '$D(ACHSZFN) G ERROR
  1. S ACHSFNLN=$L(ACHSZFN)
  1. U IO(0)
  1. W !!?10,"Backing up ",ACHSEXFN," to ",ACHSDNAM,!
  1. S ACHSHCMD="cd "_ACHSZDIR_"; tar -cvft /dev/"_ACHSDTTP_" "_ACHSZFN
  1. ;IHSIHS/ITSC/PMF 1/12/01 change call of vendor routine to call
  1. ;of routine in our namespace
  1. S ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
  1. ;
  1. U IO(0)
  1. I ACHSRTCD=0 W !!?10,"Backup to ",ACHSDNAM," was SUCCESSFUL" G TAREXIT
  1. ERROR ;
  1. W *7,!!?10,"Backup to ",ACHSDNAM," was NOT SUCCESSFUL -- NOTIFY SUPERVISOR"
  1. TAREXIT ;
  1. S ACHSHCMD="cd /usr/mumps"
  1. ;IHSIHS/ITSC/PMF 1/12/01 change call of vendor routine to call
  1. ;of routine in our namespace
  1. S ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
  1. ;
  1. G ENDX^ACHSARC1
  1. ;
  1. ARCHLIST ;EP
  1. Q:$D(DUOUT)!$D(DTOUT)
  1. ;;ACHSZFN = Input File Name
  1. ;;ACHSZOPT=0 -- NO Operator Interaction (Default)
  1. ;;ACHSZOPT=1 -- Ask Operator Questions
  1. ;;ACHSZDIR = Directory
  1. I '$D(ACHSZFN) U IO(0) W "FILE NAME ERROR" G ENDX^ACHSARC1
  1. S ACHSFNLN=$L(ACHSZFN)
  1. K ACHSJFLG
  1. I '$D(ACHSZOPT) S ACHSZOPT=0
  1. S ACHSZFNS=ACHSZFN
  1. K ACHSFILE
  1. I '$D(ACHSZDIR) S ACHSZDIR="/usr/mumps/"
  1. S ACHSDTJL=$E(DT,2,3)_$$JDT^ACHS(DT,1)
  1. S ACHSHCMD="cd "_ACHSZDIR_"; ls -l "_ACHSZFN_"*"_" | awk '{print $5,$9}' > afs.files"
  1. ;
  1. ;IHSIHS/ITSC/PMF 1/12/01 change call of vendor routine to call
  1. ;of routine in our namespace
  1. S ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
  1. ;
  1. S ACHSZFN=ACHSZDIR_$S($E(ACHSZDIR,$L(ACHSZDIR))="/":"",1:"/")_"afs.files",ACHSZZA=0
  1. ;IHS/JVK/SET ACHS*3.1*7 REMOVE BELOW
  1. ;S ACHSZIN=0
  1. ;
  1. ;TRY TO OPEN
  1. D OPENHFS^ACHSTCK1
  1. I ACHSZZA D ERROR^ACHSTCK1 G ABEND^ACHSARC1
  1. S (ACHSFCNT,ACHSDCNT)=0
  1. F ACHSI=1:1 U ACHSZDEV R ACHSX:1 Q:'$T Q:$$STATUS^%ZISH D SUB1
  1. S ACHSR=0
  1. G ENDX^ACHSARC1:ACHSZOPT=0
  1. U IO(0)
  1. W !!,"NUMBER OF PREVIOUSLY EXPORTED FILES = ",ACHSFCNT
  1. D SUB2
  1. I ACHSDCNT>0 G FILEDSP ;IF FILES FOUND LET THEM LIST
  1. I ACHSDCNT=0 W !,"NO FILES FOUND!" G LISTEND
  1. U IO(0)
  1. W !
  1. S Y=$$DIR^XBDIR("Y","Delete ALL Previously EXPORTED Files Processed BEFORE "_$$FMTE^XLFDT(ACHSDEDT),"Y")
  1. I Y=1 G FILEDEL
  1. G:$D(DUOUT)!$D(DTOUT) ARCHLIST
  1. FILEDSP ;
  1. W !
  1. K DIR
  1. S DIR("B")="Y",DIR(0)="Y",DIR("A")="Do you want to LIST Previously EXPORTED FILES?"
  1. D ^DIR
  1. G:$D(DUOUT)!$D(DTOUT) ARCHLIST
  1. I Y'=1 G ENDX^ACHSARC1
  1. A20 ;
  1. S (ACHSR,ACHSRR,ACHSSEQ)=0
  1. W !!,"SEQ # ","# RCDS EXPORT - DATE FILE NAME - SFX OK-TX? COLOR",!!
  1. FILEDSPA ;
  1. S ACHSR=$O(ACHSFILE("C",ACHSR))
  1. G LISTEND:+ACHSR=0
  1. FILEDSPB ;
  1. S ACHSRR=$O(ACHSFILE("C",ACHSR,ACHSRR))
  1. G FILEDSPA:+ACHSRR=0
  1. S ACHSFNAM=$P(ACHSFILE(ACHSRR),U,2),ACHSXPT=0,ACHSXPT=$O(^AFSTXLOG(DUZ(2),1,"B",ACHSFNAM,ACHSXPT))
  1. ;I +ACHSXPT<1 S ACHSEMSG="ERROR IN TX/EXPORT DATA STRUCTURE -- NOTIFY SUPERVISOR",ACHSJFLG=1 G JCANCEL^ACHSARC1;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. I +ACHSXPT<1 W !,"No entries for '"_ACHSFNAM_"' for "_$$LOC^ACHS_" in IHS DATA TRANSMISSION LOG file" G FILEDSPB ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. S ACHSTXST="N",$P(ACHSFILE(ACHSRR),U,3)="N"
  1. ;S:+ACHSXPT>0 ACHSTXST=$P($G(^AFSTXLOG(DUZ(2),1,ACHSXPT,0)),U,4),ACHSHCLR=$P($G(^AFSTXLOG(DUZ(2),1,ACHSXPT,0)),U,5),$P(ACHSFILE(ACHSRR),U,3)=ACHSTXST;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. S:+ACHSXPT>0 ACHSTXST=$$GET1^DIQ(9002320.52,ACHSXPT_","_DUZ(2)_",",3,"I"),ACHSHCLR=$$GET1^DIQ(9002320.52,ACHSXPT_","_DUZ(2)_",",3.11),$P(ACHSFILE(ACHSRR),U,3)=ACHSTXST ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. ;S ACHSHCLR=$S(ACHSHCLR="R":"RED",ACHSHCLR="B":"BLUE",1:"");IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. S X=$P($P(ACHSFILE(ACHSRR),".",2),U,1)
  1. S Y=$$GDT^ACHS($E(X,3,5))
  1. S X=$P(ACHSFILE(ACHSRR),U,1),Z=X/81,X=$J(Z,0,0)
  1. S ACHSSEQ=ACHSSEQ+1
  1. W $J(ACHSSEQ,3),?6,$J(X,6),?17,Y
  1. S Z=$P(ACHSFILE(ACHSRR),U,2)
  1. S X=$P(Z,".",1)
  1. W ?33,$E(X,1,ACHSFNLN),?45,$E(X,ACHSFNLN+1,ACHSFNLN+1),?51,ACHSTXST,?57,$S(ACHSHCLR="R":"RED",ACHSHCLR="B":"BLUE",1:""),!
  1. G FILEDSPB
  1. ;
  1. LISTEND ;
  1. K DIR
  1. S DIR(0)="E",DIR("A")="Enter RETURN to Continue"
  1. D ^DIR
  1. I Y=0 S %="M9",ACHSEMSG=$P($T(@%^ACHSTCK1),";;",2),ACHSJFLG=1 G JCANCEL^ACHSARC1
  1. G ENDX^ACHSARC1
  1. ;
  1. SUB1 ;
  1. S ACHSFCNT=ACHSFCNT+1
  1. S ACHSFILE(ACHSI)=$P(ACHSX," ",1)_U_$P(ACHSX," ",2),ACHSY=$P($P(ACHSX," ",2),".",2)
  1. Q:+ACHSY<1
  1. I '$D(ACHSFILE("C",ACHSY)) S ACHSDCNT=ACHSDCNT+1
  1. S ACHSFILE("C",99999-ACHSY,ACHSI)=""
  1. S ACHSZ=$P($P(ACHSX," ",2),"."),ACHSFILE("N",ACHSY,ACHSZ,ACHSI)=""
  1. Q
  1. ;
  1. SUB2 ;FIND LATEST DATE OF FILE IN SYSTEM. CHANGE MADE BECAUSE PREVIOUS
  1. ;CODE COULD NOT HANDLE LESS THAN THREE FILES SAVED OFF
  1. S ACHSR=0,ACHSLDAT=0
  1. SUB2A F ACHSDCNT=0:1 S ACHSR=$O(ACHSFILE("C",ACHSR)) Q:ACHSR="" D
  1. .S ACHSLDAT=99999-ACHSR
  1. .S ACHSDEDT=$$JTF^ACHS($E(ACHSLDAT,3,5))
  1. Q
  1. ;
  1. FILEDEL ;
  1. S ACHSR=0
  1. W !
  1. FILEDELA ;
  1. S ACHSR=$O(ACHSFILE(ACHSR))
  1. G FILEDEX:+ACHSR=0
  1. S Z=ACHSFILE(ACHSR)
  1. S (ACHSXSAV,X)=$P(Z,".",2)
  1. S ACHSDSAV=$$JTF^ACHS(X)
  1. I $E(X,1,3)>280,X<ACHSDEDT G ZDEL
  1. G FILEDELA
  1. ;
  1. ZDEL ;
  1. S ACHSFLNM=$P(ACHSFILE(ACHSR),U,2)
  1. I $$DEL^%ZISH(ACHSZDIR,ACHSFLNM) G FILEDELA
  1. W !,ACHSFLNM," FILE DELETED"
  1. K ACHSFILE("C",99999-ACHSXSAV,ACHSR),ACHSFILE("N",ACHSXSAV,$P(ACHSFLNM,".",1),ACHSR),ACHSFILE(ACHSR)
  1. S ACHSXPT=0,ACHSXPT=$O(^AFSTXLOG(DUZ(2),1,"B",ACHSFLNM,ACHSXPT))
  1. I +ACHSXPT>0 S DIK="^AFSTXLOG("_DUZ(2)_",1,",DA(1)=DUZ(2),DA=ACHSXPT D ^DIK
  1. G FILEDELA
  1. ;
  1. FILEDEX ;
  1. G ENDX^ACHSARC1
  1. ;