source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCNOTE.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.6 KB
Line 
1ORCNOTE ; SLC/MKB - Progress Note actions ;25-JAN-2001 16:18:00
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**22,48,65,104**;Dec 17, 1997
3ELSIG ; Sign rec
4 N ASK,TIUEVNT,TIUDA,TIUES,TIUI,X,X1,Y,ORI,NMBR,ORPICK,ORQUIT,IDX,TIUPOP,TIUPRM0,TIUPRM1
5 I '$D(TIUPRM0) D SETPARM^TIULE
6 I $P(TIUPRM0,U,2)'>0 W !,"Electronic signature not yet enabled." H 3 G ELSIGX
7 S ORPICK="",VALMBCK=""
8 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("sign") Q:'ORNMBR
9 I +ORNMBR D FULL^VALM1
10 S ORI=1
11 F S NMBR=$P(ORNMBR,",",ORI) Q:+NMBR'>0!$D(ORQUIT) D
12 . N TIU0,TIU12,TIU15,TIUSTAT,TIUEVNT,TIUTYPE,TIUDA
13 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),ORI=+$G(ORI)+1
14 . S TIUDA=+IDX,TIU0=$G(^TIU(8925,+TIUDA,0)),TIU12=$G(^(12)),TIU15=$G(^(15))
15 . S TIUSTAT=+$P(TIU0,U,5)
16 . S TIUTYPE=$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
17 . S TIUEVNT=$S(+TIUSTAT'>5:"SIGNATURE",1:"COSIGNATURE")
18 . S ASK=$$CANDO^TIULP(TIUDA,TIUEVNT)
19 . I +ASK>0 D
20 . . L +^TIU(8925,+TIUDA):1
21 . . E S ASK="0^ Another user is editing this entry."
22 . I +ASK'>0,$P(ASK,U,2)]"" D I 1
23 . . D FULL^VALM1
24 . . W !!,"Item #: ",NMBR,!,$P(ASK,U,2),!
25 . . W !,"Removed from signature list.",!
26 . . I $$READ^TIUU("FOA","Press RETURN to continue...")
27 . E D
28 . . I $S(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,DUZ):1,+$P(TIU15,U,6):1,1:0),(+$P(TIU12,U,8)'>0) D Q:+$G(TIUPOP)
29 . . . N COSIGNER
30 . . . W !!,"Item #",NMBR,": ",TIUTYPE," for "
31 . . . W $$PTNAME^TIULC1($P(TIU0,U,2))," will need cosignature..."
32 . . . S COSIGNER=$$ASKCSNR^TIURS(TIUDA,DUZ)
33 . . . I +COSIGNER'>0 D
34 . . . . S TIUPOP=1
35 . . . . W !!,"Item #",NMBR,": MUST have a cosigner, before you may sign."
36 . . . . W !!,"Removed from signature list.",!
37 . . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
38 . . N TIU,TIUY
39 . . D EN^VALM("ORC TIU SIGN/COSIGN")
40 I +$G(ORPICK)'>0 D G ELSIGX
41 . S VALMSG="** Signature List Empty...Nothing signed. **"
42 I +$G(ORPICK)>0 D
43 . S TIUES=$$ASKSIG^TIULA1
44 . I '+TIUES S VALMSG="** Nothing Signed. **" Q
45 . F ORI=1:1:$L(ORPICK,",") S NMBR=$P(ORPICK,",",ORI) D:NMBR Q:$D(ORQUIT)
46 . . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),TIUDA=+IDX
47 . . D ES^TIURS(TIUDA,TIUES,NMBR)
48 I $G(ORPICK)']"" S VALMSG="** Nothing Signed. **"
49 E S VALMSG="** Item"_$S($L(ORPICK,",")>1:"s ",1:" ")_ORPICK_" Signed. **"
50ELSIGX K VALMY S VALMBCK="R"
51 Q
52ACCEPT(ORPICK,NMBR) ; Adds item(s) to signature list
53 D FULL^VALM1
54 S ORPICK=$G(ORPICK)_$S($L(ORPICK):",",1:"")_NMBR,OREBUILD=1
55 W !,"Item #",NMBR," added to the signature list." H 3
56 Q
57SIGN ; -- sign notes
58 N ORI,NMBR,ORQUIT,IDX,TIUDA S VALMBCK=""
59 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("sign") Q:'ORNMBR
60 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
61 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
62 . S TIUDA=+IDX Q:'+TIUDA
63 . D EDSIG^TIURS(TIUDA,"",1)
64 Q
65 ;
66ADDENDUM ; -- make addendum
67 N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
68 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
69 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
70 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
71 . S TIUDA=+IDX Q:'+TIUDA
72 . I +$$ISADDNDM^TIULC1(TIUDA) D Q
73 . . W !,$C(7),"You may not make addenda to addenda."
74 . . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
75 . D CLEAR^VALM1,ADDEND1^TIURA1 I +$G(TIUCHNG) S OREBUILD=1
76 . I '+$G(TIUCHNG) S VALMBCK="R"
77 Q
78 ;
79EDIT ; -- edit notes
80 N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
81 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("edit") Q:'ORNMBR
82 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
83 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
84 . S TIUDA=+IDX Q:'+TIUDA
85 . D CLEAR^VALM1,EDIT1^TIURA I +$G(TIUCHNG) S OREBUILD=1
86 S VALMBCK="R"
87 Q
88COPY ; -- copy notes
89 N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,ORTAB S VALMBCK=""
90 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("copy") Q:'ORNMBR
91 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
92 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
93 . S TIUDA=+IDX Q:'+TIUDA
94 . D COPY1^TIURC I +$G(TIUCHNG) S OREBUILD=1
95 . I '+$G(TIUCHNG) S VALMBCK="R"
96 Q
97DELETE ; -- delete notes
98 N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
99 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("delete") Q:'ORNMBR
100 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
101 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
102 . S TIUDA=+IDX Q:'+TIUDA
103 . D DEL^TIURB(TIUDA) I +$G(TIUCHNG) S OREBUILD=1
104 Q
105SIGNERS ; -- Identify additional signers
106 N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG S VALMBCK=""
107 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
108 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
109 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
110 . S TIUDA=+IDX Q:'+TIUDA
111 . D FULL^VALM1,SIGNER^TIURA1
112 S VALMBCK="R"
113 Q
114PRINT ; Print selected documents
115 N DFN,TIUDA,TIUDPRM,TIUDARR,TIUDATA,TIUI,DIROUT,TIUDE,POP,TIUPFLG
116 N TIUSPG,TIUDEV
117 S VALMBCK="" I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("print") Q:'ORNMBR
118 D CLEAR^VALM1
119 I +$$CHARTANY(ORNMBR) S TIUPFLG=$$FLAG^TIUPRPN3
120 S TIUSPG=1
121 S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
122 I $S(IO']"":1,TIUDEV']"":1,1:0) G PRINTX
123 I $D(IO("Q")) D QUE^TIUDEV("PRINTN^ORCNOTE",TIUDEV) G PRINTX
124 D PRINTN
125PRINTX N IOSTBM D ^%ZISC,FIXLST^TIULM
126 K VALMY S VALMBCK="R"
127 Q
128CHARTANY(ORNMBR) ; Evaluate selected documents for chart print
129 N ORI,NMBR,ORSLT S ORSLT=0
130 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) Q:+NMBR'>0!+ORSLT D
131 . N IDX,TIUDA
132 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
133 . S TIUDA=+IDX Q:'TIUDA
134 . S ORSLT=+$$CHARTONE^TIURA1(TIUDA)
135 Q ORSLT
136PRINTN ; Loop through selected doc's & invoke print code as appropriate
137 N TIUI,TIUTYP,ORINDX,ORY,DFN K ^TMP("TIUPR",$J)
138 N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG
139 U IO
140 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)!$D(DIROUT)
141 . N TIUPMTHD,TIUTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUDTYP,TIUFLAG
142 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
143 . S TIUDA=+IDX Q:'+TIUDA Q:'$D(^TIU(8925,TIUDA,0))
144 . S TIUTYP=$P($G(^TIU(8925,TIUDA,0)),U)
145 . ; Evaluate whether user can print record
146 . S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
147 . I +TIUPRINT'>0 D Q ; Exclude records user can't print
148 . . W !!,"Item #",ORI,": ",!,$P(TIUPRINT,U,2),!
149 . . I IO=IO(0),'$D(ZTQUEUED),$$READ^TIUU("EA","RETURN to continue...")
150 . I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
151 . S DFN=$P($G(^TIU(8925,+TIUDA,0)),U,2)
152 . I +TIUTYP D
153 . . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
154 . . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
155 . . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
156 . . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
157 . I +$$ISADDNDM^TIULC1(TIUDA) D
158 . . S TIUDA=+$P($G(^TIU(8925,TIUDA,0)),U,6)
159 . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
160 . I +$G(^TIU(8925,TIUDA,21))>0 D
161 . . S TIUDA=+$G(^TIU(8925,TIUDA,21))
162 . . S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
163 . Q:+$D(ORINDX(TIUDA))
164 . I +$G(TIUDTYP)>0 D
165 . . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUDTYP)
166 . . S TIUPGRP=$$PRNTGRP^TIULG(+TIUDTYP)
167 . . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUDTYP)
168 . . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUDTYP)
169 . I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S ORY(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,ORI,TIUDA)=TIUPFNBR
170 . E S ORY(TIUPMTHD,DFN,ORI,TIUDA)=""
171 . S ORINDX(TIUDA)=ORI
172 S TIUPMTHD="" F S TIUPMTHD=$O(ORY(TIUPMTHD)) Q:TIUPMTHD="" D
173 . D PRNTDOC^TIURA(TIUPMTHD,.ORY)
174 Q
175BROWSE ; -- browse document
176 N ORI,NMBR,ORQUIT,IDX,TIUDA,TIUCHNG,TIUQUIT S VALMBCK=""
177 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("browse") Q:'ORNMBR
178 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
179 . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR))
180 . S TIUDA=+IDX Q:'+TIUDA
181 . D CLEAR^VALM1,BROWS1^TIURA("TIU BROWSE FOR CLINICIAN")
182 . S VALMBCK="R" S:+$G(TIUCHNG) OREBUILD=1
183 . I +$G(TIUQUIT) S ORQUIT=1
184 Q
185 ;
186EX ; -- exit action
187 D:$G(OREBUILD) TAB^ORCHART(ORTAB,1)
188 S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
189 Q
Note: See TracBrowser for help on using the repository browser.