TIURC ; SLC/JER - Additional Review screen actions ;02/25/10 08:52
;;1.0;TEXT INTEGRATION UTILITIES;**1,4,36,48,67,79,58,100,182,232,250**;Jun 20, 1997;Build 14
;
; ICR #10018 - ^DIE Routine & DIE, DA, DR, DTOUT, & DUOUT Local Vars
; #10117 - EN^VALM, CLEAR^VALM1, & FULL^VALM1 Routines & VALM("ENTITY"),
; VALMBCK, VALMY, & VALMY( Local Vars
; #10119 - EN^VALM2 Routine & XQORNOD(0) Local Var
;
VERIFY ; Verify Documents
N TIUCHNG,TIUDATA,TIUI,TIUY,Y,DIROUT,TIULST,TIUDAARY
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIU,TIUDATA,TIUDA,RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S TIUCHNG=0
. D EN^VALM("TIU VERIFY")
. K ^TMP("TIUVIEW",$J)
. I +$G(TIUCHNG) D
. . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
; -- Update or Rebuild list, restore video:
I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
E S TIUCHNG("UPDATE")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"verified/unverified")
Q
VERIFY1 ; Single record verify
; Receives TIUDA
N DA,DIE,DR,TIUTYP,TIUQUIT,TIUT0,TIUTNM,TIUVERX
S TIUTYP=+$G(^TIU(8925,+TIUDA,0)),TIUT0=$G(^TIU(8925.1,+TIUTYP,0))
S TIUTNM=$$PNAME^TIULC1(+TIUTYP)
S TIUTYP(1)="1^"_+TIUTYP_U_TIUTNM_U
I $$DADORKID^TIUGBR(TIUDA) D Q
. W !!,$C(7),"This ",TIUTNM," is an interdisciplinary entry.",!,"ID entries must be verified prior to attaching.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
I +$P($G(^TIU(8925,+TIUDA,15)),U)!+$P($G(^(15)),U,7) D Q
. W !!,$C(7),"This ",TIUTNM," is already signed.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
; -- Can't verify admin closed docmts (P182):
I +$P($G(^TIU(8925,+TIUDA,16)),U,6) D Q
. W !!,$C(7),"This ",TIUTNM," is already closed.",!
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
I +$P($G(^TIU(8925,+TIUDA,13)),U,5) D Q
. W !!,"This ",TIUTNM," is already verified."
. S TIUY=$$READ^TIUU("YO","Do you want to UNVERIFY this "_TIUTNM,"NO","^D UNVER^TIUDIRH")
. I TIUY W !,TIUTNM," UNVERIFIED" D
. . S DA=TIUDA,DIE=8925,DR=".05///UNVERIFIED;1305///@;1306///@" D ^DIE
. . W "." S TIUCHNG=1
. . D ALERTDEL^TIUALRT(TIUDA)
N DUOUT,DIROUT,DTOUT
S TIUY=$$READ^TIUU("YO","Do you want to edit this "_TIUTNM,"NO")
I +TIUY D
. ;VMP/ELR ADDED NEXT 2 LINES TO PROHIBIT EDIT OF SURGERY WHILE VERIFYING
. NEW TIUMSG S TIUMSG=$$CANDO^TIULP(TIUDA,"EDIT RECORD") I +TIUMSG'>0 D Q
. . W !!,$C(7),$P(TIUMSG,U,2),!
. D GETTIU^TIULD(.TIU,TIUDA),CLEAR^VALM1
. D DIE^TIUEDI4(TIUDA,.TIUQUIT) ; **100**
. I $S(+$G(TIUQUIT):1,$D(DUOUT):1,$D(DIROUT):1,$D(DTOUT):1,1:0) Q
. D RELEASE^TIUT(TIUDA)
I +TIUY'>0,$S(+$G(TIUQUIT):1,$D(DUOUT):1,$D(DIROUT):1,$D(DTOUT):1,1:0) Q
S TIUY=$$READ^TIUU("YO","VERIFY this "_TIUTNM,"NO","^D VER^TIUDIRH")
I 'TIUY W !,TIUTNM," NOT VERIFIED." Q
S DA=TIUDA,DIE=8925,DR=".05///UNSIGNED;1305////"_$$NOW^TIULC_";1306////"_$G(DUZ) D ^DIE
S TIUCHNG=1,TIUVERX=$$VERIFY^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
I TIUVERX]"" X TIUVERX
I +DA W !,TIUTNM," VERIFIED." D MAIN^TIUPD(DA,"V"),SEND^TIUALRT(DA)
Q
ADD ; Add Document
N TIUONCE,TIUNDA,TIUCLASS,TIUCREAT,TIUITEM,LINENO,VALMY,TIUCHNG,RSTRCTD
; OK to new TIUCHNG here, this is not used in browse.
S TIUONCE=1
S TIUCLASS=$S($G(VALM("ENTITY"))="Progress Note":3,$G(VALM("ENTITY"))="Discharge Summary":244,1:38)
D FULL^VALM1
I +$G(DFN) D Q:+$G(RSTRCTD)
. S RSTRCTD=$$PTRES^TIULRR(DFN)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
; -- MAIN^TIUEDIT looks like:
; MAIN(TIUCLASS,SUCCESS,DFN,TIUTITLE,EVNTFLAG,NOSAVE,
; TIUNDA,TIUSNGL,TIUCHNG)
; i.e. TIUTITLE,EVNTFLAG,NOSAVE,TIUSNGL are null
D MAIN^TIUEDIT(TIUCLASS,.TIUCREAT,+$G(DFN),"","","",.TIUNDA,"",.TIUCHNG)
I $G(TIUCHNG("DELETE"))!$G(TIUCHNG("ADDM"))!$G(TIUCHNG("EXIST"))!$G(TIUCHNG("AVAIL")) S TIUCHNG("RBLD")=1
I +$O(TIUNDA(0))'>0 S TIUCHNG("REFRESH")=1 G ADDX
; -- If in TIU OE/RR REVIEW PN, rebuild list and quit:
I $G(^TMP("TIUR",$J,"RTN"))="TIUROR" S TIUCHNG("RBLD")=1 G ADDX
; -- If in Review Notes by Patient (no review screen),
; or rebuilding, don't add elements to end of screen:
I '$D(^TMP("TIUR",$J,"RTN")) G ADDX
I $G(TIUCHNG("RBLD")) G ADDX
; -- If in an integrated docmts option, add one line
; to screen for each new docmt, refresh list, and quit:
S TIUNDA=0
F S TIUNDA=$O(TIUNDA(TIUNDA)) Q:+TIUNDA'>0 D
. S TIUITEM=+$G(^TMP("TIUR",$J,0))
. ; -- Don't add if editing existing docmt which is already in list:
. S LINENO=$O(^TMP("TIUR",$J,"IEN",TIUNDA,0))
. I LINENO D Q
. . S VALMY(LINENO)="",TIUCHNG("UPDATE")=1
. D ADDELMNT^TIUR2(TIUNDA,+TIUITEM,1)
S TIUCHNG("REFRESH")=1
ADDX D UPRBLD^TIURL(.TIUCHNG,.VALMY)
Q
COPY1 ; -- Call to COPY1 for backward compatibility
G COPY1^TIURC1
Q
TIURC ; SLC/JER - Additional Review screen actions ;02/25/10 08:52
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,4,36,48,67,79,58,100,182,232,250**;Jun 20, 1997;Build 14
+2 ;
+3 ; ICR #10018 - ^DIE Routine & DIE, DA, DR, DTOUT, & DUOUT Local Vars
+4 ; #10117 - EN^VALM, CLEAR^VALM1, & FULL^VALM1 Routines & VALM("ENTITY"),
+5 ; VALMBCK, VALMY, & VALMY( Local Vars
+6 ; #10119 - EN^VALM2 Routine & XQORNOD(0) Local Var
+7 ;
VERIFY ; Verify Documents
+1 NEW TIUCHNG,TIUDATA,TIUI,TIUY,Y,DIROUT,TIULST,TIUDAARY
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+3 SET TIUI=0
+4 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+5 NEW TIU,TIUDATA,TIUDA,RSTRCTD
+6 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+7 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+8 IF RSTRCTD
Begin DoDot:2
+9 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+10 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+11 SET TIUDAARY(TIUI)=TIUDA
+12 SET TIUCHNG=0
+13 DO EN^VALM("TIU VERIFY")
+14 KILL ^TMP("TIUVIEW",$JOB)
+15 IF +$GET(TIUCHNG)
Begin DoDot:2
+16 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:2
End DoDot:1
IF $DATA(DIROUT)
QUIT
+17 ; -- Update or Rebuild list, restore video:
+18 IF $GET(TIUCHNG("ADDM"))!$GET(TIUCHNG("DELETE"))
SET TIUCHNG("RBLD")=1
+19 IF '$TEST
SET TIUCHNG("UPDATE")=1
+20 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+21 SET VALMBCK="R"
+22 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"verified/unverified")
+23 QUIT
VERIFY1 ; Single record verify
+1 ; Receives TIUDA
+2 NEW DA,DIE,DR,TIUTYP,TIUQUIT,TIUT0,TIUTNM,TIUVERX
+3 SET TIUTYP=+$GET(^TIU(8925,+TIUDA,0))
SET TIUT0=$GET(^TIU(8925.1,+TIUTYP,0))
+4 SET TIUTNM=$$PNAME^TIULC1(+TIUTYP)
+5 SET TIUTYP(1)="1^"_+TIUTYP_U_TIUTNM_U
+6 IF $$DADORKID^TIUGBR(TIUDA)
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"This ",TIUTNM," is an interdisciplinary entry.",!,"ID entries must be verified prior to attaching.",!
+8 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+9 IF +$PIECE($GET(^TIU(8925,+TIUDA,15)),U)!+$PIECE($GET(^(15)),U,7)
Begin DoDot:1
+10 WRITE !!,$CHAR(7),"This ",TIUTNM," is already signed.",!
+11 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+12 ; -- Can't verify admin closed docmts (P182):
+13 IF +$PIECE($GET(^TIU(8925,+TIUDA,16)),U,6)
Begin DoDot:1
+14 WRITE !!,$CHAR(7),"This ",TIUTNM," is already closed.",!
+15 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+16 IF +$PIECE($GET(^TIU(8925,+TIUDA,13)),U,5)
Begin DoDot:1
+17 WRITE !!,"This ",TIUTNM," is already verified."
+18 SET TIUY=$$READ^TIUU("YO","Do you want to UNVERIFY this "_TIUTNM,"NO","^D UNVER^TIUDIRH")
+19 IF TIUY
WRITE !,TIUTNM," UNVERIFIED"
Begin DoDot:2
+20 SET DA=TIUDA
SET DIE=8925
SET DR=".05///UNVERIFIED;1305///@;1306///@"
DO ^DIE
+21 WRITE "."
SET TIUCHNG=1
+22 DO ALERTDEL^TIUALRT(TIUDA)
End DoDot:2
End DoDot:1
QUIT
+23 NEW DUOUT,DIROUT,DTOUT
+24 SET TIUY=$$READ^TIUU("YO","Do you want to edit this "_TIUTNM,"NO")
+25 IF +TIUY
Begin DoDot:1
+26 ;VMP/ELR ADDED NEXT 2 LINES TO PROHIBIT EDIT OF SURGERY WHILE VERIFYING
+27 NEW TIUMSG
SET TIUMSG=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
IF +TIUMSG'>0
Begin DoDot:2
+28 WRITE !!,$CHAR(7),$PIECE(TIUMSG,U,2),!
End DoDot:2
QUIT
+29 DO GETTIU^TIULD(.TIU,TIUDA)
DO CLEAR^VALM1
+30 ; **100**
DO DIE^TIUEDI4(TIUDA,.TIUQUIT)
+31 IF $SELECT(+$GET(TIUQUIT):1,$DATA(DUOUT):1,$DATA(DIROUT):1,$DATA(DTOUT):1,1:0)
QUIT
+32 DO RELEASE^TIUT(TIUDA)
End DoDot:1
+33 IF +TIUY'>0
IF $SELECT(+$GET(TIUQUIT):1,$DATA(DUOUT):1,$DATA(DIROUT):1,$DATA(DTOUT):1,1:0)
QUIT
+34 SET TIUY=$$READ^TIUU("YO","VERIFY this "_TIUTNM,"NO","^D VER^TIUDIRH")
+35 IF 'TIUY
WRITE !,TIUTNM," NOT VERIFIED."
QUIT
+36 SET DA=TIUDA
SET DIE=8925
SET DR=".05///UNSIGNED;1305////"_$$NOW^TIULC_";1306////"_$G(DUZ)
DO ^DIE
+37 SET TIUCHNG=1
SET TIUVERX=$$VERIFY^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+38 IF TIUVERX]""
XECUTE TIUVERX
+39 IF +DA
WRITE !,TIUTNM," VERIFIED."
DO MAIN^TIUPD(DA,"V")
DO SEND^TIUALRT(DA)
+40 QUIT
ADD ; Add Document
+1 NEW TIUONCE,TIUNDA,TIUCLASS,TIUCREAT,TIUITEM,LINENO,VALMY,TIUCHNG,RSTRCTD
+2 ; OK to new TIUCHNG here, this is not used in browse.
+3 SET TIUONCE=1
+4 SET TIUCLASS=$SELECT($GET(VALM("ENTITY"))="Progress Note":3,$GET(VALM("ENTITY"))="Discharge Summary":244,1:38)
+5 DO FULL^VALM1
+6 IF +$GET(DFN)
Begin DoDot:1
+7 SET RSTRCTD=$$PTRES^TIULRR(DFN)
+8 IF RSTRCTD
Begin DoDot:2
+9 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+10 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
End DoDot:1
IF +$GET(RSTRCTD)
QUIT
+11 ; -- MAIN^TIUEDIT looks like:
+12 ; MAIN(TIUCLASS,SUCCESS,DFN,TIUTITLE,EVNTFLAG,NOSAVE,
+13 ; TIUNDA,TIUSNGL,TIUCHNG)
+14 ; i.e. TIUTITLE,EVNTFLAG,NOSAVE,TIUSNGL are null
+15 DO MAIN^TIUEDIT(TIUCLASS,.TIUCREAT,+$GET(DFN),"","","",.TIUNDA,"",.TIUCHNG)
+16 IF $GET(TIUCHNG("DELETE"))!$GET(TIUCHNG("ADDM"))!$GET(TIUCHNG("EXIST"))!$GET(TIUCHNG("AVAIL"))
SET TIUCHNG("RBLD")=1
+17 IF +$ORDER(TIUNDA(0))'>0
SET TIUCHNG("REFRESH")=1
GOTO ADDX
+18 ; -- If in TIU OE/RR REVIEW PN, rebuild list and quit:
+19 IF $GET(^TMP("TIUR",$JOB,"RTN"))="TIUROR"
SET TIUCHNG("RBLD")=1
GOTO ADDX
+20 ; -- If in Review Notes by Patient (no review screen),
+21 ; or rebuilding, don't add elements to end of screen:
+22 IF '$DATA(^TMP("TIUR",$JOB,"RTN"))
GOTO ADDX
+23 IF $GET(TIUCHNG("RBLD"))
GOTO ADDX
+24 ; -- If in an integrated docmts option, add one line
+25 ; to screen for each new docmt, refresh list, and quit:
+26 SET TIUNDA=0
+27 FOR
SET TIUNDA=$ORDER(TIUNDA(TIUNDA))
IF +TIUNDA'>0
QUIT
Begin DoDot:1
+28 SET TIUITEM=+$GET(^TMP("TIUR",$JOB,0))
+29 ; -- Don't add if editing existing docmt which is already in list:
+30 SET LINENO=$ORDER(^TMP("TIUR",$JOB,"IEN",TIUNDA,0))
+31 IF LINENO
Begin DoDot:2
+32 SET VALMY(LINENO)=""
SET TIUCHNG("UPDATE")=1
End DoDot:2
QUIT
+33 DO ADDELMNT^TIUR2(TIUNDA,+TIUITEM,1)
End DoDot:1
+34 SET TIUCHNG("REFRESH")=1
ADDX DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
+1 QUIT
COPY1 ; -- Call to COPY1 for backward compatibility
+1 GOTO COPY1^TIURC1
+2 QUIT
