TIUEDI3 ; SLC/MAM - Additional Edit Code ;4/19/05
;;1.0;TEXT INTEGRATION UTILITIES;**100,113,184**;Jun 20, 1997
;
GETRECNW(DFN,TIU,TIUTYP1,TIUNEW,TIUDPRM,TIUINQ,PERSON,EDIT) ; New GETREC.
; Code rewritten from the old GETREC^TIUEDI1.
; GETREC^TIUEDI1 now calls this code.
; New parameters: Left out TIUCREAT since we always used it as 1.
; Added PERSON and EDIT.
; Can be called directly, or via GETREC^TIUEDI1 for
;backward compatibility. GETREC^TIUEDI1 uses OLD parameters.
; There are 3 functional differences between GETRECNW and the old
;GETREC: First, GETRECNW no longer does RETRY since there should no
;longer be editable entries with no time in the visit field.
;Second, if user when creating new docmt is asked if user wants
;to edit existing docmt instead, and user says no, and user
;cannot create a new docmt, then user is no longer given the
;existing record to addend. User must use a separate addend action.
;Third, because code is restructured, code no longer quits before
;creating a new docmt if GETRECNW is called with DUOUT, etc defined.
;So quit before calling GETRECNW if DUOUT, etc.
; Returns document record DA, where DA is:
; new docmt for user to continue entering, or
; existing docmt for user to edit or addend.
; If called by upload, DA is:
; new docmt to continue entering, or
; existing docmt for text replacement or addendum.
;
; Call with:
; DFN, TIU array, TIUTYP1 are REQUIRED.
; [DFN] --> Patient IFN.
; [TIU] --> Visit info array
; References TIU("VSTR") = LOC;VDT;VTYP
; TIU("VISIT") = Visit File IFN
; TIU("LOC")
; TIU("VLOC")
; TIU("STOP") = mark to defer workload
; [TIUTYP1] --> Title info variable of form:
; TIUTYP1 = 1^title DA^title Name, where the 1
; is just style to imitate XQORNOD
; [TIUNEW] --> flag, passed back with
; TIUNEW = 1 if returned docmt is new
; TIUNEW = 0 if returned docmt already existed,
; timeout, etc
;
;[TIUDPRM] --> Docmt param array where
; $P($G(TIUDPRM(0)),U,10), = 1 if
; more than ONE record/visit is allowed.
; If TIUDPRM not received, don't worry about
; creating multiple documents
; [TIUINQ] --> Ask user flag, where
; TIUINQ = 1: ask re edit/addend existing docmt
; (Interactive List Manager options, TRY docmt def)
; TIUINQ = 0: don't ask (Upload & GUI options)
; [PERSON] --> IFN of person asking to edit/create docmt,
; or for upload, = author of document
; If not received, assumed to be DUZ.
; [EDIT] --> flag, passed back with EDIT = 1 if returned
; PREEXISTING docmt can be edited by PERSON. If
; preexisting docmt returned and 'EDIT, then
; docmt cannot be edited by person.
N TIUVSTR,MULTOK,DA,TLFULL,XISONE
N EDABLEDA,YESDOIT ;10/3/00
N TIUTYPDA,TIUTYPNM
I '$G(PERSON) S PERSON=DUZ
S TIUVSTR=TIU("VSTR")
; -- If just testing a document definition (TRY) rather than
; doing a real note, skip inquiry into existing notes: --
I +$G(NOSAVE) S DA=$$CREATREC(DFN,.TIU,TIUTYP1),TIUNEW=1 G GETNWX
; -- MULTOK: More than ONE record/visit is OK (param permits,
; or didn't care enough to send the parameter)
; TLFULL: Only 1 docmt allowed, and it
; already exists on this title/pt/vst --
I '$D(TIUDPRM(0)) S MULTOK=1
E S MULTOK=+$P(TIUDPRM(0),U,10)
S (TIUNEW,EDIT,DA,TLFULL,EDABLEDA)=0
S TIUTYPDA=$P(TIUTYP1,U,2),TIUTYPNM=$P(TIUTYP1,U,3)
S XISONE=$$EXIST(DFN,TIUTYPDA,TIUVSTR)
I 'MULTOK,XISONE S TLFULL=1
; -- Find existing editable docmts for patient, title, & visit:--
S EDABLEDA=+$$EXIST(DFN,TIUTYPDA,TIUVSTR,1,PERSON)
; -- If there are NO such docmts,
; then create new if title not full,
; or return existing [NONeditable] for addendum [if user wants]: --
I 'EDABLEDA D G GETNWX
. I 'TLFULL S DA=$$CREATREC(DFN,.TIU,TIUTYP1),TIUNEW=1 Q
. I +$G(TIUINQ) D Q
. . W !!,"There is already a ",TIUTYPNM,".",!
. . W "Only ONE record of this type per Visit is allowed...",!
. . S YESDOIT=+$$READ^TIUU("Y"," Would you like to addend the existing record","NO")
. . I YESDOIT S DA=XISONE
. I '+$G(TIUINQ) S DA=XISONE
. Q
; -- If there ARE such docmts, then
; If title is full, return existing docmt for edit.
; If title is NOT full, return existing docmt for edit,
; or ask user.
I EDABLEDA D G GETNWX
. I TLFULL D:+$G(TIUINQ) S DA=EDABLEDA,EDIT=1 Q
. . W !!,"There is already a ",TIUTYPNM," which you may edit."
. . W !,"Only ONE record of this type per Visit is allowed...",!
. . W "Opening the existing record"
. . S TIUCHNG("EXIST")=1
. I 'TLFULL D Q
. . I '+$G(TIUINQ) S DA=EDABLEDA,EDIT=1 Q
. . W !!,"There is already a ",TIUTYPNM," which you may edit."
. . S YESDOIT=+$$INQUIRE ; "Create new anyway?"
. . I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) Q
. . I YESDOIT S DA=$$CREATREC(DFN,.TIU,TIUTYP1),TIUNEW=1 Q
. . W !!,"Okay, I'll open the existing record then!"
. . S DA=EDABLEDA,EDIT=1,TIUCHNG("EXIST")=1
GETNWX ;
I TIUNEW,'DA S TIUNEW=0
Q +$G(DA)
;
EXIST(DFN,TIUTYPDA,TIUVSTR,REQEDIT,PERSON) ; If a docmt already
;EXISTS for the given patient, title, and visit, then return it.
; Ignore: - docmts of status deleted or retracted
; - all docmts if run across a docmt w/ requesting pkg
; - all docmts if Title is PRF Title
; - I REQEDIT, then also ignore docmts PERSON cannot edit.
; If there are more than one, get the smallest DA.
; Receives TIUVSTR = LOC;VDT;VTYP
; Needs TIUTYPDA = title DA
; REQEDIT & PERSON are optional
N REQUEST,DA,TIUI,STATUS,RETRY
S REQEDIT=+$G(REQEDIT)
I '$G(PERSON) S PERSON=DUZ
S (REQUEST,TIUI,DA)=0
I $$ISPFTTL^TIUPRFL(TIUTYPDA) G EXISTEX
LOOP ; -- Find existing docmt for given patient, title, & visit:--
F S TIUI=+$O(^TIU(8925,"APTLD",DFN,TIUTYPDA,TIUVSTR,TIUI)) Q:'TIUI D Q:REQUEST Q:DA
. ; -- If TIUI doesn't exist, reject it and keep looking: --
. I '$D(^TIU(8925,TIUI,0)) D Q
. . K ^TIU(8925,"APTLD",DFN,TIUTYPDA,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**
. ; -- If TIUI has status deleted or retracted, reject it
. ; and keep looking: TIU*1*61 --
. S STATUS=+$P($G(^TIU(8925,TIUI,0)),U,5)
. I STATUS=14!(STATUS=15) Q
. ; -- If OK so far, and record not required to be editable,
. ;then grab existing record and stop looking: --
. I 'REQEDIT S DA=TIUI Q
. ; -- If REQEDIT & PERSON can edit existing record,
. ; then grab it and stop looking: --
. N CANEDIT S CANEDIT=+$$CANDO^TIULP(TIUI,"EDIT RECORD",PERSON)
. I +CANEDIT>0 S DA=TIUI
; -- If record not required to be editable & still haven't
; found a record, check for records with no visit time: --
; (Early anomaly with DSs at Boston)
I +DA'>0,($P(TIUVSTR,";",3)="H"),(+$G(RETRY)'>0) D G LOOP
. S RETRY=1,$P(TIUVSTR,";",2)=$P($P(TIUVSTR,";",2),".")
EXISTEX ;
Q +$G(DA)
;
CREATREC(DFN,TIU,TIUTYP1) ; Create document record - Returns DA
; Receives array TIU as in GETRECNW
; Needs var TIUTYP1 as in GETRECNW
N DIC,DLAYGO,X,Y,TIUFPRIV,TIUVTYP,RETRY,TIUVSTR,TIUVISIT,DA
N TIUTYPDA,TIUTYPNM
S TIUTYPDA=$P(TIUTYP1,U,2),TIUTYPNM=$P(TIUTYP1,U,3)
S TIUVSTR=TIU("VSTR")
S DA=0,TIUFPRIV=1
S (DIC,DLAYGO)=8925,DIC(0)="FL"
S X=""""_"`"_TIUTYPDA_"""" D ^DIC
I +Y'>0 W !,TIUTYPNM," record could not be created.",! G CREXIT
; -- Stuff patient, visit, parent doc type, status,
; visit type, hosp loc, visit loc, division: --
S DA=+Y
N DIE,DR S DIE=8925
S TIUVTYP=$P($G(TIUVSTR),";",3)
S TIUVISIT=$S(+$G(TIU("VISIT")):+$G(TIU("VISIT")),1:"")
S DR=".02////"_DFN_";.03////"_TIUVISIT_";.04////"_$$DOCCLASS^TIULC1(+$P(Y,U,2))_";.05///"_$$UP^XLFSTR($$STATUS^TIULC(DA))_";.13////"_TIUVTYP_";1205////"_$P($G(TIU("LOC")),U)_";1211////"_$P($G(TIU("VLOC")),U)_";1212////"_$P($G(TIU("INST")),U)
D ^DIE
; -- [Mark record for deferred crediting of stop code (fld #.11)]: --
I +$G(TIU("STOP")) D DEFER^TIUVSIT(DA,+$G(TIU("STOP")))
CREXIT Q +$G(DA)
;
INQUIRE() ; Ask user whether to create a new note anyway
N TIUY,TIUPRMT
S TIUY=0,TIUPRMT="Do you want to create a new record anyway"
S TIUY=+$$READ^TIUU("Y",TIUPRMT,"NO")
Q TIUY
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUEDI3 8632 printed Dec 13, 2024@02:39:57 Page 2
TIUEDI3 ; SLC/MAM - Additional Edit Code ;4/19/05
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,184**;Jun 20, 1997
+2 ;
GETRECNW(DFN,TIU,TIUTYP1,TIUNEW,TIUDPRM,TIUINQ,PERSON,EDIT) ; New GETREC.
+1 ; Code rewritten from the old GETREC^TIUEDI1.
+2 ; GETREC^TIUEDI1 now calls this code.
+3 ; New parameters: Left out TIUCREAT since we always used it as 1.
+4 ; Added PERSON and EDIT.
+5 ; Can be called directly, or via GETREC^TIUEDI1 for
+6 ;backward compatibility. GETREC^TIUEDI1 uses OLD parameters.
+7 ; There are 3 functional differences between GETRECNW and the old
+8 ;GETREC: First, GETRECNW no longer does RETRY since there should no
+9 ;longer be editable entries with no time in the visit field.
+10 ;Second, if user when creating new docmt is asked if user wants
+11 ;to edit existing docmt instead, and user says no, and user
+12 ;cannot create a new docmt, then user is no longer given the
+13 ;existing record to addend. User must use a separate addend action.
+14 ;Third, because code is restructured, code no longer quits before
+15 ;creating a new docmt if GETRECNW is called with DUOUT, etc defined.
+16 ;So quit before calling GETRECNW if DUOUT, etc.
+17 ; Returns document record DA, where DA is:
+18 ; new docmt for user to continue entering, or
+19 ; existing docmt for user to edit or addend.
+20 ; If called by upload, DA is:
+21 ; new docmt to continue entering, or
+22 ; existing docmt for text replacement or addendum.
+23 ;
+24 ; Call with:
+25 ; DFN, TIU array, TIUTYP1 are REQUIRED.
+26 ; [DFN] --> Patient IFN.
+27 ; [TIU] --> Visit info array
+28 ; References TIU("VSTR") = LOC;VDT;VTYP
+29 ; TIU("VISIT") = Visit File IFN
+30 ; TIU("LOC")
+31 ; TIU("VLOC")
+32 ; TIU("STOP") = mark to defer workload
+33 ; [TIUTYP1] --> Title info variable of form:
+34 ; TIUTYP1 = 1^title DA^title Name, where the 1
+35 ; is just style to imitate XQORNOD
+36 ; [TIUNEW] --> flag, passed back with
+37 ; TIUNEW = 1 if returned docmt is new
+38 ; TIUNEW = 0 if returned docmt already existed,
+39 ; timeout, etc
+40 ;
+41 ;[TIUDPRM] --> Docmt param array where
+42 ; $P($G(TIUDPRM(0)),U,10), = 1 if
+43 ; more than ONE record/visit is allowed.
+44 ; If TIUDPRM not received, don't worry about
+45 ; creating multiple documents
+46 ; [TIUINQ] --> Ask user flag, where
+47 ; TIUINQ = 1: ask re edit/addend existing docmt
+48 ; (Interactive List Manager options, TRY docmt def)
+49 ; TIUINQ = 0: don't ask (Upload & GUI options)
+50 ; [PERSON] --> IFN of person asking to edit/create docmt,
+51 ; or for upload, = author of document
+52 ; If not received, assumed to be DUZ.
+53 ; [EDIT] --> flag, passed back with EDIT = 1 if returned
+54 ; PREEXISTING docmt can be edited by PERSON. If
+55 ; preexisting docmt returned and 'EDIT, then
+56 ; docmt cannot be edited by person.
+57 NEW TIUVSTR,MULTOK,DA,TLFULL,XISONE
+58 ;10/3/00
NEW EDABLEDA,YESDOIT
+59 NEW TIUTYPDA,TIUTYPNM
+60 IF '$GET(PERSON)
SET PERSON=DUZ
+61 SET TIUVSTR=TIU("VSTR")
+62 ; -- If just testing a document definition (TRY) rather than
+63 ; doing a real note, skip inquiry into existing notes: --
+64 IF +$GET(NOSAVE)
SET DA=$$CREATREC(DFN,.TIU,TIUTYP1)
SET TIUNEW=1
GOTO GETNWX
+65 ; -- MULTOK: More than ONE record/visit is OK (param permits,
+66 ; or didn't care enough to send the parameter)
+67 ; TLFULL: Only 1 docmt allowed, and it
+68 ; already exists on this title/pt/vst --
+69 IF '$DATA(TIUDPRM(0))
SET MULTOK=1
+70 IF '$TEST
SET MULTOK=+$PIECE(TIUDPRM(0),U,10)
+71 SET (TIUNEW,EDIT,DA,TLFULL,EDABLEDA)=0
+72 SET TIUTYPDA=$PIECE(TIUTYP1,U,2)
SET TIUTYPNM=$PIECE(TIUTYP1,U,3)
+73 SET XISONE=$$EXIST(DFN,TIUTYPDA,TIUVSTR)
+74 IF 'MULTOK
IF XISONE
SET TLFULL=1
+75 ; -- Find existing editable docmts for patient, title, & visit:--
+76 SET EDABLEDA=+$$EXIST(DFN,TIUTYPDA,TIUVSTR,1,PERSON)
+77 ; -- If there are NO such docmts,
+78 ; then create new if title not full,
+79 ; or return existing [NONeditable] for addendum [if user wants]: --
+80 IF 'EDABLEDA
Begin DoDot:1
+81 IF 'TLFULL
SET DA=$$CREATREC(DFN,.TIU,TIUTYP1)
SET TIUNEW=1
QUIT
+82 IF +$GET(TIUINQ)
Begin DoDot:2
+83 WRITE !!,"There is already a ",TIUTYPNM,".",!
+84 WRITE "Only ONE record of this type per Visit is allowed...",!
+85 SET YESDOIT=+$$READ^TIUU("Y"," Would you like to addend the existing record","NO")
+86 IF YESDOIT
SET DA=XISONE
End DoDot:2
QUIT
+87 IF '+$GET(TIUINQ)
SET DA=XISONE
+88 QUIT
End DoDot:1
GOTO GETNWX
+89 ; -- If there ARE such docmts, then
+90 ; If title is full, return existing docmt for edit.
+91 ; If title is NOT full, return existing docmt for edit,
+92 ; or ask user.
+93 IF EDABLEDA
Begin DoDot:1
+94 IF TLFULL
if +$GET(TIUINQ)
Begin DoDot:2
+95 WRITE !!,"There is already a ",TIUTYPNM," which you may edit."
+96 WRITE !,"Only ONE record of this type per Visit is allowed...",!
+97 WRITE "Opening the existing record"
+98 SET TIUCHNG("EXIST")=1
End DoDot:2
SET DA=EDABLEDA
SET EDIT=1
QUIT
+99 IF 'TLFULL
Begin DoDot:2
+100 IF '+$GET(TIUINQ)
SET DA=EDABLEDA
SET EDIT=1
QUIT
+101 WRITE !!,"There is already a ",TIUTYPNM," which you may edit."
+102 ; "Create new anyway?"
SET YESDOIT=+$$INQUIRE
+103 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+104 IF YESDOIT
SET DA=$$CREATREC(DFN,.TIU,TIUTYP1)
SET TIUNEW=1
QUIT
+105 WRITE !!,"Okay, I'll open the existing record then!"
+106 SET DA=EDABLEDA
SET EDIT=1
SET TIUCHNG("EXIST")=1
End DoDot:2
QUIT
End DoDot:1
GOTO GETNWX
GETNWX ;
+1 IF TIUNEW
IF 'DA
SET TIUNEW=0
+2 QUIT +$GET(DA)
+3 ;
EXIST(DFN,TIUTYPDA,TIUVSTR,REQEDIT,PERSON) ; If a docmt already
+1 ;EXISTS for the given patient, title, and visit, then return it.
+2 ; Ignore: - docmts of status deleted or retracted
+3 ; - all docmts if run across a docmt w/ requesting pkg
+4 ; - all docmts if Title is PRF Title
+5 ; - I REQEDIT, then also ignore docmts PERSON cannot edit.
+6 ; If there are more than one, get the smallest DA.
+7 ; Receives TIUVSTR = LOC;VDT;VTYP
+8 ; Needs TIUTYPDA = title DA
+9 ; REQEDIT & PERSON are optional
+10 NEW REQUEST,DA,TIUI,STATUS,RETRY
+11 SET REQEDIT=+$GET(REQEDIT)
+12 IF '$GET(PERSON)
SET PERSON=DUZ
+13 SET (REQUEST,TIUI,DA)=0
+14 IF $$ISPFTTL^TIUPRFL(TIUTYPDA)
GOTO EXISTEX
LOOP ; -- Find existing docmt for given patient, title, & visit:--
+1 FOR
SET TIUI=+$ORDER(^TIU(8925,"APTLD",DFN,TIUTYPDA,TIUVSTR,TIUI))
if 'TIUI
QUIT
Begin DoDot:1
+2 ; -- If TIUI doesn't exist, reject it and keep looking: --
+3 IF '$DATA(^TIU(8925,TIUI,0))
Begin DoDot:2
+4 KILL ^TIU(8925,"APTLD",DFN,TIUTYPDA,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 ; -- If TIUI has status deleted or retracted, reject it
+9 ; and keep looking: TIU*1*61 --
+10 SET STATUS=+$PIECE($GET(^TIU(8925,TIUI,0)),U,5)
+11 IF STATUS=14!(STATUS=15)
QUIT
+12 ; -- If OK so far, and record not required to be editable,
+13 ;then grab existing record and stop looking: --
+14 IF 'REQEDIT
SET DA=TIUI
QUIT
+15 ; -- If REQEDIT & PERSON can edit existing record,
+16 ; then grab it and stop looking: --
+17 NEW CANEDIT
SET CANEDIT=+$$CANDO^TIULP(TIUI,"EDIT RECORD",PERSON)
+18 IF +CANEDIT>0
SET DA=TIUI
End DoDot:1
if REQUEST
QUIT
if DA
QUIT
+19 ; -- If record not required to be editable & still haven't
+20 ; found a record, check for records with no visit time: --
+21 ; (Early anomaly with DSs at Boston)
+22 IF +DA'>0
IF ($PIECE(TIUVSTR,";",3)="H")
IF (+$GET(RETRY)'>0)
Begin DoDot:1
+23 SET RETRY=1
SET $PIECE(TIUVSTR,";",2)=$PIECE($PIECE(TIUVSTR,";",2),".")
End DoDot:1
GOTO LOOP
EXISTEX ;
+1 QUIT +$GET(DA)
+2 ;
CREATREC(DFN,TIU,TIUTYP1) ; Create document record - Returns DA
+1 ; Receives array TIU as in GETRECNW
+2 ; Needs var TIUTYP1 as in GETRECNW
+3 NEW DIC,DLAYGO,X,Y,TIUFPRIV,TIUVTYP,RETRY,TIUVSTR,TIUVISIT,DA
+4 NEW TIUTYPDA,TIUTYPNM
+5 SET TIUTYPDA=$PIECE(TIUTYP1,U,2)
SET TIUTYPNM=$PIECE(TIUTYP1,U,3)
+6 SET TIUVSTR=TIU("VSTR")
+7 SET DA=0
SET TIUFPRIV=1
+8 SET (DIC,DLAYGO)=8925
SET DIC(0)="FL"
+9 SET X=""""_"`"_TIUTYPDA_""""
DO ^DIC
+10 IF +Y'>0
WRITE !,TIUTYPNM," record could not be created.",!
GOTO CREXIT
+11 ; -- Stuff patient, visit, parent doc type, status,
+12 ; visit type, hosp loc, visit loc, division: --
+13 SET DA=+Y
+14 NEW DIE,DR
SET DIE=8925
+15 SET TIUVTYP=$PIECE($GET(TIUVSTR),";",3)
+16 SET TIUVISIT=$SELECT(+$GET(TIU("VISIT")):+$GET(TIU("VISIT")),1:"")
+17 SET DR=".02////"_DFN_";.03////"_TIUVISIT_";.04////"_$$DOCCLASS^TIULC1(+$PIECE(Y,U,2))_";.05///"_$$UP^XLFSTR($$STATUS^TIULC(DA))_";.13////"_TIUVTYP_";1205////"_$PIECE(...
... $GET(TIU("LOC")),U)_";1211////"_$PIECE($GET(TIU("VLOC")),U)_";1212////"_$PIECE($GET(TIU("INST")),U)
+18 DO ^DIE
+19 ; -- [Mark record for deferred crediting of stop code (fld #.11)]: --
+20 IF +$GET(TIU("STOP"))
DO DEFER^TIUVSIT(DA,+$GET(TIU("STOP")))
CREXIT QUIT +$GET(DA)
+1 ;
INQUIRE() ; Ask user whether to create a new note anyway
+1 NEW TIUY,TIUPRMT
+2 SET TIUY=0
SET TIUPRMT="Do you want to create a new record anyway"
+3 SET TIUY=+$$READ^TIUU("Y",TIUPRMT,"NO")
+4 QUIT TIUY
+5 ;
