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

RGUTIMP.m

Go to the documentation of this file.
  1. RGUTIMP ;CAIRO/DKM - Import text into FileMan file;04-Sep-1998 11:26;DKM
  1. ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
  1. ;=================================================================
  1. ; Imports data from a specially formatted text file into a
  1. ; FileMan file.
  1. ; Inputs:
  1. ; RGINP = Full input file or global specification.
  1. ; RGTRACE= If nonzero, generates a debug trace.
  1. ; Outputs:
  1. ; Returns status code^status message. Status code of 0 means
  1. ; successful completion.
  1. ;=================================================================
  1. ENTRY(RGINP,RGTRACE) ;
  1. N RGLN,RGFN,RGLVL,RGBM,RGC,RGLBL,RGQT,RGST,RGIO,RGGBL
  1. S @$$TRAP^RGZOSF("ERROR^RGUTIMP")
  1. S RGFN=0,RGLVL=-1,RGTRACE=+$G(RGTRACE),RGST=0,RGIO=$I,U="^",RGC=0,RGGBL=$E(RGINP)=U
  1. I RGGBL S RGINP=$$CREF^DILF(RGINP)
  1. E D OPEN^RGZOSF(.RGINP,"R")
  1. F Q:$$READ D Q:RGST
  1. .U RGIO
  1. .W:RGTRACE=1 RGC,*13
  1. .W:RGTRACE=2 RGC_": ",$$TRUNC^RGUT(RGLN,$G(IOM,80)-$X-2),!
  1. .D DOIT(RGLN)
  1. D:'RGGBL CLOSE^RGZOSF(.RGINP)
  1. Q RGST
  1. READ() I 'RGGBL S RGC=RGC+1 Q $$READ^RGZOSF(.RGLN,RGINP)
  1. S RGC=$O(@RGINP@(RGC))
  1. Q:'RGC 1
  1. I $D(@RGINP@(RGC))#2 S RGLN=@RGINP@(RGC) Q 0
  1. I $D(@RGINP@(RGC,0))#2 S RGLN=@RGINP@(RGC,0) Q 0
  1. Q 1
  1. ERROR D ERR("Fatal error",$$EC^%ZOSV)
  1. Q RGST
  1. DOIT(RGLN) ;
  1. N RGZ,RGL,RGFLD,RGWP
  1. S RGLN=$$TRIM^RGUT(RGLN)
  1. I ";"[$E(RGLN) W:RGTRACE=3 $P(RGLN,";",2,999),! Q
  1. F RGL=0:1 Q:$E(RGLN,RGL+1)'="."
  1. S RGLN=$E(RGLN,RGL+1,999)
  1. I RGLN'[":" D ERR("Missing label",RGLN) Q
  1. S RGLBL=$$TRIM^RGUT($P(RGLN,":")),RGLN=$$TRIM^RGUT($P(RGLN,":",2,999))
  1. I 'RGL S RGFN=$$FILE(RGLN) Q
  1. I RGL>RGLVL D ERR("Invalid nesting",RGLN) Q
  1. S RGLVL=RGL,RGFN=+$P(RGBM(RGLVL),U,4)
  1. S RGFLD=$$FLD(RGLBL,RGFN)
  1. S RGZ=+$P($G(^DD(RGFN,RGFLD,0)),U,2)
  1. I RGZ D Q:RGST
  1. .S RGLVL=RGLVL+1,RGFN=RGZ,RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL-1),"+"_RGFN)
  1. .I +RGBM(RGLVL)<0 D ERR("Error access subfile entry",RGLBL) Q
  1. .S RGFLD=$$FLD(.01,RGFN)
  1. I 'RGFLD D ERR("Unknown field",RGLBL) Q
  1. I 'RGWP,RGLN="" Q
  1. ;S:RGLN="+" RGLN=U_$TR($P(RGBM(RGLVL),U,2),"|",",")_"$C(1))",RGLN=1+$O(@RGLN,-1)\1
  1. I RGFLD=.01!'RGBM(RGLVL)!RGWP D Q
  1. .I 'RGWP,RGFLD'=.01 D ERR("First field is not primary index",RGLBL) Q
  1. .I 'RGWP D
  1. ..S RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),"="_RGLN)
  1. ..S:+RGBM(RGLVL)'>0 RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),"="_$$UP^XLFSTR(RGLN))
  1. .S:+RGBM(RGLVL)'>0!RGWP RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),$S(RGLN="@"&'RGWP:RGLN,1:"~LX;.01///^S X=RGLN"))
  1. .I +RGBM(RGLVL)'>0,RGLN'="@" D ERR("Error adding entry",RGLN)
  1. S RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),"<"_RGFLD_"///^S X=RGLN")
  1. D:+RGBM(RGLVL)'>0 ERR("Error writing to field",RGLBL)
  1. Q
  1. FILE(RGFN) ;
  1. K RGBM
  1. S RGBM(1)=$$ENTRY^RGUTDIC(RGFN),RGLVL=1
  1. I +RGBM(1)'<0 S RGFN=+$P(RGBM(1),U,4)
  1. E D ERR("Error accessing database",RGFN)
  1. Q RGFN
  1. FLD(RGNM,RGFN) ;
  1. N RGZ
  1. S RGZ=$S(RGNM="":.01,RGNM=+RGNM:RGNM,1:+$O(^DD(RGFN,"B",RGNM,0)))
  1. I '$D(^DD(RGFN,RGZ,0)) S RGZ=0
  1. E S RGWP=$P(^(0),U,2)["W"
  1. Q RGZ
  1. ERR(RGMSG,RGX) ;
  1. S RGST=RGC_U_RGMSG_$S($D(RGX):": "_RGX,1:"")
  1. W:RGTRACE=2 RGC_": "_$P(RGST,U,2,999),!
  1. Q