source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUEDI1.m@ 1608

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

initial load of WorldVistAEHR
File size: 6.6 KB
RevLine 
[613]1TIUEDI1 ; SLC/MAM - Additional Edit Code ;March 25, 2004
2 ;;1.0;TEXT INTEGRATION UTILITIES;**7,22,66,61,100,166**;Jun 20, 1997
3GETREC(DFN,TIU,TIUCREAT,TIUNEW,TIUDPRM,TIUINQ,TIUPERSN) ;Returns
4 ;new or existing document DA.
5 ; Receives TIUPERSN (optional) = person asking to edit/create docmt,
6 ; or for upload, = author of document.
7 ; If not received, assumed to be DUZ.
8 ; New **ID** parameter, backward compatible
9 ; Requires array TIUTYP where
10 ; TIUTYP = title DA
11 ; TIUTYP(1) = 1^title DA^Name
12 ; Receives TIUCREAT for backward compatibility place holder only
13 S TIUPERSN=$G(TIUPERSN,DUZ)
14 S DA=$$GETRECNW^TIUEDI3(DFN,.TIU,TIUTYP(1),.TIUNEW,.TIUDPRM,+$G(TIUINQ),TIUPERSN)
15 Q +$G(DA)
16 ;
17INQUIRE() ; Ask user whether to create a new note anyway
18 N TIUY,TIUPRMT
19 S TIUY=0,TIUPRMT="Do you want to create a new record anyway"
20 S TIUY=+$$READ^TIUU("Y",TIUPRMT,"NO")
21 Q TIUY
22SCANDAD(TIUTYP,TIUDA) ; Search "DAD" index for component record
23 N TIUC,TIUY
24 S (TIUY,TIUC)=0
25 F S TIUC=$O(^TIU(8925,"DAD",+TIUDA,TIUC)) Q:+TIUC'>0!(+TIUY>0) D
26 . I +TIUTYP=+$G(^TIU(8925,+TIUC,0)) S TIUY=TIUC Q
27 . I +$O(^TIU(8925,"DAD",+TIUC,0)) S TIUY=$$SCANDAD(TIUTYP,TIUC)
28 Q TIUY
29GETCOMP(TIUTYP,TIUDA,TIU,DFN) ; Adds components to document
30 N DIC,DA,X,Y,DIE,DR,TIUC,TIUCMP,TIUMOM,TIUMTYP,TIUY,TIUFPRIV
31 N DLAYGO ;10/3/00
32 S TIUFPRIV=1,(TIUY,TIUC)=0
33 S TIUY=$$SCANDAD(TIUTYP,TIUDA)
34 I +TIUY G GETCX
35 S (DIC,DLAYGO)=8925,DIC(0)="FL"
36 S X="""`"_+TIUTYP_""""
37 D ^DIC
38 I +Y'>0 W !,X," component could not be created.",! G GETCX
39 S (TIUY,DA)=+Y,DIE=DIC
40 S TIUMOM=+$$RUMYMTHR(TIUDA,DA,+TIUTYP,+$G(^TIU(8925,+DA,0)))
41 S TIUMTYP=+$G(^TIU(8925,+TIUMOM,0))
42 S DR=".02////"_DFN_";.03////"_$P($G(TIU("VISIT")),U)_";.04////"_TIUMTYP_";.06////"_TIUMOM
43 D ^DIE W "."
44GETCX Q TIUY
45RUMYMTHR(MOM,BRAT,MOMTYP,BRATYP) ; Get appropriate parent for component
46 N TIUI,GOTMOM,CNDMOM,CNDTYP,TIUMOM S (GOTMOM,TIUI)=0
47 I +$O(^TIU(8925.1,"AD",+BRATYP,MOMTYP,0)) S GOTMOM=1 G RUMYX
48 S CNDMOM=0
49 F S CNDMOM=$O(^TIU(8925,"DAD",+MOM,+CNDMOM)) Q:+CNDMOM'>0 D
50 . S CNDTYP=+$G(^TIU(8925,+CNDMOM,0))
51 . S TIUMOM=$$RUMYMTHR(CNDMOM,BRAT,CNDTYP,BRATYP) I $P(TIUMOM,U,2)=1 S MOM=+TIUMOM,GOTMOM=1 Q
52RUMYX Q MOM_U_GOTMOM
53DELCOMP(TIUDA) ; Cleans up all components of a document
54 N DA,DIE,DR,TIUCDA S TIUCDA=0,DIE="^TIU(8925,"
55 F S TIUCDA=$O(^TIU(8925,"DAD",TIUDA,TIUCDA)) Q:+TIUCDA'>0 D
56 . W !,$P(^TIU(8925.1,+^TIU(8925,TIUCDA,0),0),U)_" Component Deleted"
57 . S DR=".01///@",DA=TIUCDA D ^DIE W "."
58 . I +$O(^TIU(8925,"DAD",TIUCDA,0))>0 D DELCOMP(TIUCDA)
59 Q
60DELAUDIT(TIUDA) ; Cleans up all AUDIT TRAIL entries for a document
61 N DA,DIK,DR,TIUADA S TIUADA=0,DIK="^TIU(8925.5,"
62 F S TIUADA=$O(^TIU(8925.5,"B",TIUDA,TIUADA)) Q:+TIUADA'>0 D
63 . ; W !," Audit trail record #",TIUADA," Deleted"
64 . S DA=TIUADA D ^DIK ; W "."
65 I $L($T(DEL^PXRMGECU)) D DEL^PXRMGECU(+TIUDA)
66 Q
67ISCOMP(TIUTYP,X) ; Is the text provided a component tag
68 N DIC,TIULEVEL,TIUY,Y,TIUFPRIV S TIULEVEL=0,TIUFPRIV=1
69 S DIC=8925.1,DIC(0)="FX"
70 S DIC("S")="I $P(^TIU(8925.1,+Y,0),U,4)=""CO"""
71 D ^DIC K DIC("S")
72 I +Y'>0 S TIUY=0 G ISCMPX
73 I +$O(^TIU(8925.1,+TIUTYP,10,"B",+Y,0))'>0 S TIUY=0 G ISCMPX
74 S TIUY=Y
75ISCMPX Q TIUY
76MERGTEMP(TIUDA) ; Merge text from components into TEMP node for edit
77 N TIUC,TIUI,TIUJ,TIULINE
78 S (TIUC,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
79 F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
80 . I +$$ISADDNDM^TIULC1(+TIUC) Q
81 . S TIUI=0 F S TIUI=$O(^TIU(8925,+TIUC,"TEXT",TIUI)) Q:+TIUI'>0 D
82 . . S TIUJ=+$G(TIUJ)+1
83 . . S ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC,"TEXT",TIUI,0))
84 . . K ^TIU(8925,+TIUC,"TEXT",TIUI,0) ; Clear the way for edits
85 . . S ^TIU(8925,+TIUC,"TEXT",0)="^^^^"_DT_"^^"
86 . . S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
87 . I +$O(^TIU(8925,"DAD",+TIUC,0)) D MERGGRAN(TIUDA,+TIUC)
88 . S TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
89 I $D(^TIU(8925,+TIUDA,"TEMP",1))>9 M ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
90 Q
91MERGGRAN(TIUDA,TIUC) ; Merge sub-components into TEMP node of original
92 N TIUC1,TIUI,TIUJ,TIULINE
93 S (TIUC1,TIULINE)=0,TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
94 F S TIUC1=$O(^TIU(8925,"DAD",TIUC,TIUC1)) Q:+TIUC1'>0 D
95 . S TIUI=0 F S TIUI=$O(^TIU(8925,+TIUC1,"TEXT",TIUI)) Q:+TIUI'>0 D
96 . . S TIUJ=+$G(TIUJ)+1
97 . . S ^TIU(8925,+TIUDA,"TEMP",TIUJ,0)=$G(^TIU(8925,+TIUC1,"TEXT",TIUI,0))
98 . . K ^TIU(8925,+TIUC1,"TEXT",TIUI,0) ; Clear the way for edits
99 . . S ^TIU(8925,+TIUC1,"TEXT",0)="^^^^"_DT_"^^"
100 . . S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
101 . I +$O(^TIU(8925,"DAD",+TIUC1,0)) D MERGGRAN(TIUDA,+TIUC1)
102 . S TIUJ=+$P($G(^TIU(8925,+TIUDA,"TEMP",0)),U,3)
103 Q
104MERGTEXT(TIUDA,TIU) ; Merge TEMP node from parent document into components
105 N TIUTYP
106 S TIUTYP=+$P(^TIU(8925,+TIUDA,0),U)
107 ; -- If document has components, add/update them
108 I +$O(^TIU(8925.1,+TIUTYP,10,0))>0 D
109 . N TIUC,TIUI,TIUJ,TIUX,TIUCMP S (TIUI,TIUJ,TIUCMP)=0
110 . F S TIUI=$O(^TIU(8925,+TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
111 . . S TIUX=$G(^TIU(8925,+TIUDA,"TEMP",TIUI,0))
112 . . S TIUC=+$$ISCOMP(TIUTYP,$P(TIUX,":"))
113 . . I TIUX[":",+TIUC D
114 . . . S TIUJ=0 ; Reinitialize line count for new component
115 . . . S TIUCMP=$$GETCOMP(TIUC,TIUDA,.TIU,DFN)
116 . . S TIUJ=+$G(TIUJ)+1
117 . . I +TIUCMP>0 D
118 . . . S ^TIU(8925,+TIUCMP,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEMP",+TIUI,0))
119 . . . S ^TIU(8925,+TIUCMP,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
120 . . E D
121 . . . S ^TIU(8925,+TIUDA,"TEXT",TIUJ,0)=$G(^TIU(8925,+TIUDA,"TEMP",TIUJ,0))
122 . . . S ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUJ_"^"_TIUJ_"^"_DT_"^^"
123 ; -- If no components, merge "TEMP" into "TEXT" for current document
124 I +$O(^TIU(8925.1,+TIUTYP,10,0))'>0 M ^TIU(8925,+TIUDA,"TEXT")=^TIU(8925,+TIUDA,"TEMP")
125 Q
126GETTMPL(TIUTYP) ; Get edit template, enforce inheritance
127 N TIUDAD,TIUY S TIUDAD=0
128 S TIUY=$G(^TIU(8925.1,+TIUTYP,5))
129 I TIUY']"",($P(^TIU(8925.1,+TIUTYP,0),U)["ADDENDUM") D
130 . S TIUDAD=+$P($G(^TIU(8925,+$P($G(^TIU(8925,+$G(TIUDA),0)),U,6),0)),U)
131 . I +TIUDAD S TIUY=$$GETTMPL(TIUDAD)
132 I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
133 I +TIUDAD S TIUY=$$GETTMPL(TIUDAD)
134 Q TIUY
135AUDIT(TIUDA,TIUCKSM0,TIUCKSM1) ; Update audit trail
136 N DIC,DIE,DA,DR,X,Y
137 S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
138 S DIE=DIC,DR=".02////"_$$NOW^TIULC_";.03////"_DUZ_";.04////"_TIUCKSM0_";.05////"_TIUCKSM1
139 S DA=+Y D ^DIE
140 Q
141GETLMETH(TIUTYP) ; Get Visit Linkage method, enforce inheritance
142 N TIUDAD,TIUY S TIUDAD=0
143 S TIUY=$G(^TIU(8925.1,+TIUTYP,7))
144 I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
145 I +TIUDAD S TIUY=$$GETLMETH(TIUDAD)
146 Q TIUY
147GETVMETH(TIUTYP) ; Get Validation method, enforce enheritance
148 N TIUDAD,TIUY S TIUDAD=0
149 S TIUY=$G(^TIU(8925.1,+TIUTYP,8))
150 I TIUY']"" S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
151 I +TIUDAD S TIUY=$$GETVMETH(TIUDAD)
152 Q TIUY
153 ;
Note: See TracBrowser for help on using the repository browser.