| 1 | TIURC ; 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
 | 
|---|
| 3 | VERIFY ; 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
 | 
|---|
| 27 | VERIFY1 ; 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
 | 
|---|
| 63 | ADD ; 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
 | 
|---|
| 98 | ADDX D UPRBLD^TIURL(.TIUCHNG,.VALMY)
 | 
|---|
| 99 |  Q
 | 
|---|
| 100 | COPY1 ; -- Call to COPY1 for backward compatibility
 | 
|---|
| 101 |  G COPY1^TIURC1
 | 
|---|
| 102 |  Q
 | 
|---|