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

INHZTFS1.m

Go to the documentation of this file. 
  1. %ZTFS1 ; cmi/flag/maw - Ed de Moel 11:53 ; [ 05/22/2002  2:54 PM ]
  1.  ;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001
  1.  ;CHCS TLS_4602; GEN 2; 12-NOV-1998
  1.  ;COPYRIGHT 1991 SAIC
  1.  ;--space for CMS stamp---
  1.  ;
  1. OPENSEQ(FILE,ACC,XFILEDEF) ;
  1.  ; SET DEVICE=$$OPENSEQ^%ZTFS1(FILE,ACCESS)
  1.  ;     Opens the sequential file identified by FILE and
  1.  ;     returns the identifier to be used for the file as
  1.  ;     the function value.
  1.  ;     Default file access is 'read from beginning'.
  1.  ;
  1.  ;   FILE      = name of file, needs to conform to operating
  1.  ;               system requirements
  1.  ;   ACCESS    = type of access
  1.  ;              IF ACCESS["R"  file must be readable
  1.  ;              IF ACCESS["W"  file must be writeable
  1.  ;              IF ACCESS["A"  initial position will be at end-of-file
  1.  ;                             so that data can be appended
  1.  ;              IF ACCESS["B"  initial position will be at start-of-file
  1.  ;                             so that data can be overwritten
  1.  ;              IF ACCESS["S"  the file will be opened for shared access
  1.  ;
  1.  ;   XFILEDEF  = name of FDL file to use when creating file
  1.  ;               needs to conform to operating system requirements
  1.  ;
  1.  N XRD,XWR,XBG,XAP,XT,XTR
  1.  S $ZT="ERR",ACC=$G(ACC) S:ACC="" ACC="RB" S ACC=$$UPCASE^%ZTF(ACC)
  1.  S XBG=ACC["B",XAP=ACC["A",XRD=ACC["R",XWR=ACC["W"
  1.  I $TR(ACC,"BRAW")'="" Q ""
  1.  I 'XRD,'XWR Q ""
  1.  I XBG,XAP Q ""
  1.  I XAP,XRD Q ""
  1.  ;I XRD,$ZSEARCH(FILE)="" Q ""
  1.  ; Force check the existence of the file if reading from the file
  1.  I XRD,'$$PARSE(FILE,1) Q ""
  1.  ; Don't force check the existence of the file if writing to the file
  1.  I XWR,'$$PARSE(FILE) Q ""
  1.  ;I 'XRD,XWR,XBG,$L($G(XFILEDEF)) S %=$ZC(%FDLCREATE,XFILEDEF,FILE) O % U % Q $ZI
  1.  I XBG,'XRD O FILE:NEWVERSION U FILE Q $ZI
  1.  I XBG,'XWR O FILE:READONLY U FILE Q $ZI
  1.  I XBG O FILE:NOSEQUENTIAL U FILE:RFA="1,0" Q $ZI
  1.  I XAP O FILE U FILE Q $ZI
  1.  I XWR O FILE:NEWVERSION U FILE Q $ZI
  1.  O FILE:READONLY:30 Q:'$T "" U FILE Q $ZI
  1. ERR Q ""
  1.  ;
  1. OPENRAN(FILE,ACC,WHERE) ;
  1.  ; SET DEVICE=$$OPENRAN^%ZTFS1(FILE,ACCESS,WHERE)
  1.  ;     Opens the sequential file identified by FILE and
  1.  ;     returns the identifier to be used for the file as
  1.  ;     the function value.
  1.  ;     Default file access is 'read from beginning'.
  1.  ;
  1.  ;   FILE      = name of file, needs to conform to operating
  1.  ;               system requirements
  1.  ;   ACCESS    = type of access
  1.  ;              IF ACCESS["R"  file must be readable
  1.  ;              IF ACCESS["W"  file must be writeable
  1.  ;              IF ACCESS["S"  the file will be opened for shared access
  1.  ;   WHERE     = initial file position
  1.  ;
  1.  N XRD,XWR,XT,XTR
  1.  S $ZT="ERR",ACC=$G(ACC) S:ACC="" ACC="R" S ACC=$$UPCASE^%ZTF(ACC)
  1.  S XRD=ACC["R",XWR=ACC["W"
  1.  I $TR(ACC,"RW")'="" Q ""
  1.  I 'XRD,'XWR Q ""
  1.  I XRD,'$$PARSE(FILE,1) Q ""
  1.  I XWR,'$$PARSE(FILE) Q ""
  1.  I 'XRD O FILE:NEWVERSION U FILE Q $I
  1.  I 'XWR O FILE:(NOSEQUENTIAL:READONLY) U FILE:RFA=WHERE Q $I
  1.  O FILE:NOSEQUENTIAL:30 Q:'$T "" U FILE:RFA=WHERE Q $I
  1.  ;
  1. READSEQ(FILE) ;
  1.  ; SET LINE=$$READSEQ(FILE)
  1.  ;       reads a line from the specified sequential file and
  1.  ;       returns the text of this line as the function value.
  1.  ;       The device identifier is preferably obtained through
  1.  ;       SET FILE=$$OPENSEQ(...) in this module.
  1.  ;  ***  As a side effect, local variable EOF is     **********
  1.  ;  ***  set to 0 when a line could be successfully  **********
  1.  ;  ***  read, or to 1 when end of file is reached.  **********
  1.  ;
  1.  N X
  1.  S EOF=0,$ZT="END" U FILE R X Q X
  1. END U 0 I $ZE'["ENDOFILE" ZQ
  1.  S EOF=1 Q ""
  1. CLOSESEQ(FILE,DISPOSE) ;
  1.  ; SET STATUS=$$CLOSESEQ^%ZTFS1(FILE[,DISPOSE])
  1.  ;     Closes the sequential file identified by FILE and
  1.  ;     optionally performs a special close-disposition.
  1.  ;       The device identifier is preferably obtained through
  1.  ;       SET FILE=$$OPENSEQ(...) in this module.
  1.  ;     Possible close-dispositions are:
  1.  ;          "DELETE"
  1.  ;          "PRINT/QUEUE=queuename"
  1.  ;          "SUBMIT/QUEUE=queuename"
  1.  ;
  1.  I $G(DISPOSE)="DELETE" C FILE:DELETE Q 1
  1.  C FILE Q 1
  1. GETPOS(FILE) ;
  1.  ; SET WHERE=$$GETPOS^%ZTFS1(FILE)
  1.  ;     Makes the named file the current device and returns the
  1.  ;     current file position as the function value.
  1.  ;
  1.  U FILE Q $ZB
  1. POSSEQ(FILE,WHERE) ;
  1.  ; DO POSSEQ(FILE,WHERE)
  1.  ;     Changes the file position of the named file to the spefified
  1.  ;     location.
  1.  ;
  1.  U FILE:RFA=WHERE Q
  1.  ;
  1. PARSE(FILE,EXIST,SHOWMSG) ; Parse a file spec.
  1.  ;
  1.  ; Input: FILE ==> File Spec in DEVICE:[DIRECTORY]NAME format
  1.  ;                 if DEVICE is null, current device is assumed
  1.  ;                 if DIRECTORY is null, current directory is assumed
  1.  ;
  1.  ;       EXIST ==> 1 to force check the existence of the file
  1.  ;                 0 Do not check the existence of the file (Default)
  1.  ;
  1.  ;       SHOWMSG ==> 1 If display of error message is desired
  1.  ;                   0 If display of error message is not desired (Def)
  1.  ; Note: Device and directory must exist for both read and write
  1.  ;       operations no matter how EXIST is passed.
  1.  ;
  1.  ;Output: E1   ==> Null input file spec
  1.  ;        E2   ==> Device does not exist
  1.  ;        E3   ==> Directory does not exist
  1.  ;        E4   ==> File not found
  1.  ;        1    ==> File spec was parsed
  1.  ;
  1.  ; Usage: I '$$PARSE^%ZTFS1(FILENAME,1) Q
  1.  ;
  1.  N XDEV,XDIR,XEXIST,XF,XLDEV,XMSG,XNAME,XSHOW,XTRN
  1.  S XEXIST=$G(EXIST) S:'$L(XEXIST) XEXIST=0
  1.  S XSHOW=$G(SHOWMSG),XF=$G(FILE) I '$L(XF) D  Q "E1^"_XMSG
  1.  .S XMSG="NULL INPUT FILE SPEC" W:XSHOW !,*7,XMSG
  1.  ;S XTRN=$&ZLIB.%TRNLNM(XF) S:$L(XTRN) XF=XTRN
  1.  ;S XDEV=$&ZLIB.%PARSE(XF,,,"DEV",1)
  1.  ;S XLDEV=$&ZLIB.%TRNLNM($E(XDEV,1,$L(XDEV)-1)) S:$L(XLDEV) XDEV=XLDEV
  1.  ;I $&ZLIB.%GETDVI(XDEV,"EXISTS")=0 D  Q "E2^"_XMSG
  1.  .S XMSG="DEVICE "_XDEV_" DOES NOT EXIST" W:XSHOW !,*7,XMSG
  1.  ; If device is not a directory structured device (e.g. NL:) quit 1
  1.  ;I $L(XDEV),'($&ZLIB.%GETDVI(XDEV,"DIR")) Q 1
  1.  ;S XDIR=$&ZLIB.%PARSE(XF,,,"DIR") I '$L(XDIR) D  Q "E3^"_XMSG
  1.  .S XMSG="DIRECTORY DOES NOT EXIST" W:XSHOW !,*7,XMSG
  1.  ;S XNAME=$&ZLIB.%PARSE(XF,,,"NAME",XEXIST)
  1.  I XNAME="" D  Q "E4^"_XMSG
  1.  .S XMSG="FILE "_FILE_" NOT FOUND" W:XSHOW !,*7,XMSG
  1.  I 'XEXIST Q 1
  1.  I $L($ZSEARCH(FILE)) Q 1
  1.  S XMSG="FILE "_FILE_" NOT FOUND" W:XSHOW !,*7,XMSG
  1.  Q "E4^"_XMSG