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

CIAUIMP.m

Go to the documentation of this file. 
  1. CIAUIMP ;MSC/IND/DKM - Import text into FileMan file;04-May-2006 08:19;DKM
  1.  ;;1.2;CIA UTILITIES;;Mar 20, 2007
  1.  ;;Copyright 2000-2006, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; Imports data from a specially formatted text file into a
  1.  ; FileMan file.
  1.  ; Inputs:
  1.  ;   CIAINP  = Full input file or global specification.
  1.  ;   CIATRACE= 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(CIAINP,CIATRACE) ;
  1.  N CIALN,CIAFN,CIALVL,CIABM,CIAC,CIALBL,CIAQT,CIAST,CIAIO,CIAGBL
  1.  S @$$TRAP^CIAUOS("ERROR^CIAUIMP")
  1.  S CIAFN=0,CIALVL=-1,CIATRACE=+$G(CIATRACE),CIAST=0,CIAIO=$I,U="^",CIAC=0,CIAGBL=$E(CIAINP)=U
  1.  I CIAGBL S CIAINP=$$CREF^DILF(CIAINP)
  1.  E  D OPEN^CIAUOS(.CIAINP,"R")
  1.  F  Q:$$READ  D  Q:CIAST
  1.  .U CIAIO
  1.  .W:CIATRACE=1 CIAC,*13
  1.  .W:CIATRACE=2 CIAC_": ",$$TRUNC^CIAU(CIALN,$G(IOM,80)-$X-2),!
  1.  .D DOIT(CIALN)
  1.  D:'CIAGBL CLOSE^CIAUOS(.CIAINP)
  1.  Q CIAST
  1. READ() I 'CIAGBL S CIAC=CIAC+1 Q $$READ^CIAUOS(.CIALN,CIAINP)
  1.  S CIAC=$O(@CIAINP@(CIAC))
  1.  Q:'CIAC 1
  1.  I $D(@CIAINP@(CIAC))#2 S CIALN=@CIAINP@(CIAC) Q 0
  1.  I $D(@CIAINP@(CIAC,0))#2 S CIALN=@CIAINP@(CIAC,0) Q 0
  1.  Q 1
  1. ERROR D ERR("Fatal error",$$EC^%ZOSV)
  1.  Q CIAST
  1. DOIT(CIALN) ;
  1.  N CIAZ,CIAL,CIAFLD,CIAWP
  1.  S CIALN=$$TRIM^CIAU(CIALN)
  1.  I ";"[$E(CIALN) W:CIATRACE=3 $P(CIALN,";",2,999),! Q
  1.  F CIAL=0:1 Q:$E(CIALN,CIAL+1)'="."
  1.  S CIALN=$E(CIALN,CIAL+1,999)
  1.  I CIALN'[":" D ERR("Missing label",CIALN) Q
  1.  S CIALBL=$$TRIM^CIAU($P(CIALN,":")),CIALN=$$TRIM^CIAU($P(CIALN,":",2,999))
  1.  I 'CIAL S CIAFN=$$FILE(CIALN) Q
  1.  I CIAL>CIALVL D ERR("Invalid nesting",CIALN) Q
  1.  S CIALVL=CIAL,CIAFN=+$P(CIABM(CIALVL),U,4)
  1.  S CIAFLD=$$FLD(CIALBL,CIAFN)
  1.  S CIAZ=+$P($G(^DD(CIAFN,CIAFLD,0)),U,2)
  1.  I CIAZ D  Q:CIAST
  1.  .S CIALVL=CIALVL+1,CIAFN=CIAZ,CIABM(CIALVL)=$$ENTRY^CIAUDIC(CIABM(CIALVL-1),"+"_CIAFN)
  1.  .I +CIABM(CIALVL)<0 D ERR("Error access subfile entry",CIALBL) Q
  1.  .S CIAFLD=$$FLD(.01,CIAFN)
  1.  I 'CIAFLD D ERR("Unknown field",CIALBL) Q
  1.  I 'CIAWP,CIALN="" Q
  1.  ;S:CIALN="+" CIALN=U_$TR($P(CIABM(CIALVL),U,2),"|",",")_"$C(1))",CIALN=1+$O(@CIALN,-1)\1
  1.  I CIAFLD=.01!'CIABM(CIALVL)!CIAWP D  Q
  1.  .I 'CIAWP,CIAFLD'=.01 D ERR("First field is not primary index",CIALBL) Q
  1.  .I 'CIAWP D
  1.  ..S CIABM(CIALVL)=$$ENTRY^CIAUDIC(CIABM(CIALVL),"="_CIALN)
  1.  ..S:+CIABM(CIALVL)'>0 CIABM(CIALVL)=$$ENTRY^CIAUDIC(CIABM(CIALVL),"="_$$UP^XLFSTR(CIALN))
  1.  .S:+CIABM(CIALVL)'>0!CIAWP CIABM(CIALVL)=$$ENTRY^CIAUDIC(CIABM(CIALVL),$S(CIALN="@"&'CIAWP:CIALN,1:"~LX;.01///^S X=CIALN"))
  1.  .I +CIABM(CIALVL)'>0,CIALN'="@" D ERR("Error adding entry",CIALN)
  1.  S CIABM(CIALVL)=$$ENTRY^CIAUDIC(CIABM(CIALVL),"<"_CIAFLD_"///^S X=CIALN")
  1.  D:+CIABM(CIALVL)'>0 ERR("Error writing to field",CIALBL)
  1.  Q
  1. FILE(CIAFN) ;
  1.  K CIABM
  1.  S CIABM(1)=$$ENTRY^CIAUDIC(CIAFN),CIALVL=1
  1.  I +CIABM(1)'<0 S CIAFN=+$P(CIABM(1),U,4)
  1.  E  D ERR("Error accessing database",CIAFN)
  1.  Q CIAFN
  1. FLD(CIANM,CIAFN) ;
  1.  N CIAZ
  1.  S CIAZ=$S(CIANM="":.01,CIANM=+CIANM:CIANM,1:+$O(^DD(CIAFN,"B",CIANM,0)))
  1.  I '$D(^DD(CIAFN,CIAZ,0)) S CIAZ=0
  1.  E  S CIAWP=$P(^(0),U,2)["W"
  1.  Q CIAZ
  1. ERR(CIAMSG,CIAX) ;
  1.  S CIAST=CIAC_U_CIAMSG_$S($D(CIAX):": "_CIAX,1:"")
  1.  W:CIATRACE=2 CIAC_": "_$P(CIAST,U,2,999),!
  1.  Q