| 1 | RGUTIMP ;CAIRO/DKM - Import text into FileMan file;04-Sep-1998 11:26;DKM
|
|---|
| 2 | ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
|
|---|
| 3 | ;=================================================================
|
|---|
| 4 | ; Imports data from a specially formatted text file into a
|
|---|
| 5 | ; FileMan file.
|
|---|
| 6 | ; Inputs:
|
|---|
| 7 | ; RGINP = Full input file or global specification.
|
|---|
| 8 | ; RGTRACE= If nonzero, generates a debug trace.
|
|---|
| 9 | ; Outputs:
|
|---|
| 10 | ; Returns status code^status message. Status code of 0 means
|
|---|
| 11 | ; successful completion.
|
|---|
| 12 | ;=================================================================
|
|---|
| 13 | ENTRY(RGINP,RGTRACE) ;
|
|---|
| 14 | N RGLN,RGFN,RGLVL,RGBM,RGC,RGLBL,RGQT,RGST,RGIO,RGGBL
|
|---|
| 15 | S @$$TRAP^RGZOSF("ERROR^RGUTIMP")
|
|---|
| 16 | S RGFN=0,RGLVL=-1,RGTRACE=+$G(RGTRACE),RGST=0,RGIO=$I,U="^",RGC=0,RGGBL=$E(RGINP)=U
|
|---|
| 17 | I RGGBL S RGINP=$$CREF^DILF(RGINP)
|
|---|
| 18 | E D OPEN^RGZOSF(.RGINP,"R")
|
|---|
| 19 | F Q:$$READ D Q:RGST
|
|---|
| 20 | .U RGIO
|
|---|
| 21 | .W:RGTRACE=1 RGC,*13
|
|---|
| 22 | .W:RGTRACE=2 RGC_": ",$$TRUNC^RGUT(RGLN,$G(IOM,80)-$X-2),!
|
|---|
| 23 | .D DOIT(RGLN)
|
|---|
| 24 | D:'RGGBL CLOSE^RGZOSF(.RGINP)
|
|---|
| 25 | Q RGST
|
|---|
| 26 | READ() I 'RGGBL S RGC=RGC+1 Q $$READ^RGZOSF(.RGLN,RGINP)
|
|---|
| 27 | S RGC=$O(@RGINP@(RGC))
|
|---|
| 28 | Q:'RGC 1
|
|---|
| 29 | I $D(@RGINP@(RGC))#2 S RGLN=@RGINP@(RGC) Q 0
|
|---|
| 30 | I $D(@RGINP@(RGC,0))#2 S RGLN=@RGINP@(RGC,0) Q 0
|
|---|
| 31 | Q 1
|
|---|
| 32 | ERROR D ERR("Fatal error",$$EC^%ZOSV)
|
|---|
| 33 | Q RGST
|
|---|
| 34 | DOIT(RGLN) ;
|
|---|
| 35 | N RGZ,RGL,RGFLD,RGWP
|
|---|
| 36 | S RGLN=$$TRIM^RGUT(RGLN)
|
|---|
| 37 | I ";"[$E(RGLN) W:RGTRACE=3 $P(RGLN,";",2,999),! Q
|
|---|
| 38 | F RGL=0:1 Q:$E(RGLN,RGL+1)'="."
|
|---|
| 39 | S RGLN=$E(RGLN,RGL+1,999)
|
|---|
| 40 | I RGLN'[":" D ERR("Missing label",RGLN) Q
|
|---|
| 41 | S RGLBL=$$TRIM^RGUT($P(RGLN,":")),RGLN=$$TRIM^RGUT($P(RGLN,":",2,999))
|
|---|
| 42 | I 'RGL S RGFN=$$FILE(RGLN) Q
|
|---|
| 43 | I RGL>RGLVL D ERR("Invalid nesting",RGLN) Q
|
|---|
| 44 | S RGLVL=RGL,RGFN=+$P(RGBM(RGLVL),U,4)
|
|---|
| 45 | S RGFLD=$$FLD(RGLBL,RGFN)
|
|---|
| 46 | S RGZ=+$P($G(^DD(RGFN,RGFLD,0)),U,2)
|
|---|
| 47 | I RGZ D Q:RGST
|
|---|
| 48 | .S RGLVL=RGLVL+1,RGFN=RGZ,RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL-1),"+"_RGFN)
|
|---|
| 49 | .I +RGBM(RGLVL)<0 D ERR("Error access subfile entry",RGLBL) Q
|
|---|
| 50 | .S RGFLD=$$FLD(.01,RGFN)
|
|---|
| 51 | I 'RGFLD D ERR("Unknown field",RGLBL) Q
|
|---|
| 52 | I 'RGWP,RGLN="" Q
|
|---|
| 53 | ;S:RGLN="+" RGLN=U_$TR($P(RGBM(RGLVL),U,2),"|",",")_"$C(1))",RGLN=1+$O(@RGLN,-1)\1
|
|---|
| 54 | I RGFLD=.01!'RGBM(RGLVL)!RGWP D Q
|
|---|
| 55 | .I 'RGWP,RGFLD'=.01 D ERR("First field is not primary index",RGLBL) Q
|
|---|
| 56 | .I 'RGWP D
|
|---|
| 57 | ..S RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),"="_RGLN)
|
|---|
| 58 | ..S:+RGBM(RGLVL)'>0 RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),"="_$$UP^XLFSTR(RGLN))
|
|---|
| 59 | .S:+RGBM(RGLVL)'>0!RGWP RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),$S(RGLN="@"&'RGWP:RGLN,1:"~LX;.01///^S X=RGLN"))
|
|---|
| 60 | .I +RGBM(RGLVL)'>0,RGLN'="@" D ERR("Error adding entry",RGLN)
|
|---|
| 61 | S RGBM(RGLVL)=$$ENTRY^RGUTDIC(RGBM(RGLVL),"<;"_RGFLD_"///^S X=RGLN")
|
|---|
| 62 | D:+RGBM(RGLVL)'>0 ERR("Error writing to field",RGLBL)
|
|---|
| 63 | Q
|
|---|
| 64 | FILE(RGFN) ;
|
|---|
| 65 | K RGBM
|
|---|
| 66 | S RGBM(1)=$$ENTRY^RGUTDIC(RGFN),RGLVL=1
|
|---|
| 67 | I +RGBM(1)'<0 S RGFN=+$P(RGBM(1),U,4)
|
|---|
| 68 | E D ERR("Error accessing database",RGFN)
|
|---|
| 69 | Q RGFN
|
|---|
| 70 | FLD(RGNM,RGFN) ;
|
|---|
| 71 | N RGZ
|
|---|
| 72 | S RGZ=$S(RGNM="":.01,RGNM=+RGNM:RGNM,1:+$O(^DD(RGFN,"B",RGNM,0)))
|
|---|
| 73 | I '$D(^DD(RGFN,RGZ,0)) S RGZ=0
|
|---|
| 74 | E S RGWP=$P(^(0),U,2)["W"
|
|---|
| 75 | Q RGZ
|
|---|
| 76 | ERR(RGMSG,RGX) ;
|
|---|
| 77 | S RGST=RGC_U_RGMSG_$S($D(RGX):": "_RGX,1:"")
|
|---|
| 78 | W:RGTRACE=2 RGC_": "_$P(RGST,U,2,999),!
|
|---|
| 79 | Q
|
|---|
