TIUGEDI1 ; SLC/MAM - Enter New ID Document Code; 11/14/00
;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
; New rtn for ID notes
; 3/2/00 moved GETRECG from TIUGEDIT to TIUGEDI1
GETRECG(DFN,TIU,TIUTYP,TIUDPRM,TIUNEW,EDIT,DADDA) ; Get record
;for ID entry.
; Returns DA: new docmt for user to continue entering, or
;existing docmt for user to edit, or just link, or addend.
; Requires array TIU. References TIU("VSTR") = LOC;VDT;VTYP
; TIU("VISIT") = Visit File IFN
; TIU("LOC")
; TIU("VLOC")
; TIU("STOP") = stop code
; Requires array TIUTYP as in MAIN
; Passes back flags:
; TIUNEW = 1 if good docmt is returned and it is new
; = 0 if returned docmt already existed, timeout, etc
; EDIT = 1 to open DA for edit (already know Person can edit)
; = 0 to forget the edit
; Requires DADDA = IFN of docmt DA will be added to.
N DA,MULTOK,TLFULL,DALKABLE,YESDOIT
;-- Get parameters for selected title, set TLFULL: --
; TLFULL: Already have max # entries on this title/pt/vst
; MULTOK: More than ONE record/visit is OK
D DOCPRM^TIULC1(TIUTYP,.TIUDPRM) S MULTOK=+$P($G(TIUDPRM(0)),U,10)
S (TIUNEW,EDIT,TLFULL)=0
I 'MULTOK,$$EXIST^TIUEDI3(DFN,TIUTYP,TIU("VSTR")) S TLFULL=1
; -- Find existing docmts for proposed title/patient/visit
; which are linkable to DADDA: --
S DALKABLE=$$EXISTLNK(DFN,TIUTYP,TIU("VSTR"),DUZ,DADDA)
; -- If there are NO such existing docmts,
; let user create new or tell user they can't, quit: --
I 'DALKABLE D G GETX
. I 'TLFULL S DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1)),TIUNEW=1 Q
. 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
; -- There IS such a docmt. --
; -- If docmt is already linked, and user can edit,
; ask if user wants to create new note anyway: --
I $G(^TIU(8925,DALKABLE,21))=DADDA D G GETX
. W !,"The note already has an ID entry you can edit with that title and visit"
. S YESDOIT=$$READ^TIUU("Y","Would you like to create a new entry anyway","NO")
. I YESDOIT S DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1)),TIUNEW=1 Q
. W !,"Opening the existing entry" S DA=DALKABLE,EDIT=1
; -- If docmt is NOT already linked, create new,
; or edit existing, or just link existing: --
W !,"You already have a document you can link for that patient, title, and visit."
S YESDOIT=$$READ^TIUU("Y","Would you like to create a new entry anyway","NO")
I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) G GETX
I YESDOIT S DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1)) S TIUNEW=1 G GETX
; -- If user says, no don't create, then try edit: --
N CANDO S CANDO=+$$CANDO^TIULP(DALKABLE,"EDIT RECORD")
I CANDO W !,"Opening the existing entry" S DA=DALKABLE,EDIT=1 G GETX
; -- If user can't edit, just return it for linking: --
I 'CANDO D G GETX
. S DA=DALKABLE
GETX ;
I TIUNEW,'$G(DA) W !,"No new entry created" H 2 S TIUNEW=0
Q +$G(DA)
;
EXISTLNK(DFN,TIUTYP,TIUVSTR,PERSON,DADDA) ; If a docmt PERSON
;can LINK already EXISTS for the given patient, title, and visit,
;then return it. If there are more than one, get the smallest DA.
; Receives TIUVSTR = LOC;VDT;VTYP
; Needs TIUTYP = title DA
; Needs DADDA = IFN of docmt DA will be added to.
N REQUEST,DA,TIUI,CANLINK,DALKDAD
I '$G(PERSON) S PERSON=DUZ
S (REQUEST,TIUI,DA)=0
LOOP ; -- Find existing docmt for given patient, title, & visit:--
F S TIUI=+$O(^TIU(8925,"APTLD",DFN,TIUTYP,TIUVSTR,TIUI)) Q:'TIUI D Q:REQUEST Q:DA
. ; -- If TIUI is bad, reject it and keep looking:
. I '$D(^TIU(8925,TIUI,0)) D Q
. . K ^TIU(8925,"APTLD",DFN,TIUTYP,TIUVSTR,TIUI)
. ; -- If TIUI has requesting package (e.g. Consults),
. ; then reject it and quit looking: --
. I +$P($G(^TIU(8925,TIUI,14)),U,5) S REQUEST=1 Q ; **22**
. N CANLINK S CANLINK=+$$CANDO^TIULP(TIUI,"ATTACH TO ID NOTE",PERSON)
. ; -- If person can't link it, keep looking: --
. I 'CANLINK Q
. ; -- If already linked somewhere else, keep looking: --
. S DALKDAD=$G(^TIU(8925,TIUI,21))
. I DALKDAD,DALKDAD'=DADDA Q
. ; -- If already linked to dad, but can't edit, keep looking: --
. I DALKDAD,'$$CANDO^TIULP(TIUI,"EDIT RECORD") Q
. ; -- If already linked to dad & can edit, return it: --
. I DALKDAD S DA=TIUI Q
. ; -- If not already linked, return it: --
. S DA=TIUI
EXISTLX ;
Q +$G(DA)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUGEDI1 4544 printed Dec 13, 2024@02:41:32 Page 2
TIUGEDI1 ; SLC/MAM - Enter New ID Document Code; 11/14/00
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
+2 ; New rtn for ID notes
+3 ; 3/2/00 moved GETRECG from TIUGEDIT to TIUGEDI1
GETRECG(DFN,TIU,TIUTYP,TIUDPRM,TIUNEW,EDIT,DADDA) ; Get record
+1 ;for ID entry.
+2 ; Returns DA: new docmt for user to continue entering, or
+3 ;existing docmt for user to edit, or just link, or addend.
+4 ; Requires array TIU. References TIU("VSTR") = LOC;VDT;VTYP
+5 ; TIU("VISIT") = Visit File IFN
+6 ; TIU("LOC")
+7 ; TIU("VLOC")
+8 ; TIU("STOP") = stop code
+9 ; Requires array TIUTYP as in MAIN
+10 ; Passes back flags:
+11 ; TIUNEW = 1 if good docmt is returned and it is new
+12 ; = 0 if returned docmt already existed, timeout, etc
+13 ; EDIT = 1 to open DA for edit (already know Person can edit)
+14 ; = 0 to forget the edit
+15 ; Requires DADDA = IFN of docmt DA will be added to.
+16 NEW DA,MULTOK,TLFULL,DALKABLE,YESDOIT
+17 ;-- Get parameters for selected title, set TLFULL: --
+18 ; TLFULL: Already have max # entries on this title/pt/vst
+19 ; MULTOK: More than ONE record/visit is OK
+20 DO DOCPRM^TIULC1(TIUTYP,.TIUDPRM)
SET MULTOK=+$PIECE($GET(TIUDPRM(0)),U,10)
+21 SET (TIUNEW,EDIT,TLFULL)=0
+22 IF 'MULTOK
IF $$EXIST^TIUEDI3(DFN,TIUTYP,TIU("VSTR"))
SET TLFULL=1
+23 ; -- Find existing docmts for proposed title/patient/visit
+24 ; which are linkable to DADDA: --
+25 SET DALKABLE=$$EXISTLNK(DFN,TIUTYP,TIU("VSTR"),DUZ,DADDA)
+26 ; -- If there are NO such existing docmts,
+27 ; let user create new or tell user they can't, quit: --
+28 IF 'DALKABLE
Begin DoDot:1
+29 IF 'TLFULL
SET DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1))
SET TIUNEW=1
QUIT
+30 IF TLFULL
WRITE !!,"There is already a ",$PIECE(TIUTYP(1),U,3),".",!,"Only ONE record of this type per Visit is allowed...",!
HANG 1
QUIT
End DoDot:1
GOTO GETX
+31 ; -- There IS such a docmt. --
+32 ; -- If docmt is already linked, and user can edit,
+33 ; ask if user wants to create new note anyway: --
+34 IF $GET(^TIU(8925,DALKABLE,21))=DADDA
Begin DoDot:1
+35 WRITE !,"The note already has an ID entry you can edit with that title and visit"
+36 SET YESDOIT=$$READ^TIUU("Y","Would you like to create a new entry anyway","NO")
+37 IF YESDOIT
SET DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1))
SET TIUNEW=1
QUIT
+38 WRITE !,"Opening the existing entry"
SET DA=DALKABLE
SET EDIT=1
End DoDot:1
GOTO GETX
+39 ; -- If docmt is NOT already linked, create new,
+40 ; or edit existing, or just link existing: --
+41 WRITE !,"You already have a document you can link for that patient, title, and visit."
+42 SET YESDOIT=$$READ^TIUU("Y","Would you like to create a new entry anyway","NO")
+43 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO GETX
+44 IF YESDOIT
SET DA=$$CREATREC^TIUEDI3(DFN,.TIU,TIUTYP(1))
SET TIUNEW=1
GOTO GETX
+45 ; -- If user says, no don't create, then try edit: --
+46 NEW CANDO
SET CANDO=+$$CANDO^TIULP(DALKABLE,"EDIT RECORD")
+47 IF CANDO
WRITE !,"Opening the existing entry"
SET DA=DALKABLE
SET EDIT=1
GOTO GETX
+48 ; -- If user can't edit, just return it for linking: --
+49 IF 'CANDO
Begin DoDot:1
+50 SET DA=DALKABLE
End DoDot:1
GOTO GETX
GETX ;
+1 IF TIUNEW
IF '$GET(DA)
WRITE !,"No new entry created"
HANG 2
SET TIUNEW=0
+2 QUIT +$GET(DA)
+3 ;
EXISTLNK(DFN,TIUTYP,TIUVSTR,PERSON,DADDA) ; If a docmt PERSON
+1 ;can LINK already EXISTS for the given patient, title, and visit,
+2 ;then return it. If there are more than one, get the smallest DA.
+3 ; Receives TIUVSTR = LOC;VDT;VTYP
+4 ; Needs TIUTYP = title DA
+5 ; Needs DADDA = IFN of docmt DA will be added to.
+6 NEW REQUEST,DA,TIUI,CANLINK,DALKDAD
+7 IF '$GET(PERSON)
SET PERSON=DUZ
+8 SET (REQUEST,TIUI,DA)=0
LOOP ; -- Find existing docmt for given patient, title, & visit:--
+1 FOR
SET TIUI=+$ORDER(^TIU(8925,"APTLD",DFN,TIUTYP,TIUVSTR,TIUI))
if 'TIUI
QUIT
Begin DoDot:1
+2 ; -- If TIUI is bad, reject it and keep looking:
+3 IF '$DATA(^TIU(8925,TIUI,0))
Begin DoDot:2
+4 KILL ^TIU(8925,"APTLD",DFN,TIUTYP,TIUVSTR,TIUI)
End DoDot:2
QUIT
+5 ; -- If TIUI has requesting package (e.g. Consults),
+6 ; then reject it and quit looking: --
+7 ; **22**
IF +$PIECE($GET(^TIU(8925,TIUI,14)),U,5)
SET REQUEST=1
QUIT
+8 NEW CANLINK
SET CANLINK=+$$CANDO^TIULP(TIUI,"ATTACH TO ID NOTE",PERSON)
+9 ; -- If person can't link it, keep looking: --
+10 IF 'CANLINK
QUIT
+11 ; -- If already linked somewhere else, keep looking: --
+12 SET DALKDAD=$GET(^TIU(8925,TIUI,21))
+13 IF DALKDAD
IF DALKDAD'=DADDA
QUIT
+14 ; -- If already linked to dad, but can't edit, keep looking: --
+15 IF DALKDAD
IF '$$CANDO^TIULP(TIUI,"EDIT RECORD")
QUIT
+16 ; -- If already linked to dad & can edit, return it: --
+17 IF DALKDAD
SET DA=TIUI
QUIT
+18 ; -- If not already linked, return it: --
+19 SET DA=TIUI
End DoDot:1
if REQUEST
QUIT
if DA
QUIT
EXISTLX ;
+1 QUIT +$GET(DA)
