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

TIUSRVT.m

Go to the documentation of this file. 
  1. TIUSRVT ; SLC/JM - Server functions for templates 8/23/2001 [8/19/04 1:57pm]
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**76,80,102,105,119,125,166**;Jun 20, 1997
  1.  ;
  1.  ; Nodes Returned by GETROOTS and GETITEMS
  1.  ;
  1.  ; Piece  Data
  1.  ; -----  ---------------------
  1.  ;   1    IEN
  1.  ;   2    TYPE
  1.  ;   3    STATUS
  1.  ;   4    NAME
  1.  ;   5    EXCLUDE FROM GROUP BOILERPLATE
  1.  ;   6    BLANK LINES
  1.  ;   7    PERSONAL OWNER
  1.  ;   8    HAS CHILDREN FLAG (0=NONE, 1=ACTIVE, 2=INACTIVE, 3=BOTH)
  1.  ;   9    DIALOG
  1.  ;  10    DISPLAY ONLY
  1.  ;  11    FIRST LINE
  1.  ;  12    ONE ITEM ONLY
  1.  ;  13    HIDE DIALOG ITEMS
  1.  ;  14    HIDE TREE ITEMS
  1.  ;  15    INDENT ITEMS
  1.  ;  16    REMINDER DIALOG IEN
  1.  ;  17    REMINDER DIALOG NAME
  1.  ;  18    LOCKED
  1.  ;  19    COM OBJECT POINTER
  1.  ;  20    COM OBJECT PARAMETER
  1.  ;  21    LINK POINTER
  1.  ;  22    REMINDER DIALOG PATIENT SPECIFIC VALUE
  1. GETROOTS(TIUY,USER) ;Get template root info
  1.  N IDX,TYPE
  1.  I +$G(USER) D ADDNODE(.IDX,$O(^TIU(8927,"AROOT",USER,0)),1)
  1.  F TYPE="R","TF","CF","OF" D
  1.  .D ADDNODE(.IDX,$O(^TIU(8927,"AROOT",$$ROOTIDX^TIUDDT(TYPE),0)),1)
  1.  Q
  1.  ;
  1. GETPROOT(TIUY,USER) ;Get personal template root info only
  1.  N IDX
  1.  I +$G(USER) D ADDNODE(.IDX,$O(^TIU(8927,"AROOT",USER,0)),1)
  1.  Q
  1.  ;
  1. GETITEMS(TIUY,TIUDA) ; Returns all children of a non-Template Node
  1.  N IDX,ITEM,SEQ,ITEMNODE
  1.  K ^TMP("TIU TEMPLATE",$J)
  1.  S TIUY=$NA(^TMP("TIU TEMPLATE",$J))
  1.  I $P($G(^TIU(8927,TIUDA,0)),U,3)'="T" D
  1.  .S (IDX,SEQ)=0
  1.  .F  S SEQ=$O(^TIU(8927,TIUDA,10,"B",SEQ)) Q:'SEQ  D
  1.  ..S ITEM=0
  1.  ..F  S ITEM=$O(^TIU(8927,TIUDA,10,"B",SEQ,ITEM)) Q:'ITEM  D
  1.  ...S ITEMNODE=$G(^TIU(8927,TIUDA,10,ITEM,0))
  1.  ...D ADDNODE(.IDX,$P(ITEMNODE,U,2))
  1.  Q
  1.  ;
  1. GETBOIL(TIUY,TIUDA) ;Returns a Template's Unexpanded Boilerplate Text
  1.  N IDX,LINE,TYPE
  1.  K ^TMP("TIU TEMPLATE",$J)
  1.  S TIUY=$NA(^TMP("TIU TEMPLATE",$J))
  1.  S (IDX,LINE)=0
  1.  S TYPE=$P($G(^TIU(8927,TIUDA,0)),U,3)
  1.  I (TYPE="T")!(TYPE="G") D
  1.  .F  S LINE=$O(^TIU(8927,TIUDA,2,LINE)) Q:'LINE  D
  1.  ..S IDX=IDX+1
  1.  ..S ^TMP("TIU TEMPLATE",$J,IDX)=$G(^TIU(8927,TIUDA,2,LINE,0))
  1.  Q
  1.  ;
  1. GETTEXT(TIUY,DFN,VSTR,TIUX) ; Expand Boilerplate
  1.  D BLRPLT^TIUSRVD(.TIUY,"",DFN,VSTR,"TIUX")
  1.  Q
  1. ISEDITOR(TIUY,ROOT,USER) ; Returns TRUE if user is a Template Editor
  1.  N CLASS,TIUERR
  1.  S CLASS=$P($G(^TIU(8927,ROOT,0)),U,7)
  1.  I 'CLASS S TIUY="^NO CLASS OWNER DEFINED"
  1.  E  D
  1.  .S TIUY=$$ISA^USRLM(USER,CLASS,.TIUERR)
  1.  .I 'TIUY,$D(TIUERR) S TIUY=U_TIUERR
  1.  Q
  1. LISTOWNR(TIUY,TIUFROM,DIR) ; Return subset of personal owners
  1.  N FILE,IENS,FIELDS,FLAGS,NUMBER,TIUPART,INDEX,SCREEN,ID,TIU,TIUERR
  1.  S FILE=200,FIELDS="@;.01",FLAGS="PB",INDEX="B",NUMBER=44
  1.  S (IENS,TIUPART,ID,TIU,TIUERR)=""
  1.  I DIR=1 S FLAGS="P"
  1.  S SCREEN="I $O(^TIU(8927,""AROOT"",Y,0))"
  1.  D LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,.TIUFROM,.TIUPART,INDEX,SCREEN,ID,"TIU","TIUERR")
  1.  K TIU("DILIST",0)
  1.  N DA,I
  1.  S DA="",I=0
  1.  F  S DA=$O(TIU("DILIST",DA),DIR) Q:'DA  D
  1.  . S I=I+1
  1.  . S TIUY(I)=$G(TIU("DILIST",DA,0))
  1.  Q
  1.  ;
  1.  ; Internal Routines
  1.  ;
  1. ADDNODE(IDX,TIUDA,INTIUY) ;Adds template node info
  1.  N DATA
  1.  S DATA=$$NODEDATA(TIUDA)
  1.  I DATA'="" D
  1.  .S IDX=$G(IDX)+1
  1.  .I $G(INTIUY) S TIUY(IDX)=DATA
  1.  .E  S ^TMP("TIU TEMPLATE",$J,IDX)=DATA
  1.  Q
  1.  ;
  1. NODEDATA(TIUDA) ;Returns template node data
  1.  N NODE,DATA,RDIEN
  1.  S DATA=""
  1.  I +TIUDA D
  1.  .S NODE=$G(^TIU(8927,TIUDA,0))
  1.  .S DATA=TIUDA_$$NP(3)_$$NP(4)_$$NP(1)_$$NP(5)_$$NP(2)_$$NP(6)_U_$$HASITEMS(TIUDA)_U_$P(NODE,U,8,14)
  1.  .S RDIEN=$P(NODE,U,15)
  1.  .I +RDIEN D
  1.  ..N RDN
  1.  ..S RDN=$G(^PXRMD(801.41,+RDIEN,0))
  1.  ..; TIU*166
  1.  ..I RDN'="" D
  1.  ...S $P(DATA,U,16)=RDIEN_U_$P(RDN,U,1)
  1.  ...S $P(DATA,U,22)=$S($P($G(RDN),U,17)=1:1,1:0)
  1.  .S $P(DATA,U,18)=$P(NODE,U,16,19)
  1.  Q DATA
  1.  ;
  1. NP(PNUM) ;Returns the piece of the node
  1.  Q U_$P(NODE,U,PNUM)
  1.  ;
  1. HASITEMS(TIUDA) ; Returns Has Children flag (0=NONE,1=ACTIVE,2=INACTIVE,3=BOTH)
  1.  N FLAG,FLAGA,FLAGI,ITEM,ITEMNODE
  1.  S (FLAG,FLAGA,FLAGI,ITEM)=0
  1.  I $P($G(^TIU(8927,TIUDA,0)),U,3)'="T" D
  1.  .F  S ITEM=$O(^TIU(8927,TIUDA,10,ITEM)) Q:'ITEM  D  Q:(FLAG=3)
  1.  ..S ITEMNODE=$P($G(^TIU(8927,TIUDA,10,ITEM,0)),U,2)
  1.  ..I +ITEMNODE D
  1.  ...I $P($G(^TIU(8927,ITEMNODE,0)),U,4)="A" S FLAGA=1
  1.  ...E  S FLAGI=2
  1.  ..S FLAG=FLAGA+FLAGI
  1.  Q FLAG
  1. SETTMPLT(SUCCESS,TIUDA,TIUX) ; Create/update a TEMPLATE
  1.  N FLD
  1.  S:'+TIUDA TIUDA=$$CREATE($G(TIUX(.01)),$G(TIUX(.03)))
  1.  S SUCCESS=TIUDA Q:'+SUCCESS
  1.  I $G(TIUX(.03))="R" S TIUX(.07)=+$$CLPAC^TIUSRVT1
  1.  F FLD=2,5 D  Q:$D(TIUX)'>9
  1.  . I +$O(TIUX(FLD,0)) D  Q:$D(TIUX)'>9
  1.  . . K ^TIU(8927,TIUDA,FLD)
  1.  . . I $G(TIUX(FLD,1))="@" K TIUX(FLD) Q
  1.  . . M ^TIU(8927,TIUDA,FLD)=TIUX(FLD) K TIUX(FLD)
  1.  . . D SETXT0^TIUSRVT1(TIUDA,FLD)
  1.  D FILE^TIUSRVT1(.SUCCESS,""""_TIUDA_",""",.TIUX)
  1.  Q
  1. CREATE(NAME,TYPE) ; Get or create TEMPLATE record
  1.  N DIC,DLAYGO,DR,X,Y
  1.  S (DIC,DLAYGO)=8927,DIC(0)="FL"
  1.  S X=""""_NAME_"""" D ^DIC
  1.  I +Y'>0 Q "0^ Unable to create a new TEMPLATE record."
  1.  Q +Y
  1. DELETE(SUCCESS,TIUDA) ; Delete TEMPLATES
  1.  ; Pass TIUDA as array of record numbers to be deleted by reference
  1.  ; SUCCESS will be returned as the actual number of templates deleted
  1.  N TIUI S (SUCCESS,TIUI)=0
  1.  F  S TIUI=$O(TIUDA(TIUI)) Q:+TIUI'>0  D
  1.  . N DA
  1.  . S DA=+TIUDA(TIUI)
  1.  . I 'DA Q
  1.  . L -^TIU(8927,DA,0):1 ; Unlock before deleting
  1.  . ; Quit if the Template is NOT an ORPHAN
  1.  . I +$O(^TIU(8927,"AD",DA,0)) Q
  1.  . ; Otherwise, call FileMan to DELETE the record
  1.  . D ZAP(DA) S SUCCESS=SUCCESS+1
  1.  Q
  1. ZAP(DA) ; Call ^DIK to remove an entry - CAREFUL...NO CHECKS
  1.  N DIK
  1.  S DIK="^TIU(8927," D ^DIK
  1.  Q
  1. SETITEMS(SUCCESS,TIUDA,TIUX) ; Change ITEMs of a group, class, or root
  1.  ; Receives:
  1.  ;   TIUDA=IEN of TEMPLATE record
  1.  ;   TIUX(SEQ)=IEN of item
  1.  ; Returns:
  1.  ;   SUCCESS(SEQ)=IEN of item if successful, or
  1.  ;                0^ Explanatory message if not
  1.  N TIUI S TIUI=0
  1.  D CLRITMS(TIUDA) ; Remove ITEMS
  1.  ; Iterate through TIUX and file items
  1.  F  S TIUI=$O(TIUX(TIUI)) Q:+TIUI'>0  D
  1.  . N TIUITEM,TIUSUCC
  1.  . S TIUITEM(.01)=TIUI,TIUITEM(.02)=TIUX(TIUI),TIUSUCC=TIUI
  1.  . D UPDATE^TIUSRVT1(.TIUSUCC,"""+"_TIUI_","_TIUDA_",""",.TIUITEM)
  1.  . S SUCCESS(TIUI)=TIUSUCC
  1.  Q
  1. CLRITMS(TIUDA) ; Remove all items from a group, class, or root
  1.  N DA S DA=0
  1.  F  S DA=$O(^TIU(8927,TIUDA,10,DA)) Q:+DA'>0  D
  1.  . N DIK S DIK="^TIU(8927,TIUDA,10,",DA(1)=TIUDA D ^DIK
  1.  Q
  1. OBJLST(TIUY) ; Get the list of active objects
  1.  N TIUDA,TIUD0,TIUI
  1.  S (TIUDA,TIUI)=0,TIUY=$NA(^TMP("TIU OBJECTS",$J)) K @TIUY
  1.  F  S TIUDA=$O(^TIU(8925.1,"AT","O",TIUDA)) Q:+TIUDA'>0  D
  1.  . S TIUD0=$G(^TIU(8925.1,TIUDA,0)) Q:'+$$CANPICK^TIULP(+TIUDA)
  1.  . S TIUI=TIUI+1
  1.  . S @TIUY@(TIUI)=TIUDA_U_$P(TIUD0,U,1,3)
  1.  Q
  1. BPCHECK(TIUTY,TIUX) ; Checks objects in boilerplate text.
  1.  N LINE,TIUI,TIUFWHO,TIUFPRIV,TIUY
  1.  S TIUI=0,TIUY=1,TIUFPRIV=1,TIUFWHO="M"
  1.  K ^TMP("TIUF",$J)
  1.  F  S TIUI=$O(TIUX(2,TIUI)) Q:+TIUI'>0  D  Q:'+TIUY
  1.  . S LINE=$G(TIUX(2,TIUI,0))
  1.  . I LINE["|" D
  1.  . . I ($L(LINE,"|")+1)#2 D  Q
  1.  . . . S TIUY=0
  1.  . . . S TIUTY(1)="Object split between lines, rest of line not checked:"
  1.  . . . S TIUTY(2)=LINE
  1.  . . N PIECE
  1.  . . F PIECE=2:2:$L(LINE,"|") D  Q:TIUY=0
  1.  . . . N OBJNM
  1.  . . . S OBJNM=$P(LINE,"|",PIECE)
  1.  . . . I OBJNM="" D  Q
  1.  . . . . S TIUY=0
  1.  . . . . S TIUTY(1)="Brackets are there, but there's no name inside ||:"
  1.  . . . . S TIUTY(2)=LINE
  1.  . . . N XREF,ARR
  1.  . . . F XREF="B","C","D" D  Q:'+TIUY
  1.  . . . . N ODA S ODA=0
  1.  . . . . F  S ODA=$O(^TIU(8925.1,XREF,OBJNM,ODA)) Q:+ODA'>0  D  Q:'+TIUY
  1.  . . . . . S:$D(^TIU(8925.1,"AT","O",ODA)) ARR(ODA)=""
  1.  . . . . . I $O(ARR($O(ARR(0)))) D
  1.  . . . . . . S TIUY=0
  1.  . . . . . . S TIUTY(1)="Object |"_OBJNM_"| is ambiguous."
  1.  . . . . . . S TIUTY(2)="It could be any of SEVERAL objects. Please contact IRM."
  1.  . . . I '$D(ARR) D  Q
  1.  . . . . S TIUY=0
  1.  . . . . S TIUTY(1)="Object |"_OBJNM_"| cannot be found in the file."
  1.  . . . . S TIUTY(2)="Use UPPERCASE and object's exact NAME, PRINT NAME, or ABBREVIATION."
  1.  . . . . S TIUTY(3)="Any of these may have changed since |"_OBJNM_"| was embedded."
  1.  . . . S ODA=$O(ARR(0)) N OBJCK D CHECK^TIUFLF3(ODA,0,0,.OBJCK)
  1.  . . . I '+OBJCK D  Q:'+TIUY
  1.  . . . . N SUBS
  1.  . . . . F SUBS="F","T","O","S","J" D
  1.  . . . . . I $D(OBJCK(SUBS)) D
  1.  . . . . . . S TIUY=0
  1.  . . . . . . S TIUTY(1)="Object |"_OBJNM_"| is faulty: "
  1.  . . . . . . S TIUTY(2)=OBJCK(SUBS)_"."
  1.  . . . I $P(^TIU(8925.1,ODA,0),U,7)'=11 D
  1.  . . . . S TIUY=0
  1.  . . . . S TIUTY(1)="Object |"_OBJNM_"| is NOT ACTIVE."
  1.  K ^TMP("TIUF",$J)
  1.  Q