source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUADD.m@ 1361

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1TIUADD ; SLC/JER - Enter/Edit an addendum online ;2/13/02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**3,88,100,112**;Jun 20, 1997
3 ; 2/3: Update TEXTEDIT from TIUEDIT to TIUEDI4
4ADDENDUM(TIUDA,TIUADD,TIUCHNG,TIUNOASK) ; Control branching
5 N TIUY,TIUEDIT,TIUDADD K ^TMP("TIUADD",$J)
6 I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
7 S TIUCHNG("ADDM")=1
8 ; -- Get list of existing addenda, edit existing one --
9 D ADDLIST(.TIUY,TIUDA)
10 I +$D(TIUY),+$D(@TIUY) D G:$D(DIRUT) ADDENX
11 . W !
12 . S TIUEDIT=+$$READ^TIUU("YO","Do you wish to EDIT an existing ADDENDUM","YES")
13 . I +TIUEDIT D EDIT(TIUY) S TIUADD=1
14 G:+$G(TIUADD) ADDENX
15 ; -- Create new addendum to TIUDA: --
16 I +$P($G(^TIU(8925,+TIUDA,0)),U,6)'>0 D Q:$D(DIROUT)!(+TIUDADD'>0)
17 . S TIUDADD=$$CANDO^TIULP(TIUDA,"MAKE ADDENDUM")
18 . I '+TIUDADD D Q
19 . . W !!,$C(7),$P(TIUDADD,U,2),!
20 . . I $$READ^TIUU("EA","Press RETURN to continue...")
21 . I +TIUDADD D Q:$D(DIROUT)
22 . . I +$G(TIUNOASK)'>0,'+$$READ^TIUU("YO","Do you wish to ADD a new ADDENDUM","NO") Q
23 . . D ADD(TIUDA,.TIUCHNG)
24 . . ; -- Update ADDENDED? if browsing ID Note
25 . . I TIUCHNG,$P($G(TIUGDATA),U,2) K VALMHDR
26 I +$P(^TIU(8925,+TIUDA,0),U,6)>0 D
27 . W !!,$C(7)," You may not make an ADDENDUM to an ADDENDUM.",!
28 . I $$READ^TIUU("EA","Press RETURN to continue...")
29ADDENX ;Exit for ADDENDUM
30 K ^TMP("TIUADD",$J)
31 ;I $D(VALMAR),$$READ^TIUU("EA","Press RETURN to continue...")
32 Q
33EDIT(TIUY) ;Edit existing addendum
34 N TIUED,TIUDA,DA,DIC,DIE,TIUDAUTH,TIUPT,TIURDOC,DR,X,Y,TIUCNT
35 S TIUCNT=0 F S TIUCNT=$O(@TIUY@(TIUCNT)) Q:TIUCNT'>0 D Q:$D(DIROUT)
36 . N TIUQUIT
37 . S TIUDA=+$G(@TIUY@(TIUCNT))
38 . D GETTIU^TIULD(.TIU,+TIUDA)
39 . W !!,"Displaying Addendum #",TIUCNT
40 . D EN^VALM("TIU EDIT ADDENDUM") Q:$D(DIROUT)
41 Q
42EDADD ; Edit action
43 N DA,DIC,DIE,DLAYGO,DIWESUB,TIUDAUTH,TIUMD,TIUPT,TIUECOS,TIUXINI,DR,X,Y
44 N TIUDAD,TIUD0,TIUD12,TIUD13,TIUD14,TIUQUIT,TIUTYP,TIUT0,TIU
45 K TIUBY,TIUCANED
46 S TIUCANED=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
47 I +TIUCANED'>0 D Q
48 . W !!,$P(TIUCANED,U,2)
49 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
50 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13))
51 S TIUD14=$G(^TIU(8925,+TIUDA,14))
52 S TIUDAD=+$P($G(^TIU(8925,+TIUDA,0)),U,6)
53 S DA=+TIUDA
54 W !!,"Editing ADDENDUM"
55 S TIUTYP=+$G(^TIU(8925,+DA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
56 S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
57 S TIUMD=$$ISA^USRLM(+$G(DUZ),"PROVIDER")
58 S TIUPT=$P($G(^DPT(+$P(TIUD0,U,2),0)),U)
59 S DIWESUB="Patient: "_TIUPT
60 S DR=$$GETTMPL^TIUEDI1(+$P(^TIU(8925,+TIUDAD,0),U))
61 D GETTIU^TIULD(.TIU,TIUDAD)
62 ; -- Do DIE; get text, release, verify: --
63 D ADDDIE(DA,DR,TIUDAD)
64 I '$D(^TIU(8925,+DA,0)) S TIUCHNG=0,TIUCHNG("DELETE")=1 Q
65 ; -- Update status, visit type, visit location: --
66 S DR=".05///"_$$STATUS^TIULC(DA)_";.13////"_$P($G(TIU("VSTR")),";",3)_";1211////"_$P($G(TIU("VLOC")),U),DIE=8925 D ^DIE
67 ; -- Set TIUCHNG: e.g. TIUCHNG = 2^addmIFN (2 for entered/edited text);
68 ; TIUCHNG("EXIST") for edited EXISTING not new addm
69 S TIUCHNG=2_"^"_+$G(DA),TIUCHNG("EXIST")=1,VALMBCK="Q"
70 ; -- Sign, print: --
71 I +$P(TIUPRM0,U,2) D
72 . N TIUSIGN S TIUSIGN=$$CANDO^TIULP(DA,"SIGNATURE")
73 . I '+TIUSIGN D Q
74 . . I +$$ISA^USRLM(+$G(DUZ),"TRANSCRIPTIONIST") Q
75 . . W !,$C(7),$P(TIUSIGN,U,2)
76 . . I '$D(VALMAR),$$READ^TIUU("EA","Press RETURN to continue...")
77 . I +TIUSIGN D EDSIG^TIURS(DA)
78 . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
79 ; NOIS LOU-0598-40899
80 I $G(TIUQUIT),+$$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA) S TIUCHNG=0,TIUCHNG("DELETE")=1 H 2 Q
81 Q
82ADD(TIUDA,TIUCHNG) ;Add new addendum
83 N DA,DIC,DIE,DLAYGO,DIWESUB,DR,TIUDAUTH,TIUMD,TIUPT,TIUECOS,TIUXINI,X,Y
84 N TIUD0,TIUDV,TIUD12,TIUD13,TIUD14,TIUTYP,TIUT0,TIU,TIUFPRIV,TIUQUIT
85 N LINENO,EXPANDED
86 S TIUFPRIV=1
87 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13))
88 S TIUD14=$G(^TIU(8925,+TIUDA,14)),TIUDV=$P(TIUD0,U,3)
89 S LINENO=+$O(^TMP("TIUR",$J,"IEN",TIUDA,0))
90 I LINENO,$D(^TMP("TIUR",$J,"EXPAND",LINENO)) S EXPANDED=1
91 I '$G(EXPANDED),$$HASIDKID^TIUGBR(TIUDA) W !!," You are addending an interdisciplinary note. Your addendum will be added to",!,"the parent entry of the note." H 2
92 S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_$$ADDPTR_""""
93 D ^DIC
94 I +Y>0 S DA=+Y D
95 . W !!,"Adding ADDENDUM"
96 . S DIE="^TIU(8925,"
97 . S DR=".03////"_TIUDV_";.04////"_+$$ADDCLASS_";.05////3;.06////"_TIUDA
98 . S DR=DR_";1405////^S X=$P(TIUD14,U,5)"
99 . D ^DIE
100 . S TIUTYP=+$G(^TIU(8925,+DA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
101 . S TIUTYP(1)="1^"_+TIUTYP_U_$P(TIUT0,U,3)_U
102 . S TIUMD=$$ISA^USRLM(+$G(DUZ),"PROVIDER")
103 . S TIUPT=$P($G(^DPT(+$P(TIUD0,U,2),0)),U)
104 . S DIWESUB="Patient: "_TIUPT
105 . S DR=$$GETTMPL^TIUEDI1(+$P(^TIU(8925,+TIUDA,0),U))
106 . D GETTIU^TIULD(.TIU,TIUDA)
107 . D ADDDIE(DA,DR,TIUDA) I '$D(^TIU(8925,+DA,0)) S TIUCHNG=0,TIUCHNG("DELETE")=1 Q
108 . S DR=".05///"_$$STATUS^TIULC(DA),DIE=8925 D ^DIE
109 . S TIUCHNG=2_"^"_+$G(DA)
110 . I +$P(TIUPRM0,U,2) D
111 . . N TIUSIGN S TIUSIGN=$$CANDO^TIULP(DA,"SIGNATURE")
112 . . I '+TIUSIGN D Q
113 . . . W !,$C(7),$P(TIUSIGN,U,2)
114 . . . I '$D(VALMAR),$$READ^TIUU("EA","Press RETURN to continue...")
115 . . I +TIUSIGN D EDSIG^TIURS(DA)
116 . I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(DA)
117 . I $G(TIUQUIT) D DELETE^TIUEDIT(DA) S TIUCHNG=0,TIUCHNG("DELETE")=1 Q
118 Q
119ADDPTR() ; Get record # of ADDENDUM in 8925.1
120 N DIC,X,Y,TIUFPRIV S TIUFPRIV=1
121 S DIC=8925.1,DIC(0)="FMX",X="ADDENDUM"
122 S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""DOC"""
123 D ^DIC K DIC("S")
124 Q +Y
125ADDCLASS() ; Get record # of ADDENDUM Document Class in 8925.1
126 N DIC,X,Y,TIUFPRIV S TIUFPRIV=1
127 S DIC=8925.1,DIC(0)="FMX",X="ADDENDUM"
128 S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""DC"""
129 D ^DIC K DIC("S")
130 Q +Y
131ADDDIE(DA,DR,TIUDA) ; Call DIE to conduct dialog
132 N TIUREL,TIUD0,TIUD12,TIUD13,TIUD14,DTOUT,Y,DWPK
133 S DIE=8925 D ^DIE
134 I $D(Y)!($D(DTOUT)) S TIUQUIT=1
135 D:+$G(TIUQUIT) SEND^TIUALRT(DA)
136 I '+$G(TIUQUIT) D
137 . D TEXTEDIT^TIUEDI4(DA)
138 . I $$EMPTYDOC^TIULF(DA) D DELETE^TIUEDIT(DA,0) Q
139 . ; -- Not clear why I need these nodes 0,12,13,14: --
140 . S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13))
141 . S TIUD14=$G(^TIU(8925,+DA,14))
142 . ; Execute RELEASE Logic
143 . D RELEASE^TIUT(DA) S TIUREL=""
144 . ; Execute VERIFY Logic
145 . D VERIFY^TIUT(DA)
146 . ; Send Addendum Alert
147 . D SENDADD^TIUALRT(DA)
148 Q
149ADDLIST(Y,TIUDA) ; Get list of addenda for a record
150 N TIUI,TIUCNT S (TIUCNT,TIUI)=0 K ^TMP("TIUADD",$J)
151 F S TIUI=$O(^TIU(8925,"DAD",TIUDA,TIUI)) Q:+TIUI'>0 D
152 . Q:+$$ISADDNDM^TIULC1(TIUI)'>0
153 . Q:+$$CANDO^TIULP(TIUI,"EDIT RECORD")'>0
154 . S TIUCNT=TIUCNT+1,^TMP("TIUADD",$J,TIUCNT)=TIUI
155 I $D(^TMP("TIUADD",$J)) S Y=$NA(^TMP("TIUADD",$J))
156 Q
Note: See TracBrowser for help on using the repository browser.