BTIURS ; IHS/ITSC/LJF - Electronic signature actions ;
;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
; Copy of TIURS so calls from IHS reports to sign documents work
; -- removed VA code to update list
;
ELSIG ; Sign rec
N ASK,TIUEVNT,TIULST,TIUSLST,TIURJCT,TIUDA,TIUDATA,TIUES,TIUI,X,X1,Y
I '$D(TIUPRM0) D SETPARM^TIULE
I $P(TIUPRM0,U,2)'>0 W !,"Electronic signature not yet enabled." H 3 G ELSIGX
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S (ASK,TIUI)=0 I $D(VALMY)>9 D CLEAR^VALM1
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D
. N TIU0,TIU12,TIUSTAT,TIUEVNT,TIUTYPE,TIUPOP,TIU15 S TIUPOP=0
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=$P(TIUDATA,U,2)
. S TIU0=$G(^TIU(8925,+TIUDA,0)),TIU12=$G(^(12)),TIU15=$G(^(15))
. S TIUSTAT=+$P(TIU0,U,5)
. S TIUTYPE=$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
. S TIUEVNT=$S(+TIUSTAT'>5:"SIGNATURE",1:"COSIGNATURE")
. D RESTORE^TIULM(TIUI)
. S ASK=$$CANDO^TIULP(TIUDA,TIUEVNT)
. I +ASK'>0,$P(ASK,U,2)]"" D
. . D FULL^VALM1
. . W !!,"Item #",TIUI,": ",$P(ASK,U,2),! K VALMY(TIUI)
. . W !,"Removed from signature list.",!
. . I $$READ^TIUU("FOA","Press RETURN to continue...")
. E D
. . I $S(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,DUZ):1,+$P(TIU15,U,6):1,1:0),(+$P(TIU12,U,8)'>0) D Q:+TIUPOP
. . . N COSIGNER
. . . W !!,"Item #",TIUI,": ",TIUTYPE," for "
. . . W $$PTNAME^TIULC1($P(TIU0,U,2))," will need cosignature..."
. . . S COSIGNER=$$ASKCSNR(TIUDA,DUZ)
. . . I +COSIGNER'>0 D
. . . . S TIUPOP=1
. . . . W !!,"Item #",TIUI,": MUST have a cosigner, before you may sign."
. . . . W !!,"Removed from signature list.",!
. . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
. . N TIU,TIUY
. . D EN^VALM("TIU SIGN/COSIGN")
I $D(TIUSLST)'>9 D G ELSIGX
. S VALMSG="** Signature List Empty...Nothing signed. **"
. D FIXLST^TIULM
I $D(TIUSLST)>9 D
. S TIUES=$$ASKSIG^TIULA1
. I '+TIUES S VALMSG="** Nothing Signed. **" D FIXLST^TIULM Q
. D FULL^VALM1
. S TIUI=0 F S TIUI=$O(TIUSLST(TIUI)) Q:+TIUI'>0 D
. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)),TIUDA=$P(TIUDATA,U,2)
. . S TIULST=$G(TIULST)_$S($G(TIULST)]"":", ",1:"")_TIUI
. . D ES(TIUDA,TIUES,TIUI)
. . ;I '$D(^TMP("TIUR",$J,"CTXT")) D UPDATE^TIURL(TIUDATA) ;original VA
. . ;I $D(^TMP("TIUR",$J,"CTXT")) D RBLD^TIUROR ;original VA
. . D RESET^BTIURPT ;use IHS reset code
I $G(TIULST)']"" S VALMSG="** Nothing Signed. **" D FIXLST^TIULM
E S VALMSG="** Item"_$S($L(TIULST,",")>1:"s ",$L(TIULST,"-")>1:"s ",1:" ")_TIULST_" Signed. **"
ELSIGX K VALMY S VALMBCK="R"
Q
SIGLIST(VALMY,TIUI,TIUTYPE) ; Handles processing of signature list
N TIUMSG
S TIUMSG="Is this "_TIUTYPE_" ready for signature"
W ! S TIUY=$$READ^TIUU("YO",TIUMSG,"NO","^D SIG^TIUDIRH")
I TIUY'>0 D
. K VALMY(TIUI)
. S TIURJCT=$G(TIURJCT)_$S($G(TIURJCT)]"":",",1:"")_TIUI
. W !!,"Removed from signature list." H 2
Q
ACCEPT(TIUSLST,TIUI) ; Adds item(s) to signature list
N TIUSGN
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
Q
EDSIG(TIUDA,TIUADD,TIUPASK) ; Call from Edit action to sign rec
N TIU,TIU0,TIU12,ASK,X,X1,TIUTYPE,SIGNER,COSIGNER,TIUTYPE,TIUMSG,TIUSTAT
N TIUES,TIUACT,TIUDPRM,XTRASGNR,TIUCOM,TIU15
I +$D(TIUSIGN),(TIUSIGN=0) Q
I '$D(TIUPRM0) D SETPARM^TIULE
; If Electronic Signature is not yet enabled, then quit
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))
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)" !
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
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
; --- If required, prompt for print
I '+$G(TIUPASK) Q
D DOCPRM^TIULC1(+TIU0,.TIUDPRM,TIUDA)
I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(TIUDA)
Q
ASKCSNR(DA,SIGNER) ; Ask for cosigner, require a response
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)
;I 'TIUY G AGN
Q TIUY
ES(DA,TIUES,TIUI) ; Setup ^DIE call for elec sig
N SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
N CSNEED,TIUTTL,TIUPSIG
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)
I +CSNEED,(DUZ'=COSIGNER),'+$G(SVCHIEF) S CSREQ=1
I TIUSTAT=5 D
. S DR=".05////"_$S(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+DUZ
. I '+$G(CSREQ),+CSNEED,$S(DUZ=COSIGNER:1,+$G(SVCHIEF):1,1:0) 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)
I +$$ISADDNDM^TIULC1(DA) S DA=+$P(^(0),U,6)
I +$G(CSREQ)'>0 D MAIN^TIUPD(DA,"S") I 1
I +$P(^TIU(8925,+DA,0),U,11) D CREDIT^TIUVSIT(DA)
; If the document has a post-signature action, execute it
S TIUTTL=+$G(^TIU(8925,+DA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
I +$L(TIUPSIG),'+$G(CSREQ) X TIUPSIG
Q
BTIURS ; IHS/ITSC/LJF - Electronic signature actions ;
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
+2 ; Copy of TIURS so calls from IHS reports to sign documents work
+3 ; -- removed VA code to update list
+4 ;
ELSIG ; Sign rec
+1 NEW ASK,TIUEVNT,TIULST,TIUSLST,TIURJCT,TIUDA,TIUDATA,TIUES,TIUI,X,X1,Y
+2 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+3 IF $PIECE(TIUPRM0,U,2)'>0
WRITE !,"Electronic signature not yet enabled."
HANG 3
GOTO ELSIGX
+4 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+5 SET (ASK,TIUI)=0
IF $DATA(VALMY)>9
DO CLEAR^VALM1
+6 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+7 NEW TIU0,TIU12,TIUSTAT,TIUEVNT,TIUTYPE,TIUPOP,TIU15
SET TIUPOP=0
+8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+9 SET TIUDA=$PIECE(TIUDATA,U,2)
+10 SET TIU0=$GET(^TIU(8925,+TIUDA,0))
SET TIU12=$GET(^(12))
SET TIU15=$GET(^(15))
+11 SET TIUSTAT=+$PIECE(TIU0,U,5)
+12 SET TIUTYPE=$$PNAME^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+13 SET TIUEVNT=$SELECT(+TIUSTAT'>5:"SIGNATURE",1:"COSIGNATURE")
+14 DO RESTORE^TIULM(TIUI)
+15 SET ASK=$$CANDO^TIULP(TIUDA,TIUEVNT)
+16 IF +ASK'>0
IF $PIECE(ASK,U,2)]""
Begin DoDot:2
+17 DO FULL^VALM1
+18 WRITE !!,"Item #",TIUI,": ",$PIECE(ASK,U,2),!
KILL VALMY(TIUI)
+19 WRITE !,"Removed from signature list.",!
+20 IF $$READ^TIUU("FOA","Press RETURN to continue...")
End DoDot:2
+21 IF '$TEST
Begin DoDot:2
+22 IF $SELECT(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,DUZ):1,+$PIECE(TIU15,U,6):1,1:0)
IF (+$PIECE(TIU12,U,8)'>0)
Begin DoDot:3
+23 NEW COSIGNER
+24 WRITE !!,"Item #",TIUI,": ",TIUTYPE," for "
+25 WRITE $$PTNAME^TIULC1($PIECE(TIU0,U,2))," will need cosignature..."
+26 SET COSIGNER=$$ASKCSNR(TIUDA,DUZ)
+27 IF +COSIGNER'>0
Begin DoDot:4
+28 SET TIUPOP=1
+29 WRITE !!,"Item #",TIUI,": MUST have a cosigner, before you may sign."
+30 WRITE !!,"Removed from signature list.",!
+31 IF $$READ^TIUU("FOA","Press RETURN to continue...")
End DoDot:4
End DoDot:3
IF +TIUPOP
QUIT
+32 NEW TIU,TIUY
+33 DO EN^VALM("TIU SIGN/COSIGN")
End DoDot:2
End DoDot:1
+34 IF $DATA(TIUSLST)'>9
Begin DoDot:1
+35 SET VALMSG="** Signature List Empty...Nothing signed. **"
+36 DO FIXLST^TIULM
End DoDot:1
GOTO ELSIGX
+37 IF $DATA(TIUSLST)>9
Begin DoDot:1
+38 SET TIUES=$$ASKSIG^TIULA1
+39 IF '+TIUES
SET VALMSG="** Nothing Signed. **"
DO FIXLST^TIULM
QUIT
+40 DO FULL^VALM1
+41 SET TIUI=0
FOR
SET TIUI=$ORDER(TIUSLST(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:2
+42 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
SET TIUDA=$PIECE(TIUDATA,U,2)
+43 SET TIULST=$GET(TIULST)_$SELECT($GET(TIULST)]"":", ",1:"")_TIUI
+44 DO ES(TIUDA,TIUES,TIUI)
+45 ;I '$D(^TMP("TIUR",$J,"CTXT")) D UPDATE^TIURL(TIUDATA) ;original VA
+46 ;I $D(^TMP("TIUR",$J,"CTXT")) D RBLD^TIUROR ;original VA
+47 ;use IHS reset code
DO RESET^BTIURPT
End DoDot:2
End DoDot:1
+48 IF $GET(TIULST)']""
SET VALMSG="** Nothing Signed. **"
DO FIXLST^TIULM
+49 IF '$TEST
SET VALMSG="** Item"_$SELECT($LENGTH(TIULST,",")>1:"s ",$LENGTH(TIULST,"-")>1:"s ",1:" ")_TIULST_" Signed. **"
ELSIGX KILL VALMY
SET VALMBCK="R"
+1 QUIT
SIGLIST(VALMY,TIUI,TIUTYPE) ; Handles processing of signature list
+1 NEW TIUMSG
+2 SET TIUMSG="Is this "_TIUTYPE_" ready for signature"
+3 WRITE !
SET TIUY=$$READ^TIUU("YO",TIUMSG,"NO","^D SIG^TIUDIRH")
+4 IF TIUY'>0
Begin DoDot:1
+5 KILL VALMY(TIUI)
+6 SET TIURJCT=$GET(TIURJCT)_$SELECT($GET(TIURJCT)]"":",",1:"")_TIUI
+7 WRITE !!,"Removed from signature list."
HANG 2
End DoDot:1
+8 QUIT
ACCEPT(TIUSLST,TIUI) ; Adds item(s) to signature list
+1 NEW TIUSGN
+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 WRITE !,"Item #",TIUI,": Added to signature list."
HANG 2
+11 QUIT
EDSIG(TIUDA,TIUADD,TIUPASK) ; Call from Edit action to sign rec
+1 NEW TIU,TIU0,TIU12,ASK,X,X1,TIUTYPE,SIGNER,COSIGNER,TIUTYPE,TIUMSG,TIUSTAT
+2 NEW TIUES,TIUACT,TIUDPRM,XTRASGNR,TIUCOM,TIU15
+3 IF +$DATA(TIUSIGN)
IF (TIUSIGN=0)
QUIT
+4 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+5 ; If Electronic Signature is not yet enabled, then quit
+6 IF '+$PIECE(TIUPRM0,U,2)
SET VALMBCK="R"
QUIT
+7 SET TIUADD=1
+8 SET TIU0=$GET(^TIU(8925,+TIUDA,0))
SET TIU12=$GET(^(12))
SET TIU15=$GET(^(15))
+9 SET SIGNER=$SELECT(+$PIECE(TIU12,U,4):$PIECE(TIU12,U,4),1:$PIECE(TIU12,U,2))
+10 SET COSIGNER=$PIECE(TIU12,U,8)
+11 IF (DUZ'=SIGNER)
IF (DUZ'=COSIGNER)
SET XTRASGNR=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
+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 $SELECT(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,+SIGNER):1,+$PIECE(TIU15,U,6):1,1:0)
IF (+COSIGNER'>0)
Begin DoDot:1
+25 SET COSIGNER=$$ASKCSNR(TIUDA,SIGNER)
+26 IF +COSIGNER'>0
Begin DoDot:2
+27 WRITE !!,"This ",TIUTYPE," MUST have a cosigner before you may sign.",!
+28 ; pause
IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:2
End DoDot:1
IF +COSIGNER'>0
QUIT
+29 IF TIUSTAT=5
IF $GET(DUZ)'=SIGNER
Begin DoDot:1
+30 SET TIUMSG="Author hasn't signed, are you SURE you want to sign "_TIUTYPE
End DoDot:1
+31 WRITE !
IF $GET(TIUMSG)]""
IF $$READ^TIUU("YO",TIUMSG,"NO","^D SIG^TIUDIRH")'>0
SET VALMBCK="R"
QUIT
+32 LOCK +^TIU(8925,+TIUDA):1
+33 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
+34 SET TIUES=$$ASKSIG^TIULA1
LOCK -^TIU(8925,+TIUDA)
IF '+TIUES
QUIT
+35 IF $DATA(VALMAR)
DO FULL^VALM1
+36 IF +$GET(XTRASGNR)
DO ADDSIG^TIURS1(TIUDA,XTRASGNR)
+37 IF '+$GET(XTRASGNR)
DO ES(TIUDA,TIUES)
+38 IF $GET(TIUACT)="COSIGNATURE"
IF (+$$ISADDNDM^TIULC1(TIUDA)'>0)
Begin DoDot:1
+39 NEW TIUADDND
SET TIUCOM=0
+40 SET TIUADDND=$$READ^TIUU("YO","Do you wish to add your comments in an addendum","NO")
+41 IF +TIUADDND
DO ADD^TIUADD(TIUDA,.TIUCHNG)
SET TIUCOM=1
End DoDot:1
IF +TIUCOM
QUIT
+42 ; --- If required, prompt for print
+43 IF '+$GET(TIUPASK)
QUIT
+44 DO DOCPRM^TIULC1(+TIU0,.TIUDPRM,TIUDA)
+45 IF +$PIECE($GET(TIUDPRM(0)),U,8)
DO PRINT^TIUEPRNT(TIUDA)
+46 QUIT
ASKCSNR(DA,SIGNER) ; Ask for cosigner, require a response
+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 ;I 'TIUY G AGN
+3 QUIT TIUY
ES(DA,TIUES,TIUI) ; Setup ^DIE call for elec sig
+1 NEW SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
+2 NEW CSNEED,TIUTTL,TIUPSIG
+3 SET TIUSTAT=$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ESDT=$$NOW^TIULC
+4 SET SVCHIEF=+$$ISA^USRLM(DUZ,"CLINICAL SERVICE CHIEF")
+5 SET SIGNER=$PIECE(^TIU(8925,+DA,12),U,4)
SET COSIGNER=$PIECE(^(12),U,8)
SET CSREQ=0
+6 SET CSNEED=+$PIECE($GET(^TIU(8925,+DA,15)),U,6)
+7 IF +CSNEED
IF (DUZ'=COSIGNER)
IF '+$GET(SVCHIEF)
SET CSREQ=1
+8 IF TIUSTAT=5
Begin DoDot:1
+9 SET DR=".05////"_$SELECT(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+DUZ
+10 IF '+$GET(CSREQ)
IF +CSNEED
IF $SELECT(DUZ=COSIGNER:1,+$GET(SVCHIEF):1,1:0)
Begin DoDot:2
+11 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
+12 IF TIUSTAT=6
SET DR=".05////7;1506////0;1507////"_ESDT_";1508////"_+DUZ
+13 IF '$DATA(DR)
QUIT
+14 SET DIE=8925
DO ^DIE
IF '$DATA(XWBOS)
WRITE "."
+15 IF TIUSTAT=5
SET DR="1503///^S X=$P(TIUES,U,2);1504///^S X=$P(TIUES,U,3);1505////E"
+16 IF TIUSTAT=6
Begin DoDot:1
+17 NEW TIUSBY
SET DR=""
SET TIUSBY=$PIECE($GET(^TIU(8925,+DA,15)),U,2)
+18 IF +TIUSBY>0
SET DR="1503///^S X=$$SIGNAME^TIULS("_TIUSBY_");1504///^S X=$$SIGTITL^TIULS("_TIUSBY_");"
+19 SET DR=$GET(DR)_"1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
End DoDot:1
+20 SET DIE=8925
DO ^DIE
IF '$DATA(XWBOS)
WRITE "."
IF '+$GET(TIUCHNG)
SET TIUCHNG=1
+21 DO SEND^TIUALRT(DA)
DO SIGNIRT^TIUDIRT(+DA)
+22 IF +$$ISADDNDM^TIULC1(DA)
SET DA=+$PIECE(^(0),U,6)
+23 IF +$GET(CSREQ)'>0
DO MAIN^TIUPD(DA,"S")
IF 1
+24 IF +$PIECE(^TIU(8925,+DA,0),U,11)
DO CREDIT^TIUVSIT(DA)
+25 ; If the document has a post-signature action, execute it
+26 SET TIUTTL=+$GET(^TIU(8925,+DA,0))
SET TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
+27 IF +$LENGTH(TIUPSIG)
IF '+$GET(CSREQ)
XECUTE TIUPSIG
+28 QUIT
