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

BMXSQL2.m

Go to the documentation of this file. 
  1. BMXSQL2 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1.  ;
  1. FLDFILE(BMXIN)     ;EP - Returns name of file containing field BMXIN
  1.  ;in the form FILE^FIELD^FILENUMBER^FIELDNUMBER
  1.  ;Based on data contained in the BMXF() array
  1.  ;BMXIN can be either an unambiguous field name or FILE.FIELDNAME
  1.  ;
  1.  N C,BMXA,BMXB,BMXRET,BMXFILN,BMXFLDN,BMXFILNA
  1.  S BMXRET=""
  1.  I BMXTMPLT D  Q BMXRET
  1.  . S BMXFILNA=BMXIN
  1.  . I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
  1.  . I BMXF(BMXFILNA)'=BMXFO(1) S BMXERR="TEMPLATES ONLY SUPPORTED ON PRIMARY FILE" D ERROR^BMXSQL Q
  1.  . S BMXRET=BMXFILNA_U_"BMXIEN"_U_BMXF(BMXFILNA)_U_".001"
  1.  ;
  1.  I BMXIN["." D  Q BMXRET
  1.  . S BMXFILNA=$P(BMXIN,".") ;File Name
  1.  . I '$D(BMXF(BMXFILNA)) S BMXERR="FILE NOT FOUND" S BMXRET="" D ERROR^BMXSQL Q
  1.  . S BMXRET=BMXFILNA_U_$P(BMXIN,".",2)
  1.  . S $P(BMXRET,U,3)=BMXF(BMXFILNA)
  1.  . S BMXFLDN=0
  1.  . I $P(BMXIN,".",2)'="",$D(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2))) D
  1.  . . S BMXFLDN=$O(^DD(BMXF(BMXFILNA),"B",$P(BMXIN,".",2),0))
  1.  . I BMXIN["BMXIEN" S BMXFLDN=".001"
  1.  . I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
  1.  . S $P(BMXRET,U,4)=BMXFLDN
  1.  . Q
  1.  ;Loop through files in BMXF to locate field name
  1.  S C=0,BMXA=""
  1.  I 'BMXIEN F  S BMXA=$O(BMXF(BMXA)) Q:BMXA=""  D  Q:$D(BMXERR)
  1.  . I $D(^DD(BMXF(BMXA),"B",BMXIN)) S BMXRET=BMXA_U_BMXIN D  Q:$D(BMXERR)
  1.  . . S C=C+1
  1.  . . I C>1 S BMXERR="AMBIGUOUS FIELD NAME" D ERROR^BMXSQL Q
  1.  . . Q
  1.  . Q
  1.  I BMXIEN D
  1.  . S BMXA=BMXFO(1)
  1.  . S BMXA=BMXFNX(BMXA)
  1.  . S BMXRET=BMXA_U_BMXIN
  1.  . S C=1
  1.  I C=0 D  Q BMXRET
  1.  . S BMXRET="0^"_BMXIN ;String or numeric literal
  1.  S BMXFILNA=$P(BMXRET,U)
  1.  S BMXFILN=BMXF(BMXFILNA)
  1.  S $P(BMXRET,U,3)=BMXFILN
  1.  I $D(^DD(BMXFILN,"B",BMXIN)) D
  1.  . S BMXFLDN=$O(^DD(BMXFILN,"B",BMXIN,0))
  1.  I BMXIEN S BMXFLDN=".001"
  1.  I '+BMXFLDN S BMXERR="FIELD NOT FOUND",BMXRET="" D ERROR^BMXSQL Q
  1.  S $P(BMXRET,U,4)=BMXFLDN
  1.  Q BMXRET
  1.  ;
  1. DECSTR(BMXSTR)     ;EP
  1.  ;Decrements string collation value by 1
  1.  ;
  1.  N A,E,S,L,BMXRET
  1.  I BMXSTR="" Q BMXSTR
  1.  S L=$L(BMXSTR)
  1.  S E=$E(BMXSTR,L)
  1.  S B=$E(BMXSTR,1,L-1)
  1.  S A=$A(E)
  1.  S A=A-1
  1.  S E=$C(A)
  1.  S BMXRET=B_E
  1.  Q BMXRET
  1.  ;
  1. INCSTR(BMXSTR)     ;EP
  1.  ;Increments string collation value by 1
  1.  Q BMXSTR_$C(1)
  1.  ;
  1. SETX(BMXX,BMXFG,BMXSCR) ;EP
  1.  ;Set up executable screen code
  1.  ;by assembling pieces in BMXFG
  1.  ;and attach to executable iterator(s)
  1.  ;
  1.  ;IN:  BMXFG()
  1.  ;     BMXX() -- modified
  1.  ;OUT: BMXSCR
  1.  ;
  1.  N J
  1.  Q:'$D(BMXFG)
  1.  S BMXSCR=""
  1.  S J=0 F  S J=$O(BMXX(J)) Q:'+J  D
  1.  . S BMXX(J)=BMXX(J)_"X BMXSCR"
  1.  F J=1:1:BMXFG S BMXSCR=BMXSCR_BMXFG(J)
  1.  S BMXSCR=$S(BMXSCR]"":"I "_BMXSCR_" ",1:"")
  1.  S BMXSCR=BMXSCR_"D:'$D(^BMXTMP($J,""O"",D0)) OUT^BMXSQL"
  1.  I BMXFG("C") D
  1.  . N C
  1.  . S C=BMXFG("C")
  1.  . S BMXSCR("C")="F BMXC=1:1:"_C_" X BMXSCR(""C"",BMXC) S BMXSCR(""X"",BMXC)=X"
  1.  . F C=1:1:BMXFG("C") S BMXSCR("C",C)=BMXFG("C",C)
  1.  . S BMXSCR="X BMXSCR(""C"") "_BMXSCR
  1.  ;
  1.  Q