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