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

TIUEDI1.m

Go to the documentation of this file. 
  1. TIUEDI1 ; SLC/MAM - Additional Edit Code ;March 25, 2004
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**7,22,66,61,100,166**;Jun 20, 1997
  1. GETREC(DFN,TIU,TIUCREAT,TIUNEW,TIUDPRM,TIUINQ,TIUPERSN) ;Returns
  1.  ;new or existing document DA.
  1.  ; Receives TIUPERSN (optional) = person asking to edit/create docmt,
  1.  ;             or for upload, = author of document.
  1.  ;             If not received, assumed to be DUZ.
  1.  ;             New **ID** parameter, backward compatible
  1.  ; Requires array TIUTYP where
  1.  ;   TIUTYP = title DA
  1.  ;   TIUTYP(1) = 1^title DA^Name
  1.  ; Receives TIUCREAT for backward compatibility place holder only
  1.  S TIUPERSN=$G(TIUPERSN,DUZ)
  1.  S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,+$G(TIUINQ),TIUPERSN)
  1.  Q +$G(DA)
  1.  ;
  1. INQUIRE() ; Ask user whether to create a new note anyway
  1.  N TIUY,TIUPRMT
  1.  S TIUY=0,TIUPRMT="Do you want to create a new record anyway"
  1.  S TIUY=+$$READ^TIUU("Y",TIUPRMT,"NO")
  1.  Q TIUY
  1. SCANDAD(TIUTYP,TIUDA) ; Search "DAD" index for component record
  1.  N TIUC,TIUY
  1.  S (TIUY,TIUC)=0
  1.  F  S TIUC=$O(^TIU(8925,"DAD",+TIUDA,TIUC)) Q:+TIUC'>0!(+TIUY>0)  D
  1.  . I +TIUTYP=+$G(^TIU(8925,+TIUC,0)) S TIUY=TIUC Q
  1.  . I +$O(^TIU(8925,"DAD",+TIUC,0)) S TIUY=$$SCANDAD(TIUTYP,TIUC)
  1.  Q TIUY
  1. GETCOMP(TIUTYP,TIUDA,TIU,DFN) ; Adds components to document
  1.  N DIC,DA,X,Y,DIE,DR,TIUC,TIUCMP,TIUMOM,TIUMTYP,TIUY,TIUFPRIV
  1.  N DLAYGO ;10/3/00
  1.  S TIUFPRIV=1,(TIUY,TIUC)=0
  1.  S TIUY=$$SCANDAD(TIUTYP,TIUDA)
  1.  I +TIUY G GETCX
  1.  S (DIC,DLAYGO)=8925,DIC(0)="FL"
  1.  S X="""`"_+TIUTYP_""""
  1.  D ^DIC
  1.  I +Y'>0 W !,X," component could not be created.",! G GETCX
  1.  S (TIUY,DA)=+Y,DIE=DIC
  1.  S TIUMOM=+$$RUMYMTHR(TIUDA,DA,+TIUTYP,+$G(^TIU(8925,+DA,0)))
  1.  S TIUMTYP=+$G(^TIU(8925,+TIUMOM,0))
  1.  S DR=".02////"_DFN_";.03////"_$P($G(TIU("VISIT")),U)_";.04////"_TIUMTYP_";.06////"_TIUMOM
  1.  D ^DIE W "."
  1. GETCX Q TIUY
  1. RUMYMTHR(MOM,BRAT,MOMTYP,BRATYP) ; Get appropriate parent for component
  1.  N TIUI,GOTMOM,CNDMOM,CNDTYP,TIUMOM S (GOTMOM,TIUI)=0
  1.  I +$O(^TIU(8925.1,"AD",+BRATYP,MOMTYP,0)) S GOTMOM=1 G RUMYX
  1.  S CNDMOM=0
  1.  F  S CNDMOM=$O(^TIU(8925,"DAD",+MOM,+CNDMOM)) Q:+CNDMOM'>0  D
  1.  . S CNDTYP=+$G(^TIU(8925,+CNDMOM,0))
  1.  . S TIUMOM=$$RUMYMTHR(CNDMOM,BRAT,CNDTYP,BRATYP) I $P(TIUMOM,U,2)=1 S MOM=+TIUMOM,GOTMOM=1 Q
  1. RUMYX Q MOM_U_GOTMOM
  1. DELCOMP(TIUDA) ; Cleans up all components of a document
  1.  N DA,DIE,DR,TIUCDA S TIUCDA=0,DIE="^TIU(8925,"
  1.  F  S TIUCDA=$O(^TIU(8925,"DAD",TIUDA,TIUCDA)) Q:+TIUCDA'>0  D
  1.  . W !,$P(^TIU(8925.1,+^TIU(8925,TIUCDA,0),0),U)_" Component Deleted"
  1.  . S DR=".01///@",DA=TIUCDA D ^DIE W "."
  1.  . I +$O(^TIU(8925,"DAD",TIUCDA,0))>0  D DELCOMP(TIUCDA)
  1.  Q
  1. DELAUDIT(TIUDA) ; Cleans up all AUDIT TRAIL entries for a document
  1.  N DA,DIK,DR,TIUADA S TIUADA=0,DIK="^TIU(8925.5,"
  1.  F  S TIUADA=$O(^TIU(8925.5,"B",TIUDA,TIUADA)) Q:+TIUADA'>0  D
  1.  . ; W !," Audit trail record #",TIUADA," Deleted"
  1.  . S DA=TIUADA D ^DIK ; W "."
  1.  I $L($T(DEL^PXRMGECU)) D DEL^PXRMGECU(+TIUDA)
  1.  Q
  1. ISCOMP(TIUTYP,X) ; Is the text provided a component tag
  1.  N DIC,TIULEVEL,TIUY,Y,TIUFPRIV S TIULEVEL=0,TIUFPRIV=1
  1.  S DIC=8925.1,DIC(0)="FX"
  1.  S DIC("S")="I $P(^TIU(8925.1,+Y,0),U,4)=""CO"""
  1.  D ^DIC K DIC("S")
  1.  I +Y'>0 S TIUY=0 G ISCMPX
  1.  I +$O(^TIU(8925.1,+TIUTYP,10,"B",+Y,0))'>0 S TIUY=0 G ISCMPX
  1.  S TIUY=Y
  1. ISCMPX Q TIUY
  1. MERGTEMP(TIUDA) ; Merge text from components into TEMP node for edit
  1.  N TIUC,TIUI,TIUJ,TIULINE
  1.  S (TIUC,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
  1.  F  S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0  D
  1.  . I +$$ISADDNDM^TIULC1(+TIUC) Q
  1.  . S TIUI=0 F  S TIUI=$O(^TIU(8925,+TIUC,"TEXT",TIUI)) Q:+TIUI'>0  D
  1.  . . S TIUJ=+$G(TIUJ)+1
  1.  . . S ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC,"TEXT",TIUI,0))
  1.  . . K ^TIU(8925,+TIUC,"TEXT",TIUI,0) ; Clear the way for edits
  1.  . . S ^TIU(8925,+TIUC,"TEXT",0)="^^^^"_DT_"^^"
  1.  . . S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
  1.  . I +$O(^TIU(8925,"DAD",+TIUC,0)) D MERGGRAN(TIUDA,+TIUC)
  1.  . S TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
  1.  I $D(^TIU(8925,+TIUDA,"TEMP",1))>9 M ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
  1.  Q
  1. MERGGRAN(TIUDA,TIUC) ; Merge sub-components into TEMP node of original
  1.  N TIUC1,TIUI,TIUJ,TIULINE
  1.  S (TIUC1,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
  1.  F  S TIUC1=$O(^TIU(8925,"DAD",TIUC,TIUC1)) Q:+TIUC1'>0  D
  1.  . S TIUI=0 F  S TIUI=$O(^TIU(8925,+TIUC1,"TEXT",TIUI)) Q:+TIUI'>0  D
  1.  . . S TIUJ=+$G(TIUJ)+1
  1.  . . S ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC1,"TEXT",TIUI,0))
  1.  . . K ^TIU(8925,+TIUC1,"TEXT",TIUI,0) ; Clear the way for edits
  1.  . . S ^TIU(8925,+TIUC1,"TEXT",0)="^^^^"_DT_"^^"
  1.  . . S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
  1.  . I +$O(^TIU(8925,"DAD",+TIUC1,0)) D MERGGRAN(TIUDA,+TIUC1)
  1.  . S TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
  1.  Q
  1. MERGTEXT(TIUDA,TIU) ; Merge TEMP node from parent document into components
  1.  N TIUTYP
  1.  S TIUTYP=+$P(^TIU(8925,+TIUDA,0),U)
  1.  ; -- If document has components, add/update them
  1.  I +$O(^TIU(8925.1,+TIUTYP,10,0))>0 D
  1.  . N TIUC,TIUI,TIUJ,TIUX,TIUCMP S (TIUI,TIUJ,TIUCMP)=0
  1.  . F  S TIUI=$O(^TIU(8925,+TIUDA,"TEMP",TIUI)) Q:+TIUI'>0  D
  1.  . . S TIUX=$G(^TIU(8925,+TIUDA,"TEMP",TIUI,0))
  1.  . . S TIUC=+$$ISCOMP(TIUTYP,$P(TIUX,":"))
  1.  . . I TIUX[":",+TIUC D
  1.  . . . S TIUJ=0 ; Reinitialize line count for new component
  1.  . . . S TIUCMP=$$GETCOMP(TIUC,TIUDA,.TIU,DFN)
  1.  . . S TIUJ=+$G(TIUJ)+1
  1.  . . I +TIUCMP>0 D
  1.  . . . S ^TIU(8925,+TIUCMP,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEMP",+TIUI,0))
  1.  . . . S ^TIU(8925,+TIUCMP,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
  1.  . . E  D
  1.  . . . S ^TIU(8925,+TIUDA,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEMP",TIUJ,0))
  1.  . . . S ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
  1.  ; -- If no components, merge "TEMP" into "TEXT" for current document
  1.  I +$O(^TIU(8925.1,+TIUTYP,10,0))'>0 M ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
  1.  Q
  1. GETTMPL(TIUTYP) ; Get edit template, enforce inheritance
  1.  N TIUDAD,TIUY S TIUDAD=0
  1.  S TIUY=$G(^TIU(8925.1,+TIUTYP,5))
  1.  I TIUY']"",($P(^TIU(8925.1,+TIUTYP,0),U)["ADDENDUM") D
  1.  . S TIUDAD=+$P($G(^TIU(8925,+$P($G(^TIU(8925,+$G(TIUDA),0)),U,6),0)),U)
  1.  . I +TIUDAD S TIUY=$$GETTMPL(TIUDAD)
  1.  I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
  1.  I +TIUDAD S TIUY=$$GETTMPL(TIUDAD)
  1.  Q TIUY
  1. AUDIT(TIUDA,TIUCKSM0,TIUCKSM1) ; Update audit trail
  1.  N DIC,DIE,DA,DR,X,Y
  1.  S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
  1.  S DIE=DIC,DR=".02////"_$$NOW^TIULC_";.03////"_DUZ_";.04////"_TIUCKSM0_";.05////"_TIUCKSM1
  1.  S DA=+Y D ^DIE
  1.  Q
  1. GETLMETH(TIUTYP) ; Get Visit Linkage method, enforce inheritance
  1.  N TIUDAD,TIUY S TIUDAD=0
  1.  S TIUY=$G(^TIU(8925.1,+TIUTYP,7))
  1.  I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
  1.  I +TIUDAD S TIUY=$$GETLMETH(TIUDAD)
  1.  Q TIUY
  1. GETVMETH(TIUTYP) ; Get Validation method, enforce enheritance
  1.  N TIUDAD,TIUY S TIUDAD=0
  1.  S TIUY=$G(^TIU(8925.1,+TIUTYP,8))
  1.  I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
  1.  I +TIUDAD S TIUY=$$GETVMETH(TIUDAD)
  1.  Q TIUY
  1.  ;