TIURS ; SLC/JER - Electronic signature actions ;28-Apr-2014 14:52;DU
;;1.0;TEXT INTEGRATION UTILITES;**3,4,20,67,79,98,107,58,100,109,179,1007,157,1010,227,274,1013**;Jun 20, 1997;Build 33
;Bypass PCE coding after signature
;02/25/2010 Mod returned after patches
ACCEPT(TIUSLST,TIUI) ; Accept for signing
N TIUSGN,TIUMSG,TIUPR,TIUFLAG
I +$G(TIUDA),($G(TIUEVNT)]"") D Q:'+$G(TIUSGN)
. S TIUSGN=$$CANDO^TIULP(TIUDA,TIUEVNT)
. I '+TIUSGN D
. . D FULL^VALM1
. . W !!,"Document has changed...",!,$P(TIUSGN,U,2)
. . W !!,"Item #",TIUI,": Removed from signature list.",!
. . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
S TIUSLST(TIUI)=""
W !,"Item #",TIUI,": Added to signature list." ;H 2
I +$P($G(TIUDPRM(0)),U,8) D
. S TIUMSG="Print this note"
. S TIUPR=$$READ^TIUU("Y",TIUMSG,"No")
. I +TIUPR S TIUSLST(TIUI)=1
I +$G(TIUPR),+$P($G(TIUDPRM(0)),U,9) D
. S TIUFLAG=$$FLAG^TIUPRPN3
. I +TIUFLAG S $P(TIUSLST(TIUI),U,2)=1
I +$G(XTRASGNR) S $P(TIUSLST(TIUI),U,3)=$G(XTRASGNR)
Q
EDSIG(TIUDA,TIUADD,TIUPASK) ; interactive sign
N TIU,TIU0,TIU12,ASK,X,X1,TIUTYPE,SIGNER,COSIGNER,TIUTYPE,TIUMSG,TIUSTAT
N TIUES,TIUACT,TIUDPRM,XTRASGNR,TIUCOM,TIU15,TIUCPFLD
I +$D(TIUSIGN),(TIUSIGN=0) Q
I '$D(TIUPRM0) D SETPARM^TIULE
I '+$P(TIUPRM0,U,2) S VALMBCK="R" Q
S TIUADD=1
S TIU0=$G(^TIU(8925,+TIUDA,0)),TIU12=$G(^(12)),TIU15=$G(^(15))
S SIGNER=$S(+$P(TIU12,U,4):$P(TIU12,U,4),1:$P(TIU12,U,2))
S COSIGNER=$P(TIU12,U,8)
I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
I '$G(XTRASGNR) S XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
S TIUSTAT=+$P(TIU0,U,5)
S TIUACT=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
S ASK=$$CANDO^TIULP(TIUDA,TIUACT)
S TIUTYPE=$$PNAME^TIULC1(+TIU0)
I +ASK'>0 D Q
. S VALMBCK="R"
. I +$$ISA^USRLM(+$G(DUZ),"MEDICAL INFORMATION SECTION"),(+$$ISPN^TIULX(+TIU0)'>0) Q
. I +$$ISA^USRLM(+$G(DUZ),"MAS TRANSCRIPTIONIST") Q
. I +$$ISA^USRLM(+$G(DUZ),"TRANSCRIPTIONIST") Q
. W !,$P(ASK,U,2)
. I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
W:$G(VALMAR)'="^TMP(""TIUVIEW"",$J)" !
;If document is a clinical procedures (CP) title, and
;(P179 for P182) this is not an additional signature,
;check if CP fields are required. If required, prompt for them
;and don't let user sign unless fields are defined. (P109)
I '$G(XTRASGNR),+$$ISA^TIULX(+TIU0,+$$CLASS^TIUCP),$$REQCPF^TIULP(+$P($G(^TIU(8925,+TIUDA,14)),U,5)) D Q:+TIUCPFLD'>0
. I $G(^TIU(8925,+TIUDA,702)),$P(^(702),U)]"",$P(^(702),U,2)]"" S TIUCPFLD=1 Q
. S TIUCPFLD=$$ASKCPF(TIUDA)
. I +TIUCPFLD'>0 D
. . W !!,"The Procedure Summary Code and Date/Time Performed MUST be entered before",!,"you may sign.",!
. . I $$READ^TIUU("EA","Press RETURN to continue...") ;pause
I $S(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,+SIGNER):1,+$P(TIU15,U,6):1,1:0),(+COSIGNER'>0) D Q:+COSIGNER'>0
. S COSIGNER=$$ASKCSNR(TIUDA,SIGNER)
. I +COSIGNER'>0 D
. . W !!,"This ",TIUTYPE," MUST have a cosigner before you may sign.",!
. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
I TIUSTAT=5,$G(DUZ)'=SIGNER D
. S TIUMSG="Author hasn't signed, are you SURE you want to sign "_TIUTYPE
W ! I $G(TIUMSG)]"",$$READ^TIUU("YO",TIUMSG,"NO","^D SIG^TIUDIRH")'>0 S VALMBCK="R" Q
L +^TIU(8925,+TIUDA):1
E W !?5,$C(7),"Another user is editing this entry.",! W:$$READ^TIUU("EA","Press RETURN to continue...") "" S TIUQUIT=2 Q
; TIU*1.0*274 DJH Do not allow notes without any text to be signed
I $$EMPTYDOC^TIULF(+TIUDA) W !?5,$C(7),"This note contains no text and cannot be signed.",! W:$$READ^TIUU("EA","Press RETURN to continue...") "" Q
S TIUES=$$ASKSIG^TIULA1 L -^TIU(8925,+TIUDA) I '+TIUES Q
I $D(VALMAR) D FULL^VALM1
I +$G(XTRASGNR) D ADDSIG^TIURS1(TIUDA,XTRASGNR)
I '+$G(XTRASGNR) D ES(TIUDA,TIUES)
I $G(TIUACT)="COSIGNATURE",(+$$ISADDNDM^TIULC1(TIUDA)'>0) D Q:+TIUCOM
. N TIUADDND S TIUCOM=0
. S TIUADDND=$$READ^TIUU("YO","Do you wish to add your comments in an addendum","NO")
. I +TIUADDND D ADD^TIUADD(TIUDA,.TIUCHNG) S TIUCOM=1
I '+$G(TIUPASK) Q
D DOCPRM^TIULC1(+TIU0,.TIUDPRM,TIUDA)
D ^%ZTER
I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(TIUDA)
Q
;
ASKCPF(DA) ;Ask required clinical procedure fields
N DR,DIE,TIUY
D FULL^VALM1
AGNCP W !!,$C(7),"You must designate the Procedure Summary Code and Date/Time Performed...",!
L +^TIU(8925,+DA):1
E W !?5,$C(7),"Another user is editing this entry.",! W:$$READ^TIUU("EA","Press RETURN to continue...") "" G ASKCPFQ
S DR="70201R;70202R"
S DIE="^TIU(8925," D ^DIE
ASKCPFQ L -^TIU(8925,+DA)
I $G(^TIU(8925,+DA,702)),$P(^(702),U)]"",$P(^(702),U,2)]"" S TIUY=1
Q +$G(TIUY)
;
ASKCSNR(DA,SIGNER) ; Ask cosigner
N DR,DIE,TIUY,TIUDCSNR,TIUPREF,TIUFLD
S TIUPREF=$$PERSPRF^TIULE(SIGNER)
S TIUDCSNR=$$PERSNAME^TIULC1($P(TIUPREF,U,9))
I TIUDCSNR="UNKNOWN" S TIUDCSNR=""
S TIUFLD=$S(+$$ISDS^TIULX(+$G(^TIU(8925,+DA,0))):"ATTENDING PHYSICIAN",1:"EXPECTED COSIGNER")
D FULL^VALM1
AGN W !!,$C(7),"You must designate an ",TIUFLD,"...",!
L +^TIU(8925,+DA):1
E W !?5,$C(7),"Another user is editing this entry.",! W:$$READ^TIUU("EA","Press RETURN to continue...") "" G ASKCOUT
I $E(TIUFLD)="A" S DR="1209R//^S X=TIUDCSNR;1208////^S X=$P(^TIU(8925,DA,12),U,9);1506////1"
E S DR="1208R//^S X=TIUDCSNR;1506////1"
S DIE="^TIU(8925," D ^DIE
ASKCOUT L -^TIU(8925,+DA)
S TIUY=+$P($G(^TIU(8925,+DA,12)),U,8)
Q TIUY
ES(DA,TIUES,TIUI) ; ^DIE call for /es/
N SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
N CSNEED,TIUTTL,TIUPSIG,TIUDPRM,DAO,TIUSTWAS,TIUSTIS,DAORIG,TIUCSPRM,TIUCSPM2
S TIUSTWAS=$P($G(^TIU(8925,DA,0)),U,5),TIUCSPRM=1,TIUCSPM2=0
D DOCPRM^TIULC1(+$G(^TIU(8925,+DA,0)),.TIUDPRM,DA)
S TIUSTAT=$P($G(^TIU(8925,+DA,0)),U,5),ESDT=$$NOW^TIULC
S SVCHIEF=+$$ISA^USRLM(DUZ,"CLINICAL SERVICE CHIEF")
S SIGNER=$P(^TIU(8925,+DA,12),U,4),COSIGNER=$P(^(12),U,8),CSREQ=0
S CSNEED=+$P($G(^TIU(8925,+DA,15)),U,6)
; VMP/RJT - PATCH 227 ALLOW THIRD PARTY ONE-TIME SIGNING FOR SIGNATURE AND COSIGNATURE
I +CSNEED,(DUZ=SIGNER),'+$G(SVCHIEF),(TIUSTAT'=6) S CSREQ=1
I +CSNEED,(DUZ'=SIGNER),(DUZ'=COSIGNER) D
. D THIRD I '+$G(SVCHIEF),(('+$G(TIUCSPRM))!(+$G(TIUCSPM2))),(TIUSTAT'=6) S CSREQ=1 Q
I TIUSTAT=5 D
. S DR=".05////"_$S(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+DUZ
. I '+$G(CSREQ),+CSNEED D
. . S DR=DR_";1506////0;1507////"_ESDT_";1508////"_+DUZ_";1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
I TIUSTAT=6 S DR=".05////7;1506////0;1507////"_ESDT_";1508////"_+DUZ
Q:'$D(DR)
S DIE=8925 D ^DIE W:'$D(XWBOS) "."
I TIUSTAT=5 S DR="1503///^S X=$P(TIUES,U,2);1504///^S X=$P(TIUES,U,3);1505////E"
I TIUSTAT=6 D
. N TIUSBY S DR="",TIUSBY=$P($G(^TIU(8925,+DA,15)),U,2)
. I +TIUSBY>0 S DR="1503///^S X=$$SIGNAME^TIULS("_TIUSBY_");1504///^S X=$$SIGTITL^TIULS("_TIUSBY_");"
. S DR=$G(DR)_"1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
S DIE=8925 D ^DIE W:'$D(XWBOS) "." S:'+$G(TIUCHNG) TIUCHNG=1
D SEND^TIUALRT(DA),SIGNIRT^TIUDIRT(+DA)
S DAORIG=DA
I +$$ISADDNDM^TIULC1(DA) S DA=+$P($G(^TIU(8925,+DA,0)),U,6)
I +$G(CSREQ)'>0 D MAIN^TIUPD(DA,"S") I 1
;If 'Credit Stop Code on Completion' is Yes
I +$P(^TIU(8925,+DA,0),U,11) D
. ;
. Q ;IHS/ITSC/LJF 05/22/2003 bypass VA PCE coding
. ;If workload does not exist, process using TIU's interview otherwise
. ;process as an edit using PCE's interview
. I '$$CHKVST^TIUPXAP2(+DA) D I 1
. . N TIUCONT,TIUPRMT
. . Q:$D(XWBOS)
. . I $P(+$P(^TIU(8925,+DA,0),U,7),".")>DT D Q
. . . W !!
. . . D QUE^TIUPXAP1
. . . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
. . W !!
. . ;Check if workload should be entered
. . I $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM) D CREDIT^TIUVSIT(DA)
. E D
. . ;Check if workload should be entered
. . I $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM) D EDTENC^TIUPXAP2(DA)
. D REMFLAG^TIUVSIT(+DA)
;If document does not have a visit and docmt is associated with
;an event type visit or call is invoked by broker, check if
;docmt can be linked to an existing visit or try and create a new
;visit. (P179)
I $D(^TIU(8925,+DA,0)),$P(^(0),U,3)'>0,($P(^(0),U,13)="E"!($$BROKER^XWBLIB)) D
. N D0,DFN,TIU,TIUVSIT
. ;Try to link docmt to an existing visit, quit if successful
. I $$LNKVST^TIUPXAP3(DA,.TIUVSIT) Q
. ;Otherwise set TIU array and DFN to use TIU API which calls PCE
. ;to resolve multiple visits or creates a new visit
. D GETTIU^TIULD(.TIU,DA)
. S DFN=$P($G(^TIU(8925,+DA,0)),U,2)
. D QUE^TIUPXAP1
; post-signature action
N TIUCONS S TIUCONS=-1
D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,DA,0)))
I TIUCONS S DA=DAORIG
S TIUSTIS=$P($G(^TIU(8925,DA,0)),U,5)
S TIUTTL=+$G(^TIU(8925,+DA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
I +$L(TIUPSIG),'+$G(CSREQ) X TIUPSIG
I TIUCONS,TIUSTIS=7,TIUSTWAS<7,$$HASKIDS^TIUSRVLI(DA) D
. N SEQUENCE,TIUKIDS,TIUINT,TIUK
. S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
. D SETKIDS^TIUSRVLI(TIUKIDS,DA,TIUINT)
. F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK D
. . I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
Q
THIRD ;
N TYPE
S TIUCSPRM=+$$CANDO^TIULP(DA,"COSIGNATURE")
S TYPE=$G(^TIU(8925,+TIUDA,0))
S TIUCSPM2=$$REQCOSIG^TIULP(+TYPE,+DA,DUZ)
Q
TIURS ; SLC/JER - Electronic signature actions ;28-Apr-2014 14:52;DU
+1 ;;1.0;TEXT INTEGRATION UTILITES;**3,4,20,67,79,98,107,58,100,109,179,1007,157,1010,227,274,1013**;Jun 20, 1997;Build 33
+2 ;Bypass PCE coding after signature
+3 ;02/25/2010 Mod returned after patches
ACCEPT(TIUSLST,TIUI) ; Accept for signing
+1 NEW TIUSGN,TIUMSG,TIUPR,TIUFLAG
+2 IF +$GET(TIUDA)
IF ($GET(TIUEVNT)]"")
Begin DoDot:1
+3 SET TIUSGN=$$CANDO^TIULP(TIUDA,TIUEVNT)
+4 IF '+TIUSGN
Begin DoDot:2
+5 DO FULL^VALM1
+6 WRITE !!,"Document has changed...",!,$PIECE(TIUSGN,U,2)
+7 WRITE !!,"Item #",TIUI,": Removed from signature list.",!
+8 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:2
End DoDot:1
IF '+$GET(TIUSGN)
QUIT
+9 SET TIUSLST(TIUI)=""
+10 ;H 2
WRITE !,"Item #",TIUI,": Added to signature list."
+11 IF +$PIECE($GET(TIUDPRM(0)),U,8)
Begin DoDot:1
+12 SET TIUMSG="Print this note"
+13 SET TIUPR=$$READ^TIUU("Y",TIUMSG,"No")
+14 IF +TIUPR
SET TIUSLST(TIUI)=1
End DoDot:1
+15 IF +$GET(TIUPR)
IF +$PIECE($GET(TIUDPRM(0)),U,9)
Begin DoDot:1
+16 SET TIUFLAG=$$FLAG^TIUPRPN3
+17 IF +TIUFLAG
SET $PIECE(TIUSLST(TIUI),U,2)=1
End DoDot:1
+18 IF +$GET(XTRASGNR)
SET $PIECE(TIUSLST(TIUI),U,3)=$GET(XTRASGNR)
+19 QUIT
EDSIG(TIUDA,TIUADD,TIUPASK) ; interactive sign
+1 NEW TIU,TIU0,TIU12,ASK,X,X1,TIUTYPE,SIGNER,COSIGNER,TIUTYPE,TIUMSG,TIUSTAT
+2 NEW TIUES,TIUACT,TIUDPRM,XTRASGNR,TIUCOM,TIU15,TIUCPFLD
+3 IF +$DATA(TIUSIGN)
IF (TIUSIGN=0)
QUIT
+4 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+5 IF '+$PIECE(TIUPRM0,U,2)
SET VALMBCK="R"
QUIT
+6 SET TIUADD=1
+7 SET TIU0=$GET(^TIU(8925,+TIUDA,0))
SET TIU12=$GET(^(12))
SET TIU15=$GET(^(15))
+8 SET SIGNER=$SELECT(+$PIECE(TIU12,U,4):$PIECE(TIU12,U,4),1:$PIECE(TIU12,U,2))
+9 SET COSIGNER=$PIECE(TIU12,U,8)
+10 IF (DUZ'=SIGNER)
IF (DUZ'=COSIGNER)
SET XTRASGNR=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
+11 IF '$GET(XTRASGNR)
SET XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
+12 SET TIUSTAT=+$PIECE(TIU0,U,5)
+13 SET TIUACT=$SELECT(TIUSTAT'>5:"SIGNATURE",+$GET(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
+14 SET ASK=$$CANDO^TIULP(TIUDA,TIUACT)
+15 SET TIUTYPE=$$PNAME^TIULC1(+TIU0)
+16 IF +ASK'>0
Begin DoDot:1
+17 SET VALMBCK="R"
+18 IF +$$ISA^USRLM(+$GET(DUZ),"MEDICAL INFORMATION SECTION")
IF (+$$ISPN^TIULX(+TIU0)'>0)
QUIT
+19 IF +$$ISA^USRLM(+$GET(DUZ),"MAS TRANSCRIPTIONIST")
QUIT
+20 IF +$$ISA^USRLM(+$GET(DUZ),"TRANSCRIPTIONIST")
QUIT
+21 WRITE !,$PIECE(ASK,U,2)
+22 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+23 IF $GET(VALMAR)'="^TMP(""TIUVIEW"",$J)"
WRITE !
+24 ;If document is a clinical procedures (CP) title, and
+25 ;(P179 for P182) this is not an additional signature,
+26 ;check if CP fields are required. If required, prompt for them
+27 ;and don't let user sign unless fields are defined. (P109)
+28 IF '$GET(XTRASGNR)
IF +$$ISA^TIULX(+TIU0,+$$CLASS^TIUCP)
IF $$REQCPF^TIULP(+$PIECE($GET(^TIU(8925,+TIUDA,14)),U,5))
Begin DoDot:1
+29 IF $GET(^TIU(8925,+TIUDA,702))
IF $PIECE(^(702),U)]""
IF $PIECE(^(702),U,2)]""
SET TIUCPFLD=1
QUIT
+30 SET TIUCPFLD=$$ASKCPF(TIUDA)
+31 IF +TIUCPFLD'>0
Begin DoDot:2
+32 WRITE !!,"The Procedure Summary Code and Date/Time Performed MUST be entered before",!,"you may sign.",!
+33 ;pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:2
End DoDot:1
IF +TIUCPFLD'>0
QUIT
+34 IF $SELECT(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,+SIGNER):1,+$PIECE(TIU15,U,6):1,1:0)
IF (+COSIGNER'>0)
Begin DoDot:1
+35 SET COSIGNER=$$ASKCSNR(TIUDA,SIGNER)
+36 IF +COSIGNER'>0
Begin DoDot:2
+37 WRITE !!,"This ",TIUTYPE," MUST have a cosigner before you may sign.",!
+38 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:2
End DoDot:1
IF +COSIGNER'>0
QUIT
+39 IF TIUSTAT=5
IF $GET(DUZ)'=SIGNER
Begin DoDot:1
+40 SET TIUMSG="Author hasn't signed, are you SURE you want to sign "_TIUTYPE
End DoDot:1
+41 WRITE !
IF $GET(TIUMSG)]""
IF $$READ^TIUU("YO",TIUMSG,"NO","^D SIG^TIUDIRH")'>0
SET VALMBCK="R"
QUIT
+42 LOCK +^TIU(8925,+TIUDA):1
+43 IF '$TEST
WRITE !?5,$CHAR(7),"Another user is editing this entry.",!
IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
SET TIUQUIT=2
QUIT
+44 ; TIU*1.0*274 DJH Do not allow notes without any text to be signed
+45 IF $$EMPTYDOC^TIULF(+TIUDA)
WRITE !?5,$CHAR(7),"This note contains no text and cannot be signed.",!
IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
QUIT
+46 SET TIUES=$$ASKSIG^TIULA1
LOCK -^TIU(8925,+TIUDA)
IF '+TIUES
QUIT
+47 IF $DATA(VALMAR)
DO FULL^VALM1
+48 IF +$GET(XTRASGNR)
DO ADDSIG^TIURS1(TIUDA,XTRASGNR)
+49 IF '+$GET(XTRASGNR)
DO ES(TIUDA,TIUES)
+50 IF $GET(TIUACT)="COSIGNATURE"
IF (+$$ISADDNDM^TIULC1(TIUDA)'>0)
Begin DoDot:1
+51 NEW TIUADDND
SET TIUCOM=0
+52 SET TIUADDND=$$READ^TIUU("YO","Do you wish to add your comments in an addendum","NO")
+53 IF +TIUADDND
DO ADD^TIUADD(TIUDA,.TIUCHNG)
SET TIUCOM=1
End DoDot:1
IF +TIUCOM
QUIT
+54 IF '+$GET(TIUPASK)
QUIT
+55 DO DOCPRM^TIULC1(+TIU0,.TIUDPRM,TIUDA)
+56 DO ^%ZTER
+57 IF +$PIECE($GET(TIUDPRM(0)),U,8)
DO PRINT^TIUEPRNT(TIUDA)
+58 QUIT
+59 ;
ASKCPF(DA) ;Ask required clinical procedure fields
+1 NEW DR,DIE,TIUY
+2 DO FULL^VALM1
AGNCP WRITE !!,$CHAR(7),"You must designate the Procedure Summary Code and Date/Time Performed...",!
+1 LOCK +^TIU(8925,+DA):1
+2 IF '$TEST
WRITE !?5,$CHAR(7),"Another user is editing this entry.",!
IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
GOTO ASKCPFQ
+3 SET DR="70201R;70202R"
+4 SET DIE="^TIU(8925,"
DO ^DIE
ASKCPFQ LOCK -^TIU(8925,+DA)
+1 IF $GET(^TIU(8925,+DA,702))
IF $PIECE(^(702),U)]""
IF $PIECE(^(702),U,2)]""
SET TIUY=1
+2 QUIT +$GET(TIUY)
+3 ;
ASKCSNR(DA,SIGNER) ; Ask cosigner
+1 NEW DR,DIE,TIUY,TIUDCSNR,TIUPREF,TIUFLD
+2 SET TIUPREF=$$PERSPRF^TIULE(SIGNER)
+3 SET TIUDCSNR=$$PERSNAME^TIULC1($PIECE(TIUPREF,U,9))
+4 IF TIUDCSNR="UNKNOWN"
SET TIUDCSNR=""
+5 SET TIUFLD=$SELECT(+$$ISDS^TIULX(+$GET(^TIU(8925,+DA,0))):"ATTENDING PHYSICIAN",1:"EXPECTED COSIGNER")
+6 DO FULL^VALM1
AGN WRITE !!,$CHAR(7),"You must designate an ",TIUFLD,"...",!
+1 LOCK +^TIU(8925,+DA):1
+2 IF '$TEST
WRITE !?5,$CHAR(7),"Another user is editing this entry.",!
IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
GOTO ASKCOUT
+3 IF $EXTRACT(TIUFLD)="A"
SET DR="1209R//^S X=TIUDCSNR;1208////^S X=$P(^TIU(8925,DA,12),U,9);1506////1"
+4 IF '$TEST
SET DR="1208R//^S X=TIUDCSNR;1506////1"
+5 SET DIE="^TIU(8925,"
DO ^DIE
ASKCOUT LOCK -^TIU(8925,+DA)
+1 SET TIUY=+$PIECE($GET(^TIU(8925,+DA,12)),U,8)
+2 QUIT TIUY
ES(DA,TIUES,TIUI) ; ^DIE call for /es/
+1 NEW SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
+2 NEW CSNEED,TIUTTL,TIUPSIG,TIUDPRM,DAO,TIUSTWAS,TIUSTIS,DAORIG,TIUCSPRM,TIUCSPM2
+3 SET TIUSTWAS=$PIECE($GET(^TIU(8925,DA,0)),U,5)
SET TIUCSPRM=1
SET TIUCSPM2=0
+4 DO DOCPRM^TIULC1(+$GET(^TIU(8925,+DA,0)),.TIUDPRM,DA)
+5 SET TIUSTAT=$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ESDT=$$NOW^TIULC
+6 SET SVCHIEF=+$$ISA^USRLM(DUZ,"CLINICAL SERVICE CHIEF")
+7 SET SIGNER=$PIECE(^TIU(8925,+DA,12),U,4)
SET COSIGNER=$PIECE(^(12),U,8)
SET CSREQ=0
+8 SET CSNEED=+$PIECE($GET(^TIU(8925,+DA,15)),U,6)
+9 ; VMP/RJT - PATCH 227 ALLOW THIRD PARTY ONE-TIME SIGNING FOR SIGNATURE AND COSIGNATURE
+10 IF +CSNEED
IF (DUZ=SIGNER)
IF '+$GET(SVCHIEF)
IF (TIUSTAT'=6)
SET CSREQ=1
+11 IF +CSNEED
IF (DUZ'=SIGNER)
IF (DUZ'=COSIGNER)
Begin DoDot:1
+12 DO THIRD
IF '+$GET(SVCHIEF)
IF (('+$GET(TIUCSPRM))!(+$GET(TIUCSPM2)))
IF (TIUSTAT'=6)
SET CSREQ=1
QUIT
End DoDot:1
+13 IF TIUSTAT=5
Begin DoDot:1
+14 SET DR=".05////"_$SELECT(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+DUZ
+15 IF '+$GET(CSREQ)
IF +CSNEED
Begin DoDot:2
+16 SET DR=DR_";1506////0;1507////"_ESDT_";1508////"_+DUZ_";1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
End DoDot:2
End DoDot:1
+17 IF TIUSTAT=6
SET DR=".05////7;1506////0;1507////"_ESDT_";1508////"_+DUZ
+18 IF '$DATA(DR)
QUIT
+19 SET DIE=8925
DO ^DIE
IF '$DATA(XWBOS)
WRITE "."
+20 IF TIUSTAT=5
SET DR="1503///^S X=$P(TIUES,U,2);1504///^S X=$P(TIUES,U,3);1505////E"
+21 IF TIUSTAT=6
Begin DoDot:1
+22 NEW TIUSBY
SET DR=""
SET TIUSBY=$PIECE($GET(^TIU(8925,+DA,15)),U,2)
+23 IF +TIUSBY>0
SET DR="1503///^S X=$$SIGNAME^TIULS("_TIUSBY_");1504///^S X=$$SIGTITL^TIULS("_TIUSBY_");"
+24 SET DR=$GET(DR)_"1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
End DoDot:1
+25 SET DIE=8925
DO ^DIE
IF '$DATA(XWBOS)
WRITE "."
IF '+$GET(TIUCHNG)
SET TIUCHNG=1
+26 DO SEND^TIUALRT(DA)
DO SIGNIRT^TIUDIRT(+DA)
+27 SET DAORIG=DA
+28 IF +$$ISADDNDM^TIULC1(DA)
SET DA=+$PIECE($GET(^TIU(8925,+DA,0)),U,6)
+29 IF +$GET(CSREQ)'>0
DO MAIN^TIUPD(DA,"S")
IF 1
+30 ;If 'Credit Stop Code on Completion' is Yes
+31 IF +$PIECE(^TIU(8925,+DA,0),U,11)
Begin DoDot:1
+32 ;
+33 ;IHS/ITSC/LJF 05/22/2003 bypass VA PCE coding
QUIT
+34 ;If workload does not exist, process using TIU's interview otherwise
+35 ;process as an edit using PCE's interview
+36 IF '$$CHKVST^TIUPXAP2(+DA)
Begin DoDot:2
+37 NEW TIUCONT,TIUPRMT
+38 IF $DATA(XWBOS)
QUIT
+39 IF $PIECE(+$PIECE(^TIU(8925,+DA,0),U,7),".")>DT
Begin DoDot:3
+40 WRITE !!
+41 DO QUE^TIUPXAP1
+42 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:3
QUIT
+43 WRITE !!
+44 ;Check if workload should be entered
+45 IF $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM)
DO CREDIT^TIUVSIT(DA)
End DoDot:2
IF 1
+46 IF '$TEST
Begin DoDot:2
+47 ;Check if workload should be entered
+48 IF $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM)
DO EDTENC^TIUPXAP2(DA)
End DoDot:2
+49 DO REMFLAG^TIUVSIT(+DA)
End DoDot:1
+50 ;If document does not have a visit and docmt is associated with
+51 ;an event type visit or call is invoked by broker, check if
+52 ;docmt can be linked to an existing visit or try and create a new
+53 ;visit. (P179)
+54 IF $DATA(^TIU(8925,+DA,0))
IF $PIECE(^(0),U,3)'>0
IF ($PIECE(^(0),U,13)="E"!($$BROKER^XWBLIB))
Begin DoDot:1
+55 NEW D0,DFN,TIU,TIUVSIT
+56 ;Try to link docmt to an existing visit, quit if successful
+57 IF $$LNKVST^TIUPXAP3(DA,.TIUVSIT)
QUIT
+58 ;Otherwise set TIU array and DFN to use TIU API which calls PCE
+59 ;to resolve multiple visits or creates a new visit
+60 DO GETTIU^TIULD(.TIU,DA)
+61 SET DFN=$PIECE($GET(^TIU(8925,+DA,0)),U,2)
+62 DO QUE^TIUPXAP1
End DoDot:1
+63 ; post-signature action
+64 NEW TIUCONS
SET TIUCONS=-1
+65 DO ISCNSLT^TIUCNSLT(.TIUCONS,+$GET(^TIU(8925,DA,0)))
+66 IF TIUCONS
SET DA=DAORIG
+67 SET TIUSTIS=$PIECE($GET(^TIU(8925,DA,0)),U,5)
+68 SET TIUTTL=+$GET(^TIU(8925,+DA,0))
SET TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
+69 IF +$LENGTH(TIUPSIG)
IF '+$GET(CSREQ)
XECUTE TIUPSIG
+70 IF TIUCONS
IF TIUSTIS=7
IF TIUSTWAS<7
IF $$HASKIDS^TIUSRVLI(DA)
Begin DoDot:1
+71 NEW SEQUENCE,TIUKIDS,TIUINT,TIUK
+72 SET SEQUENCE="D"
SET TIUKIDS="TIUKIDS"
SET TIUINT=0
SET TIUK=0
+73 DO SETKIDS^TIUSRVLI(TIUKIDS,DA,TIUINT)
+74 FOR
SET TIUK=$ORDER(TIUKIDS(TIUK))
IF 'TIUK
QUIT
Begin DoDot:2
+75 IF $PIECE(TIUKIDS(TIUK),U,7)="completed"
XECUTE TIUPSIG
End DoDot:2
End DoDot:1
+76 QUIT
THIRD ;
+1 NEW TYPE
+2 SET TIUCSPRM=+$$CANDO^TIULP(DA,"COSIGNATURE")
+3 SET TYPE=$GET(^TIU(8925,+TIUDA,0))
+4 SET TIUCSPM2=$$REQCOSIG^TIULP(+TYPE,+DA,DUZ)
+5 QUIT
