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

TIUGEDI1.m

Go to the documentation of this file. 
  1. TIUGEDI1 ; SLC/MAM - Enter New ID Document Code; 11/14/00
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
  1.  ; New rtn for ID notes
  1.  ; 3/2/00 moved GETRECG from TIUGEDIT to TIUGEDI1
  1. GETRECG(DFN,TIU,TIUTYP,TIUDPRM,TIUNEW,EDIT,DADDA) ; Get record
  1.  ;for ID entry.
  1.  ; Returns DA: new docmt for user to continue entering, or
  1.  ;existing docmt for user to edit, or just link, or addend.
  1.  ; Requires array TIU.  References TIU("VSTR") = LOC;VDT;VTYP
  1.  ;                                 TIU("VISIT") = Visit File IFN
  1.  ;                                 TIU("LOC")
  1.  ;                                 TIU("VLOC")
  1.  ;                                 TIU("STOP") = stop code
  1.  ; Requires array TIUTYP as in MAIN
  1.  ; Passes back flags:
  1.  ;   TIUNEW = 1 if good docmt is returned and it is new
  1.  ;          = 0 if returned docmt already existed, timeout, etc
  1.  ;     EDIT = 1 to open DA for edit (already know Person can edit)
  1.  ;          = 0 to forget the edit
  1.  ; Requires DADDA = IFN of docmt DA will be added to.
  1.  N DA,MULTOK,TLFULL,DALKABLE,YESDOIT
  1.  ;-- Get parameters for selected title, set TLFULL: --
  1.  ;        TLFULL: Already have max # entries on this title/pt/vst
  1.  ;        MULTOK: More than ONE record/visit is OK
  1.  D DOCPRM^TIULC1(TIUTYP,.TIUDPRM) S MULTOK=+$P($G(TIUDPRM(0)),U,10)
  1.  S (TIUNEW,EDIT,TLFULL)=0
  1.  I 'MULTOK,$$EXIST^TIUEDI3(DFN,TIUTYP,TIU("VSTR")) S TLFULL=1
  1.  ; -- Find existing docmts for proposed title/patient/visit
  1.  ;    which are linkable to DADDA: --
  1.  S DALKABLE=$$EXISTLNK(DFN,TIUTYP,TIU("VSTR"),DUZ,DADDA)
  1.  ; -- If there are NO such existing docmts,
  1.  ;    let user create new or tell user they can't, quit: --
  1.  I 'DALKABLE D  G GETX
  1.  . I 'TLFULL S DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1)),TIUNEW=1 Q
  1.  . I TLFULL W !!,"There is already a ",$P(TIUTYP(1),U,3),".",!,"Only ONE record of this type per Visit is allowed...",! H 1 Q
  1.  ; -- There IS such a docmt. --
  1.  ;    -- If docmt is already linked, and user can edit,
  1.  ;       ask if user wants to create new note anyway: --
  1.  I $G(^TIU(8925,DALKABLE,21))=DADDA D  G GETX
  1.  . W !,"The note already has an ID entry you can edit with that title and visit"
  1.  . S YESDOIT=$$READ^TIUU("Y","Would you like to create a new entry anyway","NO")
  1.  . I YESDOIT S DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1)),TIUNEW=1 Q
  1.  . W !,"Opening the existing entry" S DA=DALKABLE,EDIT=1
  1.  ;   -- If docmt is NOT already linked, create new,
  1.  ;      or edit existing, or just link existing: --
  1.  W !,"You already have a document you can link for that patient, title, and visit."
  1.  S YESDOIT=$$READ^TIUU("Y","Would you like to create a new entry anyway","NO")
  1.  I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) G GETX
  1.  I YESDOIT S DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1)) S TIUNEW=1 G GETX
  1.  ;      -- If user says, no don't create, then try edit: --
  1.  N CANDO S CANDO=+$$CANDO^TIULP(DALKABLE,"EDIT RECORD")
  1.  I CANDO W !,"Opening the existing entry" S DA=DALKABLE,EDIT=1 G GETX
  1.  ;         -- If user can't edit, just return it for linking: --
  1.  I 'CANDO D  G GETX
  1.  . S DA=DALKABLE
  1. GETX ;
  1.  I TIUNEW,'$G(DA) W !,"No new entry created" H 2 S TIUNEW=0
  1.  Q +$G(DA)
  1.  ;
  1. EXISTLNK(DFN,TIUTYP,TIUVSTR,PERSON,DADDA) ; If a docmt PERSON
  1.  ;can LINK already EXISTS for the given patient, title, and visit,
  1.  ;then return it. If there are more than one, get the smallest DA.
  1.  ; Receives TIUVSTR = LOC;VDT;VTYP
  1.  ; Needs TIUTYP = title DA
  1.  ; Needs DADDA = IFN of docmt DA will be added to.
  1.  N REQUEST,DA,TIUI,CANLINK,DALKDAD
  1.  I '$G(PERSON) S PERSON=DUZ
  1.  S (REQUEST,TIUI,DA)=0
  1. LOOP ; -- Find existing docmt for given patient, title, & visit:--
  1.  F  S TIUI=+$O(^TIU(8925,"APTLD",DFN,TIUTYP,TIUVSTR,TIUI)) Q:'TIUI  D  Q:REQUEST  Q:DA
  1.  . ; -- If TIUI is bad, reject it and keep looking:
  1.  . I '$D(^TIU(8925,TIUI,0)) D  Q
  1.  . . K ^TIU(8925,"APTLD",DFN,TIUTYP,TIUVSTR,TIUI)
  1.  . ; -- If TIUI has requesting package (e.g. Consults),
  1.  . ;    then reject it and quit looking: --
  1.  . I +$P($G(^TIU(8925,TIUI,14)),U,5) S REQUEST=1 Q  ; **22**
  1.  . N CANLINK S CANLINK=+$$CANDO^TIULP(TIUI,"ATTACH TO ID NOTE",PERSON)
  1.  . ; -- If person can't link it, keep looking: --
  1.  . I 'CANLINK Q
  1.  . ; -- If already linked somewhere else, keep looking: --
  1.  . S DALKDAD=$G(^TIU(8925,TIUI,21))
  1.  . I DALKDAD,DALKDAD'=DADDA Q
  1.  . ; -- If already linked to dad, but can't edit, keep looking: --
  1.  . I DALKDAD,'$$CANDO^TIULP(TIUI,"EDIT RECORD") Q
  1.  . ; -- If already linked to dad & can edit, return it: --
  1.  . I DALKDAD S DA=TIUI Q
  1.  . ; -- If not already linked, return it: --
  1.  . S DA=TIUI
  1. EXISTLX ;
  1.  Q +$G(DA)