source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUEDI3.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1TIUEDI3 ; SLC/MAM - Additional Edit Code ;4/19/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100,113,184**;Jun 20, 1997
3 ;
4GETRECNW(DFN,TIU,TIUTYP1,TIUNEW,TIUDPRM,TIUINQ,PERSON,EDIT) ; New GETREC.
5 ; Code rewritten from the old GETREC^TIUEDI1.
6 ; GETREC^TIUEDI1 now calls this code.
7 ; New parameters: Left out TIUCREAT since we always used it as 1.
8 ; Added PERSON and EDIT.
9 ; Can be called directly, or via GETREC^TIUEDI1 for
10 ;backward compatibility. GETREC^TIUEDI1 uses OLD parameters.
11 ; There are 3 functional differences between GETRECNW and the old
12 ;GETREC: First, GETRECNW no longer does RETRY since there should no
13 ;longer be editable entries with no time in the visit field.
14 ;Second, if user when creating new docmt is asked if user wants
15 ;to edit existing docmt instead, and user says no, and user
16 ;cannot create a new docmt, then user is no longer given the
17 ;existing record to addend. User must use a separate addend action.
18 ;Third, because code is restructured, code no longer quits before
19 ;creating a new docmt if GETRECNW is called with DUOUT, etc defined.
20 ;So quit before calling GETRECNW if DUOUT, etc.
21 ; Returns document record DA, where DA is:
22 ; new docmt for user to continue entering, or
23 ; existing docmt for user to edit or addend.
24 ; If called by upload, DA is:
25 ; new docmt to continue entering, or
26 ; existing docmt for text replacement or addendum.
27 ;
28 ; Call with:
29 ; DFN, TIU array, TIUTYP1 are REQUIRED.
30 ; [DFN] --> Patient IFN.
31 ; [TIU] --> Visit info array
32 ; References TIU("VSTR") = LOC;VDT;VTYP
33 ; TIU("VISIT") = Visit File IFN
34 ; TIU("LOC")
35 ; TIU("VLOC")
36 ; TIU("STOP") = mark to defer workload
37 ; [TIUTYP1] --> Title info variable of form:
38 ; TIUTYP1 = 1^title DA^title Name, where the 1
39 ; is just style to imitate XQORNOD
40 ; [TIUNEW] --> flag, passed back with
41 ; TIUNEW = 1 if returned docmt is new
42 ; TIUNEW = 0 if returned docmt already existed,
43 ; timeout, etc
44 ;
45 ;[TIUDPRM] --> Docmt param array where
46 ; $P($G(TIUDPRM(0)),U,10), = 1 if
47 ; more than ONE record/visit is allowed.
48 ; If TIUDPRM not received, don't worry about
49 ; creating multiple documents
50 ; [TIUINQ] --> Ask user flag, where
51 ; TIUINQ = 1: ask re edit/addend existing docmt
52 ; (Interactive List Manager options, TRY docmt def)
53 ; TIUINQ = 0: don't ask (Upload & GUI options)
54 ; [PERSON] --> IFN of person asking to edit/create docmt,
55 ; or for upload, = author of document
56 ; If not received, assumed to be DUZ.
57 ; [EDIT] --> flag, passed back with EDIT = 1 if returned
58 ; PREEXISTING docmt can be edited by PERSON. If
59 ; preexisting docmt returned and 'EDIT, then
60 ; docmt cannot be edited by person.
61 N TIUVSTR,MULTOK,DA,TLFULL,XISONE
62 N EDABLEDA,YESDOIT ;10/3/00
63 N TIUTYPDA,TIUTYPNM
64 I '$G(PERSON) S PERSON=DUZ
65 S TIUVSTR=TIU("VSTR")
66 ; -- If just testing a document definition (TRY) rather than
67 ; doing a real note, skip inquiry into existing notes: --
68 I +$G(NOSAVE) S DA=$$CREATREC(DFN,.TIU,TIUTYP1),TIUNEW=1 G GETNWX
69 ; -- MULTOK: More than ONE record/visit is OK (param permits,
70 ; or didn't care enough to send the parameter)
71 ; TLFULL: Only 1 docmt allowed, and it
72 ; already exists on this title/pt/vst --
73 I '$D(TIUDPRM(0)) S MULTOK=1
74 E S MULTOK=+$P(TIUDPRM(0),U,10)
75 S (TIUNEW,EDIT,DA,TLFULL,EDABLEDA)=0
76 S TIUTYPDA=$P(TIUTYP1,U,2),TIUTYPNM=$P(TIUTYP1,U,3)
77 S XISONE=$$EXIST(DFN,TIUTYPDA,TIUVSTR)
78 I 'MULTOK,XISONE S TLFULL=1
79 ; -- Find existing editable docmts for patient, title, & visit:--
80 S EDABLEDA=+$$EXIST(DFN,TIUTYPDA,TIUVSTR,1,PERSON)
81 ; -- If there are NO such docmts,
82 ; then create new if title not full,
83 ; or return existing [NONeditable] for addendum [if user wants]: --
84 I 'EDABLEDA D G GETNWX
85 . I 'TLFULL S DA=$$CREATREC(DFN,.TIU,TIUTYP1),TIUNEW=1 Q
86 . I +$G(TIUINQ) D Q
87 . . W !!,"There is already a ",TIUTYPNM,".",!
88 . . W "Only ONE record of this type per Visit is allowed...",!
89 . . S YESDOIT=+$$READ^TIUU("Y"," Would you like to addend the existing record","NO")
90 . . I YESDOIT S DA=XISONE
91 . I '+$G(TIUINQ) S DA=XISONE
92 . Q
93 ; -- If there ARE such docmts, then
94 ; If title is full, return existing docmt for edit.
95 ; If title is NOT full, return existing docmt for edit,
96 ; or ask user.
97 I EDABLEDA D G GETNWX
98 . I TLFULL D:+$G(TIUINQ) S DA=EDABLEDA,EDIT=1 Q
99 . . W !!,"There is already a ",TIUTYPNM," which you may edit."
100 . . W !,"Only ONE record of this type per Visit is allowed...",!
101 . . W "Opening the existing record"
102 . . S TIUCHNG("EXIST")=1
103 . I 'TLFULL D Q
104 . . I '+$G(TIUINQ) S DA=EDABLEDA,EDIT=1 Q
105 . . W !!,"There is already a ",TIUTYPNM," which you may edit."
106 . . S YESDOIT=+$$INQUIRE ; "Create new anyway?"
107 . . I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) Q
108 . . I YESDOIT S DA=$$CREATREC(DFN,.TIU,TIUTYP1),TIUNEW=1 Q
109 . . W !!,"Okay, I'll open the existing record then!"
110 . . S DA=EDABLEDA,EDIT=1,TIUCHNG("EXIST")=1
111GETNWX ;
112 I TIUNEW,'DA S TIUNEW=0
113 Q +$G(DA)
114 ;
115EXIST(DFN,TIUTYPDA,TIUVSTR,REQEDIT,PERSON) ; If a docmt already
116 ;EXISTS for the given patient, title, and visit, then return it.
117 ; Ignore: - docmts of status deleted or retracted
118 ; - all docmts if run across a docmt w/ requesting pkg
119 ; - all docmts if Title is PRF Title
120 ; - I REQEDIT, then also ignore docmts PERSON cannot edit.
121 ; If there are more than one, get the smallest DA.
122 ; Receives TIUVSTR = LOC;VDT;VTYP
123 ; Needs TIUTYPDA = title DA
124 ; REQEDIT & PERSON are optional
125 N REQUEST,DA,TIUI,STATUS,RETRY
126 S REQEDIT=+$G(REQEDIT)
127 I '$G(PERSON) S PERSON=DUZ
128 S (REQUEST,TIUI,DA)=0
129 I $$ISPFTTL^TIUPRFL(TIUTYPDA) G EXISTEX
130LOOP ; -- Find existing docmt for given patient, title, & visit:--
131 F S TIUI=+$O(^TIU(8925,"APTLD",DFN,TIUTYPDA,TIUVSTR,TIUI)) Q:'TIUI D Q:REQUEST Q:DA
132 . ; -- If TIUI doesn't exist, reject it and keep looking: --
133 . I '$D(^TIU(8925,TIUI,0)) D Q
134 . . K ^TIU(8925,"APTLD",DFN,TIUTYPDA,TIUVSTR,TIUI)
135 . ; -- If TIUI has requesting package (e.g. Consults),
136 . ; then reject it and quit looking: --
137 . I +$P($G(^TIU(8925,TIUI,14)),U,5) S REQUEST=1 Q ; **22**
138 . ; -- If TIUI has status deleted or retracted, reject it
139 . ; and keep looking: TIU*1*61 --
140 . S STATUS=+$P($G(^TIU(8925,TIUI,0)),U,5)
141 . I STATUS=14!(STATUS=15) Q
142 . ; -- If OK so far, and record not required to be editable,
143 . ;then grab existing record and stop looking: --
144 . I 'REQEDIT S DA=TIUI Q
145 . ; -- If REQEDIT & PERSON can edit existing record,
146 . ; then grab it and stop looking: --
147 . N CANEDIT S CANEDIT=+$$CANDO^TIULP(TIUI,"EDIT RECORD",PERSON)
148 . I +CANEDIT>0 S DA=TIUI
149 ; -- If record not required to be editable & still haven't
150 ; found a record, check for records with no visit time: --
151 ; (Early anomaly with DSs at Boston)
152 I +DA'>0,($P(TIUVSTR,";",3)="H"),(+$G(RETRY)'>0) D G LOOP
153 . S RETRY=1,$P(TIUVSTR,";",2)=$P($P(TIUVSTR,";",2),".")
154EXISTEX ;
155 Q +$G(DA)
156 ;
157CREATREC(DFN,TIU,TIUTYP1) ; Create document record - Returns DA
158 ; Receives array TIU as in GETRECNW
159 ; Needs var TIUTYP1 as in GETRECNW
160 N DIC,DLAYGO,X,Y,TIUFPRIV,TIUVTYP,RETRY,TIUVSTR,TIUVISIT,DA
161 N TIUTYPDA,TIUTYPNM
162 S TIUTYPDA=$P(TIUTYP1,U,2),TIUTYPNM=$P(TIUTYP1,U,3)
163 S TIUVSTR=TIU("VSTR")
164 S DA=0,TIUFPRIV=1
165 S (DIC,DLAYGO)=8925,DIC(0)="FL"
166 S X=""""_"`"_TIUTYPDA_"""" D ^DIC
167 I +Y'>0 W !,TIUTYPNM," record could not be created.",! G CREXIT
168 ; -- Stuff patient, visit, parent doc type, status,
169 ; visit type, hosp loc, visit loc, division: --
170 S DA=+Y
171 N DIE,DR S DIE=8925
172 S TIUVTYP=$P($G(TIUVSTR),";",3)
173 S TIUVISIT=$S(+$G(TIU("VISIT")):+$G(TIU("VISIT")),1:"")
174 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)
175 D ^DIE
176 ; -- [Mark record for deferred crediting of stop code (fld #.11)]: --
177 I +$G(TIU("STOP")) D DEFER^TIUVSIT(DA,+$G(TIU("STOP")))
178CREXIT Q +$G(DA)
179 ;
180INQUIRE() ; Ask user whether to create a new note anyway
181 N TIUY,TIUPRMT
182 S TIUY=0,TIUPRMT="Do you want to create a new record anyway"
183 S TIUY=+$$READ^TIUU("Y",TIUPRMT,"NO")
184 Q TIUY
185 ;
Note: See TracBrowser for help on using the repository browser.