source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURC.m@ 1261

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1TIURC ; SLC/JER - Additional Review screen actions ;5/19/04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,4,36,48,67,79,58,100,182**;Jun 20, 1997
3VERIFY ; Verify Documents
4 N TIUCHNG,TIUDATA,TIUI,TIUY,Y,DIROUT,TIULST,TIUDAARY
5 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
6 S TIUI=0
7 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
8 . N TIU,TIUDATA,TIUDA,RSTRCTD
9 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
10 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
11 . I RSTRCTD D Q
12 . . W !!,$C(7),"Ok, no harm done...",!
13 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
14 . S TIUDAARY(TIUI)=TIUDA
15 . S TIUCHNG=0
16 . D EN^VALM("TIU VERIFY")
17 . K ^TMP("TIUVIEW",$J)
18 . I +$G(TIUCHNG) D
19 . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
20 ; -- Update or Rebuild list, restore video:
21 I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
22 E S TIUCHNG("UPDATE")=1
23 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
24 S VALMBCK="R"
25 D VMSG^TIURS1($G(TIULST),.TIUDAARY,"verified/unverified")
26 Q
27VERIFY1 ; Single record verify
28 ; Receives TIUDA
29 N DA,DIE,DR,TIUTYP,TIUQUIT,TIUT0,TIUTNM,TIUVERX
30 S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
31 S TIUTNM=$$PNAME^TIULC1(+TIUTYP)
32 S TIUTYP(1)="1^"_+TIUTYP_U_TIUTNM_U
33 I $$DADORKID^TIUGBR(TIUDA) D Q
34 . W !!,$C(7),"This ",TIUTNM," is an interdisciplinary entry.",!,"ID entries must be verified prior to attaching.",!
35 . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
36 I +$P($G(^TIU(8925,+TIUDA,15)),U)!+$P($G(^(15)),U,7) D Q
37 . W !!,$C(7),"This ",TIUTNM," is already signed.",!
38 . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
39 ; -- Can't verify admin closed docmts (P182):
40 I +$P($G(^TIU(8925,+TIUDA,16)),U,6) D Q
41 . W !!,$C(7),"This ",TIUTNM," is already closed.",!
42 . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
43 I +$P($G(^TIU(8925,+TIUDA,13)),U,5) D Q
44 . W !!,"This ",TIUTNM," is already verified."
45 . S TIUY=$$READ^TIUU("YO","Do you want to UNVERIFY this "_TIUTNM,"NO","^D UNVER^TIUDIRH")
46 . I TIUY W !,TIUTNM," UNVERIFIED" D
47 . . S DA=TIUDA,DIE=8925,DR=".05///UNVERIFIED;1305///@;1306///@" D ^DIE
48 . . W "." S TIUCHNG=1
49 . . D ALERTDEL^TIUALRT(TIUDA)
50 N DUOUT,DIROUT,DTOUT
51 S TIUY=$$READ^TIUU("YO","Do you want to edit this "_TIUTNM,"NO")
52 I +TIUY D
53 . D GETTIU^TIULD(.TIU,TIUDA),CLEAR^VALM1
54 . D DIE^TIUEDI4(TIUDA,.TIUQUIT) ; **100**
55 I +TIUY'>0,$S(+$G(TIUQUIT):1,$D(DUOUT):1,$D(DIROUT):1,$D(DTOUT):1,1:0) Q
56 S TIUY=$$READ^TIUU("YO","VERIFY this "_TIUTNM,"NO","^D VER^TIUDIRH")
57 I 'TIUY W !,TIUTNM," NOT VERIFIED." Q
58 S DA=TIUDA,DIE=8925,DR=".05///UNSIGNED;1305////"_$$NOW^TIULC_";1306////"_$G(DUZ) D ^DIE
59 S TIUCHNG=1,TIUVERX=$$VERIFY^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
60 I TIUVERX]"" X TIUVERX
61 I +DA W !,TIUTNM," VERIFIED." D MAIN^TIUPD(DA,"V"),SEND^TIUALRT(DA)
62 Q
63ADD ; Add Document
64 N TIUONCE,TIUNDA,TIUCLASS,TIUCREAT,TIUITEM,LINENO,VALMY,TIUCHNG,RSTRCTD
65 ; OK to new TIUCHNG here, this is not used in browse.
66 S TIUONCE=1
67 S TIUCLASS=$S($G(VALM("ENTITY"))="Progress Note":3,$G(VALM("ENTITY"))="Discharge Summary":244,1:38)
68 D FULL^VALM1
69 I +$G(DFN) D Q:+$G(RSTRCTD)
70 . S RSTRCTD=$$PTRES^TIULRR(DFN)
71 . I RSTRCTD D Q
72 . . W !!,$C(7),"Ok, no harm done...",!
73 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
74 ; -- MAIN^TIUEDIT looks like:
75 ; MAIN(TIUCLASS,SUCCESS,DFN,TIUTITLE,EVNTFLAG,NOSAVE,
76 ; TIUNDA,TIUSNGL,TIUCHNG)
77 ; i.e. TIUTITLE,EVNTFLAG,NOSAVE,TIUSNGL are null
78 D MAIN^TIUEDIT(TIUCLASS,.TIUCREAT,+$G(DFN),"","","",.TIUNDA,"",.TIUCHNG)
79 I $G(TIUCHNG("DELETE"))!$G(TIUCHNG("ADDM"))!$G(TIUCHNG("EXIST"))!$G(TIUCHNG("AVAIL")) S TIUCHNG("RBLD")=1
80 I +$O(TIUNDA(0))'>0 S TIUCHNG("REFRESH")=1 G ADDX
81 ; -- If in TIU OE/RR REVIEW PN, rebuild list and quit:
82 I $G(^TMP("TIUR",$J,"RTN"))="TIUROR" S TIUCHNG("RBLD")=1 G ADDX
83 ; -- If in Review Notes by Patient (no review screen),
84 ; or rebuilding, don't add elements to end of screen:
85 I '$D(^TMP("TIUR",$J,"RTN")) G ADDX
86 I $G(TIUCHNG("RBLD")) G ADDX
87 ; -- If in an integrated docmts option, add one line
88 ; to screen for each new docmt, refresh list, and quit:
89 S TIUNDA=0
90 F S TIUNDA=$O(TIUNDA(TIUNDA)) Q:+TIUNDA'>0 D
91 . S TIUITEM=+$G(^TMP("TIUR",$J,0))
92 . ; -- Don't add if editing existing docmt which is already in list:
93 . S LINENO=$O(^TMP("TIUR",$J,"IEN",TIUNDA,0))
94 . I LINENO D Q
95 . . S VALMY(LINENO)="",TIUCHNG("UPDATE")=1
96 . D ADDELMNT^TIUR2(TIUNDA,+TIUITEM,1)
97 S TIUCHNG("REFRESH")=1
98ADDX D UPRBLD^TIURL(.TIUCHNG,.VALMY)
99 Q
100COPY1 ; -- Call to COPY1 for backward compatibility
101 G COPY1^TIURC1
102 Q
Note: See TracBrowser for help on using the repository browser.