TIURA1 ; SLC/JER - Review screen actions ;3/5/01
;;1.0;TEXT INTEGRATION UTILITIES;**20,88,58,100**;Jun 20, 1997
;IHS/ITSC/LJF 08/22/2003 bypass VA rebuild if called by BTIURPT
;
ADDEND ; Make addenda
N TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIULST,TIUDAARY
S TIUI=0
; -- Get docmt to addend: --
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. D CLEAR^VALM1 W !!,"Making an addendum for #",+TIUDATA
. ; -- Addend it: --
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S TIUCHNG=0
. I +$D(^TIU(8925,+TIUDA,0)) D ADDEND1
. 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 ; user may have edited existing addm
;D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY ;IHS/ITSC/LJF 08/22/2003
D:'$G(BTIURPT) UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY ;IHS/ITSC/LJF 08/22/2003 don't rebuild if called by BTIURPT
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"addended")
Q
ADDEND1 ; Single record Addendum
; Receives TIUDA
N %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
N TIUTYP,TIUT0,TIUDPRM
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
I '+$G(TIUDA) W !,"No Documents selected." H 2 Q
D ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG,1)
Q
NAME ; Identify signer(s)
N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
N TIUDAARY
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
I +$O(VALMY(0)) D FULL^VALM1
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIU,VALMY,XQORM,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...",! ; Echo denial message
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S TIUCHNG=0
. D SIGNER ; SIGNER initializes TIUCHNG to 0
. I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
NAMEX ; Revise list and cycle back as appropriate
S TIUCHNG("REFRESH")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"Signers identified/edited")
Q
SIGNER ; Link selected document to additional signers
; Receives TIUDA as pointer to document record
N TIULIST,TIUI,TIUMORE,TIUCANID S (TIUCHNG,TIUI)=0,TIUMORE=1
S TIUCANID=$$CANDO^TIULP(TIUDA,"IDENTIFY SIGNERS")
I +$$MAYCHNG(TIUDA) D Q:'TIUMORE
. N TIUPRMT S TIUPRMT="Do you Wish to Identify Additional Signers"
. D CHNGCSNR(TIUDA) S TIUCHNG=1
. I +$G(TIUCANID) S TIUMORE=$$READ^TIUU("YO",TIUPRMT,"NO")
. I +$G(TIUCANID)'>0 S TIUMORE=0
I +$G(TIUCANID)'>0 D Q
. W !!,$C(7),$P(TIUCANID,U,2),! ; Echo denial message
. I $$READ^TIUU("EA","RETURN to continue...") ; pause
I +$O(^TIU(8925.7,"B",TIUDA,0)) D Q:+TIUMORE'>0
. N DIDEL,DIE,DA,DR,TIUY,TIUPRMT
. W !,"This Document Already has Additional Expected Signers."
. D XTRASIGN^TIULX(.TIUY,TIUDA) Q:+$O(TIUY(0))'>0
. S DA=+$$ASKSIGN^TIULX(.TIUY) Q:+DA'>0
. S (DIE,DIDEL)=8925.7,DR=".03;I +X>0 S Y=""@1"";.01///@;@1" D ^DIE
. D SEND^TIUALRT(TIUDA) S TIUCHNG=1
. S TIUPRMT="Do You Wish to Identify More Additional Signers"
. S TIUMORE=$$READ^TIUU("Y",TIUPRMT,"NO")
D PERSEL(.TIULIST,TIUDA) Q:+$D(TIULIST)'>9
F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0 D
. N DA,DIC,DIE,DLAYGO,DR,X,Y
. S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.7,DIC(0)="LX" D ^DIC Q:+Y'>0
. S DIE=DIC
. S DR=".02////"_0_";.03////"_+$G(TIULIST(TIUI))
. D ^DIE
. W !,$$SIGNAME^TIULS(+TIULIST(TIUI))," Added as expected signer..." H 2
. D SEND^TIUALRT(TIUDA)
. S TIUCHNG=1 K VALMY(TIUI)
Q
MAYCHNG(TIUDA) ; Boolean function - can cosigner be modified?
N TIUD0,TIUD12,TIUY,TIUAUTH,TIUESNR,TIUECSNR S TIUY=0
S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
S TIUAUTH=$P(TIUD12,U,2),TIUESNR=$P(TIUD12,U,4),TIUECSNR=$P(TIUD12,U,8)
I +TIUECSNR,(+$P(TIUD0,U,5)<7) D
. S TIUY=$S(DUZ=TIUAUTH:1,DUZ=TIUESNR:1,DUZ=TIUECSNR:1,1:0)
Q TIUY
CHNGCSNR(DA) ; Change the expected cosigner
N DR,DIE,X,Y
W !,"You may change the expected cosigner, if you wish...",!
CHNGAGN S DIE=8925,DR="1208R" D ^DIE
I +$P($G(^TIU(8925,DA,12)),U,8)'>0 W !,$C(7)," Response Required." G CHNGAGN
D SEND^TIUALRT(DA)
Q
PERSEL(TIUY,TIUDA) ; Select a person
N TIUQUIT,TIUPRSN,TIUI,TIUPRMT,TIUSCRN S (TIUI,TIUQUIT)=0
W !!,"Specify other practitioners whose signatures will be expected:",!
F D Q:+TIUQUIT
. S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") "
. S TIUSCRN="I +$$SCREEN^TIURA1(TIUDA,+Y)"
. S TIUPRSN=$$READ^TIUU("PAO^200:AEMQ",TIUPRMT,"","",TIUSCRN)
. I +TIUPRSN'>0 S TIUQUIT=1 Q
. S TIUY(TIUI)=TIUPRSN
W !
Q
SCREEN(TIUDA,Y) ; Evaluate whether a person may be selected as a signer
N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected
S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
; A user may NOT select himself
I Y=+$G(DUZ) S TIUY=0 G SCREENX
; Author may NOT be selected
I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX
; Expected Signer may NOT be selected
I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX
; Can't choose a terminated user
I '+$$ACTIVE^XUSER(+Y) S TIUY=0 G SCREENX
; Can't name the same signer twice
I +$O(^TIU(8925.7,"AE",+TIUDA,+Y,0)) S TIUY=0 G SCREENX
S TIUI=0
F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0!(TIUY=0) D
. I +$G(TIULIST(TIUI))=+Y S TIUY=0
I +TIUY=0 G SCREENX
; Expected Cosigner may NOT be selected
I Y=+$P(TIUD12,U,8) S TIUY=0
SCREENX Q +$G(TIUY)
ENCNTR ; Enter/edit encounter data on demand
N TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUI,TIUY,TIULST,Y,DIROUT
N TIUDAARY
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
I +$O(VALMY(0)) D FULL^VALM1
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIU,VALMY,XQORM,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...",! ; Echo denial message
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. S TIUDAARY(TIUI)=TIUDA
. S TIUCHNG=0
. D EDTENC^TIUPXAP2(TIUDA,.TIUCHNG)
. I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
ENCNTX ; Revise list and cycle back as appropriate
S TIUCHNG("REFRESH")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
D VMSG^TIURS1($G(TIULST),.TIUDAARY,"Encounter Data Edited")
Q
CHARTANY(VALMY) ; Can any of the selected items be printed for the chart?
N TIUDATA,TIUDA,TIUI,TIUY S (TIUI,TIUY)=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:+TIUY
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2)
. S TIUY=+$$CHARTONE(TIUDA)
Q TIUY
CHARTONE(TIUDA) ; Can this document be printed for the chart?
N TIUDTYP,TIUDPRM
S TIUDTYP=+$G(^TIU(8925,TIUDA,0))
D DOCPRM^TIULC1(TIUDTYP,.TIUDPRM,TIUDA)
Q +$P(TIUDPRM(0),U,9)
TIURA1 ; SLC/JER - Review screen actions ;3/5/01
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**20,88,58,100**;Jun 20, 1997
+2 ;IHS/ITSC/LJF 08/22/2003 bypass VA rebuild if called by BTIURPT
+3 ;
ADDEND ; Make addenda
+1 NEW TIUDA,TIUDATA,TIUCHNG,TIUI,DIROUT,TIULST,TIUDAARY
+2 SET TIUI=0
+3 ; -- Get docmt to addend: --
+4 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+5 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW RSTRCTD
+7 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+8 DO CLEAR^VALM1
WRITE !!,"Making an addendum for #",+TIUDATA
+9 ; -- Addend it: --
+10 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+11 IF RSTRCTD
Begin DoDot:2
+12 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+13 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+14 SET TIUDAARY(TIUI)=TIUDA
+15 SET TIUCHNG=0
+16 IF +$DATA(^TIU(8925,+TIUDA,0))
DO ADDEND1
+17 IF +$GET(TIUCHNG)
Begin DoDot:2
+18 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:2
End DoDot:1
IF $DATA(DIROUT)
QUIT
+19 ; -- Update or Rebuild list, restore video:
+20 IF $GET(TIUCHNG("ADDM"))!$GET(TIUCHNG("DELETE"))
SET TIUCHNG("RBLD")=1
+21 ; user may have edited existing addm
IF '$TEST
SET TIUCHNG("UPDATE")=1
+22 ;D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY ;IHS/ITSC/LJF 08/22/2003
+23 ;IHS/ITSC/LJF 08/22/2003 don't rebuild if called by BTIURPT
IF '$GET(BTIURPT)
DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+24 SET VALMBCK="R"
+25 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"addended")
+26 QUIT
ADDEND1 ; Single record Addendum
+1 ; Receives TIUDA
+2 NEW %X,%Y,C,D,D0,DDWTMP,DFN,DI,DIC,TIUEDIT,TIUMSG,TIUQUIT,TIUADD,TIUREL
+3 NEW TIUTYP,TIUT0,TIUDPRM
+4 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+5 IF '+$GET(TIUDA)
WRITE !,"No Documents selected."
HANG 2
QUIT
+6 DO ADDENDUM^TIUADD(TIUDA,"",.TIUCHNG,1)
+7 QUIT
NAME ; Identify signer(s)
+1 NEW TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUEDIT,TIUI,TIUY,TIULST,Y,DIROUT
+2 NEW TIUDAARY
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET TIUI=0
+5 IF +$ORDER(VALMY(0))
DO FULL^VALM1
+6 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+7 NEW TIU,VALMY,XQORM,RSTRCTD
+8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+9 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+10 IF RSTRCTD
Begin DoDot:2
+11 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+12 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+13 SET TIUDAARY(TIUI)=TIUDA
+14 SET TIUCHNG=0
+15 ; SIGNER initializes TIUCHNG to 0
DO SIGNER
+16 IF +$GET(TIUCHNG)
SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:1
IF $DATA(DIROUT)
QUIT
NAMEX ; Revise list and cycle back as appropriate
+1 SET TIUCHNG("REFRESH")=1
+2 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+3 SET VALMBCK="R"
+4 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"Signers identified/edited")
+5 QUIT
SIGNER ; Link selected document to additional signers
+1 ; Receives TIUDA as pointer to document record
+2 NEW TIULIST,TIUI,TIUMORE,TIUCANID
SET (TIUCHNG,TIUI)=0
SET TIUMORE=1
+3 SET TIUCANID=$$CANDO^TIULP(TIUDA,"IDENTIFY SIGNERS")
+4 IF +$$MAYCHNG(TIUDA)
Begin DoDot:1
+5 NEW TIUPRMT
SET TIUPRMT="Do you Wish to Identify Additional Signers"
+6 DO CHNGCSNR(TIUDA)
SET TIUCHNG=1
+7 IF +$GET(TIUCANID)
SET TIUMORE=$$READ^TIUU("YO",TIUPRMT,"NO")
+8 IF +$GET(TIUCANID)'>0
SET TIUMORE=0
End DoDot:1
IF 'TIUMORE
QUIT
+9 IF +$GET(TIUCANID)'>0
Begin DoDot:1
+10 ; Echo denial message
WRITE !!,$CHAR(7),$PIECE(TIUCANID,U,2),!
+11 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:1
QUIT
+12 IF +$ORDER(^TIU(8925.7,"B",TIUDA,0))
Begin DoDot:1
+13 NEW DIDEL,DIE,DA,DR,TIUY,TIUPRMT
+14 WRITE !,"This Document Already has Additional Expected Signers."
+15 DO XTRASIGN^TIULX(.TIUY,TIUDA)
IF +$ORDER(TIUY(0))'>0
QUIT
+16 SET DA=+$$ASKSIGN^TIULX(.TIUY)
IF +DA'>0
QUIT
+17 SET (DIE,DIDEL)=8925.7
SET DR=".03;I +X>0 S Y=""@1"";.01///@;@1"
DO ^DIE
+18 DO SEND^TIUALRT(TIUDA)
SET TIUCHNG=1
+19 SET TIUPRMT="Do You Wish to Identify More Additional Signers"
+20 SET TIUMORE=$$READ^TIUU("Y",TIUPRMT,"NO")
End DoDot:1
IF +TIUMORE'>0
QUIT
+21 DO PERSEL(.TIULIST,TIUDA)
IF +$DATA(TIULIST)'>9
QUIT
+22 FOR
SET TIUI=$ORDER(TIULIST(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+23 NEW DA,DIC,DIE,DLAYGO,DR,X,Y
+24 SET X=""""_"`"_TIUDA_""""
SET (DIC,DLAYGO)=8925.7
SET DIC(0)="LX"
DO ^DIC
IF +Y'>0
QUIT
+25 SET DIE=DIC
+26 SET DR=".02////"_0_";.03////"_+$GET(TIULIST(TIUI))
+27 DO ^DIE
+28 WRITE !,$$SIGNAME^TIULS(+TIULIST(TIUI))," Added as expected signer..."
HANG 2
+29 DO SEND^TIUALRT(TIUDA)
+30 SET TIUCHNG=1
KILL VALMY(TIUI)
End DoDot:1
+31 QUIT
MAYCHNG(TIUDA) ; Boolean function - can cosigner be modified?
+1 NEW TIUD0,TIUD12,TIUY,TIUAUTH,TIUESNR,TIUECSNR
SET TIUY=0
+2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
+3 SET TIUAUTH=$PIECE(TIUD12,U,2)
SET TIUESNR=$PIECE(TIUD12,U,4)
SET TIUECSNR=$PIECE(TIUD12,U,8)
+4 IF +TIUECSNR
IF (+$PIECE(TIUD0,U,5)<7)
Begin DoDot:1
+5 SET TIUY=$SELECT(DUZ=TIUAUTH:1,DUZ=TIUESNR:1,DUZ=TIUECSNR:1,1:0)
End DoDot:1
+6 QUIT TIUY
CHNGCSNR(DA) ; Change the expected cosigner
+1 NEW DR,DIE,X,Y
+2 WRITE !,"You may change the expected cosigner, if you wish...",!
CHNGAGN SET DIE=8925
SET DR="1208R"
DO ^DIE
+1 IF +$PIECE($GET(^TIU(8925,DA,12)),U,8)'>0
WRITE !,$CHAR(7)," Response Required."
GOTO CHNGAGN
+2 DO SEND^TIUALRT(DA)
+3 QUIT
PERSEL(TIUY,TIUDA) ; Select a person
+1 NEW TIUQUIT,TIUPRSN,TIUI,TIUPRMT,TIUSCRN
SET (TIUI,TIUQUIT)=0
+2 WRITE !!,"Specify other practitioners whose signatures will be expected:",!
+3 FOR
Begin DoDot:1
+4 SET TIUI=TIUI+1
SET TIUPRMT=$JUSTIFY(TIUI,3)_") "
+5 SET TIUSCRN="I +$$SCREEN^TIURA1(TIUDA,+Y)"
+6 SET TIUPRSN=$$READ^TIUU("PAO^200:AEMQ",TIUPRMT,"","",TIUSCRN)
+7 IF +TIUPRSN'>0
SET TIUQUIT=1
QUIT
+8 SET TIUY(TIUI)=TIUPRSN
End DoDot:1
IF +TIUQUIT
QUIT
+9 WRITE !
+10 QUIT
SCREEN(TIUDA,Y) ; Evaluate whether a person may be selected as a signer
+1 ; most people may be selected
NEW TIUI,TIUY,TIUD0,TIUD12
SET TIUY=1
+2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
+3 ; A user may NOT select himself
+4 IF Y=+$GET(DUZ)
SET TIUY=0
GOTO SCREENX
+5 ; Author may NOT be selected
+6 IF Y=+$PIECE(TIUD12,U,2)
SET TIUY=0
GOTO SCREENX
+7 ; Expected Signer may NOT be selected
+8 IF Y=+$PIECE(TIUD12,U,4)
SET TIUY=0
GOTO SCREENX
+9 ; Can't choose a terminated user
+10 IF '+$$ACTIVE^XUSER(+Y)
SET TIUY=0
GOTO SCREENX
+11 ; Can't name the same signer twice
+12 IF +$ORDER(^TIU(8925.7,"AE",+TIUDA,+Y,0))
SET TIUY=0
GOTO SCREENX
+13 SET TIUI=0
+14 FOR
SET TIUI=$ORDER(TIULIST(TIUI))
IF +TIUI'>0!(TIUY=0)
QUIT
Begin DoDot:1
+15 IF +$GET(TIULIST(TIUI))=+Y
SET TIUY=0
End DoDot:1
+16 IF +TIUY=0
GOTO SCREENX
+17 ; Expected Cosigner may NOT be selected
+18 IF Y=+$PIECE(TIUD12,U,8)
SET TIUY=0
SCREENX QUIT +$GET(TIUY)
ENCNTR ; Enter/edit encounter data on demand
+1 NEW TIUCHNG,TIUDA,DFN,TIU,TIUDATA,TIUI,TIUY,TIULST,Y,DIROUT
+2 NEW TIUDAARY
+3 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+4 SET TIUI=0
+5 IF +$ORDER(VALMY(0))
DO FULL^VALM1
+6 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+7 NEW TIU,VALMY,XQORM,RSTRCTD
+8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+9 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+10 IF RSTRCTD
Begin DoDot:2
+11 ; Echo denial message
WRITE !!,$CHAR(7),"Ok, no harm done...",!
+12 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+13 SET TIUDAARY(TIUI)=TIUDA
+14 SET TIUCHNG=0
+15 DO EDTENC^TIUPXAP2(TIUDA,.TIUCHNG)
+16 IF +$GET(TIUCHNG)
SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":",",1:"")_TIUI
End DoDot:1
IF $DATA(DIROUT)
QUIT
ENCNTX ; Revise list and cycle back as appropriate
+1 SET TIUCHNG("REFRESH")=1
+2 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+3 SET VALMBCK="R"
+4 DO VMSG^TIURS1($GET(TIULST),.TIUDAARY,"Encounter Data Edited")
+5 QUIT
CHARTANY(VALMY) ; Can any of the selected items be printed for the chart?
+1 NEW TIUDATA,TIUDA,TIUI,TIUY
SET (TIUI,TIUY)=0
+2 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+3 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+4 SET TIUDA=+$PIECE(TIUDATA,U,2)
+5 SET TIUY=+$$CHARTONE(TIUDA)
End DoDot:1
IF +TIUY
QUIT
+6 QUIT TIUY
CHARTONE(TIUDA) ; Can this document be printed for the chart?
+1 NEW TIUDTYP,TIUDPRM
+2 SET TIUDTYP=+$GET(^TIU(8925,TIUDA,0))
+3 DO DOCPRM^TIULC1(TIUDTYP,.TIUDPRM,TIUDA)
+4 QUIT +$PIECE(TIUDPRM(0),U,9)
