source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURA1.m@ 862

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

initial load of WorldVistAEHR
File size: 6.6 KB
RevLine 
[613]1TIURA1 ; SLC/JER - Review screen actions ;3/5/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**20,88,58,100**;Jun 20, 1997
3ADDEND ; Make addenda
4 N TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIULST,TIUDAARY
5 S TIUI=0
6 ; -- Get docmt to addend: --
7 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
8 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
9 . N RSTRCTD
10 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
11 . D CLEAR^VALM1 W !!,"Making an addendum for #",+TIUDATA
12 . ; -- Addend it: --
13 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
14 . I RSTRCTD D Q
15 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
16 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
17 . S TIUDAARY(TIUI)=TIUDA
18 . S TIUCHNG=0
19 . I +$D(^TIU(8925,+TIUDA,0)) D ADDEND1
20 . I +$G(TIUCHNG) D
21 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
22 ; -- Update or Rebuild list, restore video:
23 I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
24 E S TIUCHNG("UPDATE")=1 ; user may have edited existing addm
25 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
26 S VALMBCK="R"
27 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"addended")
28 Q
29ADDEND1 ; Single record Addendum
30 ; Receives TIUDA
31 N %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
32 N TIUTYP,TIUT0,TIUDPRM
33 I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
34 I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
35 D ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG,1)
36 Q
37NAME ; Identify signer(s)
38 N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
39 N TIUDAARY
40 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
41 S TIUI=0
42 I +$O(VALMY(0)) D FULL^VALM1
43 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
44 . N TIU,VALMY,XQORM,RSTRCTD
45 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
46 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
47 . I RSTRCTD D Q
48 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
49 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
50 . S TIUDAARY(TIUI)=TIUDA
51 . S TIUCHNG=0
52 . D SIGNER ; SIGNER initializes TIUCHNG to 0
53 . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
54NAMEX ; Revise list and cycle back as appropriate
55 S TIUCHNG("REFRESH")=1
56 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
57 S VALMBCK="R"
58 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"Signers identified/edited")
59 Q
60SIGNER ; Link selected document to additional signers
61 ; Receives TIUDA as pointer to document record
62 N TIULIST,TIUI,TIUMORE,TIUCANID S (TIUCHNG,TIUI)=0,TIUMORE=1
63 S TIUCANID=$$CANDO^TIULP(TIUDA,"IDENTIFY SIGNERS")
64 I +$$MAYCHNG(TIUDA) D Q:'TIUMORE
65 . N TIUPRMT S TIUPRMT="Do you Wish to Identify Additional Signers"
66 . D CHNGCSNR(TIUDA) S TIUCHNG=1
67 . I +$G(TIUCANID) S TIUMORE=$$READ^TIUU("YO",TIUPRMT,"NO")
68 . I +$G(TIUCANID)'>0 S TIUMORE=0
69 I +$G(TIUCANID)'>0 D Q
70 . W !!,$C(7),$P(TIUCANID,U,2),! ; Echo denial message
71 . I $$READ^TIUU("EA","RETURN to continue...") ; pause
72 I +$O(^TIU(8925.7,"B",TIUDA,0)) D Q:+TIUMORE'>0
73 . N DIDEL,DIE,DA,DR,TIUY,TIUPRMT
74 . W !,"This Document Already has Additional Expected Signers."
75 . D XTRASIGN^TIULX(.TIUY,TIUDA) Q:+$O(TIUY(0))'>0
76 . S DA=+$$ASKSIGN^TIULX(.TIUY) Q:+DA'>0
77 . S (DIE,DIDEL)=8925.7,DR=".03;I +X>0 S Y=""@1"";.01///@;@1" D ^DIE
78 . D SEND^TIUALRT(TIUDA) S TIUCHNG=1
79 . S TIUPRMT="Do You Wish to Identify More Additional Signers"
80 . S TIUMORE=$$READ^TIUU("Y",TIUPRMT,"NO")
81 D PERSEL(.TIULIST,TIUDA) Q:+$D(TIULIST)'>9
82 F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0 D
83 . N DA,DIC,DIE,DLAYGO,DR,X,Y
84 . S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.7,DIC(0)="LX" D ^DIC Q:+Y'>0
85 . S DIE=DIC
86 . S DR=".02////"_0_";.03////"_+$G(TIULIST(TIUI))
87 . D ^DIE
88 . W !,$$SIGNAME^TIULS(+TIULIST(TIUI))," Added as expected signer..." H 2
89 . D SEND^TIUALRT(TIUDA)
90 . S TIUCHNG=1 K VALMY(TIUI)
91 Q
92MAYCHNG(TIUDA) ; Boolean function - can cosigner be modified?
93 N TIUD0,TIUD12,TIUY,TIUAUTH,TIUESNR,TIUECSNR S TIUY=0
94 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
95 S TIUAUTH=$P(TIUD12,U,2),TIUESNR=$P(TIUD12,U,4),TIUECSNR=$P(TIUD12,U,8)
96 I +TIUECSNR,(+$P(TIUD0,U,5)<7) D
97 . S TIUY=$S(DUZ=TIUAUTH:1,DUZ=TIUESNR:1,DUZ=TIUECSNR:1,1:0)
98 Q TIUY
99CHNGCSNR(DA) ; Change the expected cosigner
100 N DR,DIE,X,Y
101 W !,"You may change the expected cosigner, if you wish...",!
102CHNGAGN S DIE=8925,DR="1208R" D ^DIE
103 I +$P($G(^TIU(8925,DA,12)),U,8)'>0 W !,$C(7)," Response Required." G CHNGAGN
104 D SEND^TIUALRT(DA)
105 Q
106PERSEL(TIUY,TIUDA) ; Select a person
107 N TIUQUIT,TIUPRSN,TIUI,TIUPRMT,TIUSCRN S (TIUI,TIUQUIT)=0
108 W !!,"Specify other practitioners whose signatures will be expected:",!
109 F D Q:+TIUQUIT
110 . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") "
111 . S TIUSCRN="I +$$SCREEN^TIURA1(TIUDA,+Y)"
112 . S TIUPRSN=$$READ^TIUU("PAO^200:AEMQ",TIUPRMT,"","",TIUSCRN)
113 . I +TIUPRSN'>0 S TIUQUIT=1 Q
114 . S TIUY(TIUI)=TIUPRSN
115 W !
116 Q
117SCREEN(TIUDA,Y) ; Evaluate whether a person may be selected as a signer
118 N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected
119 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
120 ; A user may NOT select himself
121 I Y=+$G(DUZ) S TIUY=0 G SCREENX
122 ; Author may NOT be selected
123 I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX
124 ; Expected Signer may NOT be selected
125 I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX
126 ; Can't choose a terminated user
127 I '+$$ACTIVE^XUSER(+Y) S TIUY=0 G SCREENX
128 ; Can't name the same signer twice
129 I +$O(^TIU(8925.7,"AE",+TIUDA,+Y,0)) S TIUY=0 G SCREENX
130 S TIUI=0
131 F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0!(TIUY=0) D
132 . I +$G(TIULIST(TIUI))=+Y S TIUY=0
133 I +TIUY=0 G SCREENX
134 ; Expected Cosigner may NOT be selected
135 I Y=+$P(TIUD12,U,8) S TIUY=0
136SCREENX Q +$G(TIUY)
137ENCNTR ; Enter/edit encounter data on demand
138 N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUI,TIUY,TIULST,Y,DIROUT
139 N TIUDAARY
140 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
141 S TIUI=0
142 I +$O(VALMY(0)) D FULL^VALM1
143 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
144 . N TIU,VALMY,XQORM,RSTRCTD
145 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
146 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
147 . I RSTRCTD D Q
148 . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
149 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
150 . S TIUDAARY(TIUI)=TIUDA
151 . S TIUCHNG=0
152 . D EDTENC^TIUPXAP2(TIUDA,.TIUCHNG)
153 . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
154ENCNTX ; Revise list and cycle back as appropriate
155 S TIUCHNG("REFRESH")=1
156 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
157 S VALMBCK="R"
158 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"Encounter Data Edited")
159 Q
160CHARTANY(VALMY) ; Can any of the selected items be printed for the chart?
161 N TIUDATA,TIUDA,TIUI,TIUY S (TIUI,TIUY)=0
162 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:+TIUY
163 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
164 . S TIUDA=+$P(TIUDATA,U,2)
165 . S TIUY=+$$CHARTONE(TIUDA)
166 Q TIUY
167CHARTONE(TIUDA) ; Can this document be printed for the chart?
168 N TIUDTYP,TIUDPRM
169 S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
170 D DOCPRM^TIULC1(TIUDTYP,.TIUDPRM,TIUDA)
171 Q +$P(TIUDPRM(0),U,9)
Note: See TracBrowser for help on using the repository browser.