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

TIUSRVF1.m

Go to the documentation of this file. 
  1. TIUSRVF1 ; SLC/JM - Server calls for Template Fields ; 02/06/2002
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**105,127,132**;Jun 20, 1997
  1. ISUNIQUE(TIUY,NAME,IEN) ; Is Name Unique?
  1.  N FLD
  1.  S FLD=+$O(^TIU(8927.1,"B",NAME,0))
  1.  I +FLD,FLD'=IEN S TIUY=0
  1.  E  S TIUY=1
  1.  Q
  1. LOCK(TIUY,TIUDA) ; Lock Template Field
  1.  L +^TIU(8927.1,TIUDA,0):1
  1.  S TIUY=$T
  1.  Q
  1. UNLOCK(TIUY,TIUDA) ; Unlock Template Field
  1.  L -^TIU(8927.1,TIUDA,0)
  1.  S TIUY=1
  1.  Q
  1. DELETE(TIUY,TIUDA) ; Call ^DIK to remove a Template Field
  1.  N DIK,DA
  1.  S DA=+TIUDA
  1.  D UNLOCK(.TIUY,.TIUDA)
  1.  S DIK="^TIU(8927.1," D ^DIK
  1.  S TIUY=1
  1.  Q
  1. LIST(Y,FROM,DIR)    ; Long list of Template Fields
  1.  ; .Y=returned list, FROM=text to $O from, DIR=$O direction
  1.  N I,DA,CNT,TIUD0,NODE
  1.  S I=0,CNT=80,DIR=$G(DIR,1)
  1.  F  Q:I'<CNT  S FROM=$O(^TIU(8927.1,"B",FROM),DIR) Q:FROM=""  D
  1.  . S DA=0
  1.  . F  Q:I'<CNT  S DA=$O(^TIU(8927.1,"B",FROM,DA)) Q:+DA'>0  D
  1.  .. S I=I+1,Y(I)=DA_U_FROM
  1.  .. S NODE=$G(^TIU(8927.1,DA,0))
  1.  .. I +$P(NODE,U,3) S Y(I)=Y(I)_" <Inactive>"
  1.  .. S Y(I)=Y(I)_U_$P(NODE,U,2)_U_$P(NODE,U,8)_U_$P(NODE,U,16)
  1.  Q
  1. CANEDIT(TIUY) ; Returns TRUE if the current user can edit dialog fields
  1.  S TIUY=0
  1.  I '+DUZ Q
  1.  N TIUCLASS,TIUERR,IDX,SRV
  1.  S SRV=$P($G(^VA(200,DUZ,5)),U)
  1.  D GETLST^XPAR(.TIUCLASS,DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","TIU FIELD EDITOR CLASSES","Q",.TIUERR)
  1.  I TIUERR>0 Q
  1.  S IDX=0
  1.  F  S IDX=$O(TIUCLASS(IDX)) Q:'IDX  D  Q:+TIUY
  1.  .I $$ISA^USRLM(DUZ,$P(TIUCLASS(IDX),U,2),.TIUERR) S TIUY=1
  1.  Q
  1. DOLMLINE(TIUX) ; finds Template Fields in a Line and replaces with LM Text
  1.  N I,J,OUT,NAME,LMTEXT,IDX
  1.  S OUT=TIUX
  1.  F  S I=$F(OUT,"{FLD:") Q:'I  D
  1.  . S J=$F(OUT,"}",I)
  1.  . I J>0 S NAME=$E(OUT,I,J-2)
  1.  . E  S NAME="",J=I
  1.  . S LMTEXT=""
  1.  . I NAME'="" D
  1.  . . S IDX=$O(^TIU(8927.1,"B",NAME,0))
  1.  . . I +IDX S LMTEXT=$P($G(^TIU(8927.1,IDX,0)),U,6)
  1.  . S OUT=$E(OUT,1,I-6)_LMTEXT_$E(OUT,J,512)
  1.  Q OUT
  1. DOLMTEXT(TIUY,TIULIST) ; finds Template Fields and replaces with LM Text
  1.  N I,LINE
  1.  S I=0
  1.  F  S I=$O(TIULIST(I)) Q:'I  D
  1.  . S TIUY(I)=$$DOLMLINE(TIULIST(I,0))
  1.  Q
  1. CHKFLD(RESULT) ;Input: <None>
  1.  ;Output: RESULT (see below for description)
  1.  ;Similar to IMPORT^TIUSRVF; takes and parses XML fields to
  1.  ;see if they have a matching field in the database.  Also resolves self
  1.  ;referencing fields, and updates the XML.  Returns RESULT, which is a 
  1.  ;list of fields in format ORIGINAL_FIELD_NAME^CODE^NEW_FIELD_NAME.
  1.  ;If the CODE is 1 or 2, then the NEW_FIELD_NAME is blank.  If the CODE
  1.  ;is 0, then the NEW_FIELD_NAME has the renamed field name.  In that 
  1.  ;case, the XML has been updated with the new name where ever the 
  1.  ;original name had occurred.
  1.  N FIRST,RENAME,SAVESET,I,J,X,Y,OLD,ERR,CURS,CUR,RSET,K,FSET
  1.  S FIRST=1,RENAME=0,I=0,ERR=0,FSET="^TMP(""TIUFLDXML"",$J)"
  1.  ;LOOP UNTIL THE XML FIELD NAMES DON'T NEED TO BE RENAMED AND THE 
  1.  ;XML NO LONGER NEEDS TO BE UPDATED
  1.  F  D  Q:ERR!('RENAME)
  1.  .D IMPORT2^TIUSRVF(.RSET,FSET,0)
  1.  .I FIRST S FIRST=0,I=0 F  S I=$O(RSET(I)) Q:I'>0  S SAVESET(I)=$P(RSET(I),U,1)
  1.  .S I=0
  1.  .F  S I=$O(RSET(I)) Q:(I'>0)!ERR  I $P(RSET(I),U,3)="XML FORMAT ERROR" S ERR=1
  1.  .Q:ERR
  1.  .S I=0,RENAME=0
  1.  .;LOOP THROUGH THE NAMES AND RENAME DUPLICATE NAMES
  1.  .F  S I=$O(RSET(I)) Q:I'>0  D
  1.  ..S CURS=$P(RSET(I),U,2),X=1
  1.  ..I CURS="0" S X=3,RENAME=1
  1.  ..I $L(CURS)>1 D
  1.  ...S CURS=$E(CURS,3,$L(CURS)),OLD=$P(RSET(I),U,1)
  1.  ...I CURS=OLD S RSET(I)=CURS_U_2
  1.  ...E  S RSET(I)=OLD_U_0_U_CURS,X=3,RENAME=1
  1.  ..S CUR=$P(RSET(I),U,X),J=0
  1.  ..F  S J=$O(RSET(J)) Q:(J'<I)  D
  1.  ...S K=$P(RSET(J),U,2),Y=1 I +K=0 S Y=3
  1.  ...S OLD=$P(RSET(J),U,Y)
  1.  ...I OLD=CUR D  ;SAME NAME FOUND; RENAME CURRENT ITEM
  1.  ....S Y=1
  1.  ....I X=3 S Y=1+(+$E(CUR,$L($P(RSET(I),U,1))+1,$L(CUR)))
  1.  ....S $P(RSET(I),U,2)=0,$P(RSET(I),U,3)=$P(RSET(I),U,1)_Y
  1.  ....S X=3,J=0,CUR=$P(RSET(I),U,X),RENAME=1
  1.  .I RENAME D UPDTXML(.RSET,FSET)
  1.  I 'ERR D
  1.  .S I=0,J=0
  1.  .F  S I=$O(SAVESET(I)) S J=$O(RSET(J)) Q:(I'>0)!(J'>0)  D
  1.  ..I SAVESET(I)'=$P(RSET(J),U,1) D
  1.  ...S Y=$P(RSET(J),U,2)
  1.  ...I +Y=1 S X=0 ; CHANGE THIS X=0 TO X=3 WHEN THE GUI IS READY
  1.  ...E  S X=0
  1.  ...S $P(RSET(J),U,2)=X,$P(RSET(J),U,3)=$P(RSET(J),U,1),$P(RSET(J),U,1)=SAVESET(I)
  1.  S I=0,J=0
  1.  F  S I=$O(RSET(I)),J=J+1 Q:I'>0  S RESULT(J)=RSET(I)
  1.  Q
  1. UPDTXML(NAMESET,XSET) ; UPDATES THE XSET WITH UPDATED NAMES IN THE NAMESET
  1.  N FND,I,J,PA1,PA2,PB1,PB2,P1,P2,P3
  1.  S I=0,J=0
  1.  F  S I=$O(NAMESET(I)) Q:I'>0  D
  1.  .I $P(NAMESET(I),U,2)="0" S J=J+1
  1.  .E  K NAMESET(I)
  1.  Q:J'>0
  1.  S I=0
  1.  F  S I=$O(NAMESET(I)) Q:I'>0  D
  1.  .S P1=$P(NAMESET(I),U,1),P2=$P(NAMESET(I),U,2),P3=$P(NAMESET(I),U,3)
  1.  .S NAMESET(I)=$$XMLCONV^TIUSRVF(P1,0,1)_U_P2_U_$$XMLCONV^TIUSRVF(P3,0,1)
  1.  S I=0
  1.  ;MAIN LOOP - CURRENT XML LINE
  1.  F  S I=$O(@XSET@(I)),FND=0,J=0 Q:I'>0  D
  1.  .S PA1=$F(@XSET@(I),"<FIELD NAME="""),PA2=$F(@XSET@(I),"""",PA1)
  1.  .S PB1=$F(@XSET@(I),"{FLD:"),PB2=$F(@XSET@(I),"}",PB1)
  1.  .I (PA1&PA2) S PA2=PA2-2,FND=1
  1.  .I (PB1&PB2) S PA1=PB1,PA2=PB2-2,FND=1
  1.  .I FND F  S J=$O(NAMESET(J)) Q:J'>0  D  Q:J'>0
  1.  ..I $P(NAMESET(J),U,2)=0,$E(@XSET@(I),PA1,PA2)=$P(NAMESET(J),U,1) D
  1.  ...S $E(@XSET@(I),PA1,PA2)=$P(NAMESET(J),U,3),J=0
  1.  Q
  1. XFLDLD(RESULT,IN) ; RESETS/UPDATES THE TMP("TIUFLDXML",$J) GLOBAL
  1.  ;WITH THE STRING PASSED IN "IN".  IF THE 1ST LINE IS SUBSCRIPTED
  1.  ;AS 1, THE PROGRAM CLEARS THE TMP GLOBAL FIRST.  RETURNS "1" IF
  1.  ;THIS CALL WAS SUCCESSFUL, "0" OTHERWISE.
  1.  N X
  1.  S X=0
  1.  S X=$O(IN(X))
  1.  I +X=1 K ^TMP("TIUFLDXML",$J)
  1.  M ^TMP("TIUFLDXML",$J)=IN
  1.  S RESULT(1)=1
  1.  Q
  1. LIMPORT(RESULT) ; Calls the import process to import all of the fields in the
  1.  ;^TMP global for this process.  Result contains a list of NAME^X^RENAME
  1.  ;strings.
  1.  D IMPORT2^TIUSRVF(.RESULT,"^TMP(""TIUFLDXML"",$J)",1)
  1.  Q