Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURS

TIURS.m

Go to the documentation of this file.
  1. TIURS ; SLC/JER - Electronic signature actions ; 25 Jun 2015 12:14 PM
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**3,4,20,67,79,98,107,58,100,109,179,157,227,274,296,333**;Jun 20, 1997;Build 5
  1. ;MILW/JMC 4/26/05-Inserted line "ES+68" execute post for text events.
  1. ACCEPT(TIUSLST,TIUI) ; Accept for signing
  1. N TIUSGN,TIUMSG,TIUPR,TIUFLAG
  1. I +$G(TIUDA),($G(TIUEVNT)]"") D Q:'+$G(TIUSGN)
  1. . S TIUSGN=$$CANDO^TIULP(TIUDA,TIUEVNT)
  1. . I '+TIUSGN D
  1. . . D FULL^VALM1
  1. . . W !!,"Document has changed...",!,$P(TIUSGN,U,2)
  1. . . W !!,"Item #",TIUI,": Removed from signature list.",!
  1. . . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
  1. S TIUSLST(TIUI)=""
  1. W !,"Item #",TIUI,": Added to signature list." ;H 2
  1. I +$P($G(TIUDPRM(0)),U,8) D
  1. . S TIUMSG="Print this note"
  1. . S TIUPR=$$READ^TIUU("Y",TIUMSG,"No")
  1. . I +TIUPR S TIUSLST(TIUI)=1
  1. I +$G(TIUPR),+$P($G(TIUDPRM(0)),U,9) D
  1. . S TIUFLAG=$$FLAG^TIUPRPN3
  1. . I +TIUFLAG S $P(TIUSLST(TIUI),U,2)=1
  1. I +$G(XTRASGNR) S $P(TIUSLST(TIUI),U,3)=$G(XTRASGNR)
  1. Q
  1. EDSIG(TIUDA,TIUADD,TIUPASK) ; interactive sign
  1. N TIU,TIU0,TIU12,ASK,X,X1,TIUTYPE,SIGNER,COSIGNER,TIUTYPE,TIUMSG,TIUSTAT
  1. N TIUES,TIUACT,TIUDPRM,XTRASGNR,TIUCOM,TIU15,TIUCPFLD
  1. I +$D(TIUSIGN),(TIUSIGN=0) Q
  1. I '$D(TIUPRM0) D SETPARM^TIULE
  1. I '+$P(TIUPRM0,U,2) S VALMBCK="R" Q
  1. S TIUADD=1
  1. S TIU0=$G(^TIU(8925,+TIUDA,0)),TIU12=$G(^(12)),TIU15=$G(^(15))
  1. S SIGNER=$S(+$P(TIU12,U,4):$P(TIU12,U,4),1:$P(TIU12,U,2))
  1. S COSIGNER=$P(TIU12,U,8)
  1. I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
  1. I '$G(XTRASGNR) S XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
  1. S TIUSTAT=+$P(TIU0,U,5)
  1. S TIUACT=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
  1. S ASK=$$CANDO^TIULP(TIUDA,TIUACT)
  1. S TIUTYPE=$$PNAME^TIULC1(+TIU0)
  1. I +ASK'>0 D Q
  1. . S VALMBCK="R"
  1. . I +$$ISA^USRLM(+$G(DUZ),"MEDICAL INFORMATION SECTION"),(+$$ISPN^TIULX(+TIU0)'>0) Q
  1. . I +$$ISA^USRLM(+$G(DUZ),"MAS TRANSCRIPTIONIST") Q
  1. . I +$$ISA^USRLM(+$G(DUZ),"TRANSCRIPTIONIST") Q
  1. . W !,$P(ASK,U,2)
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. W:$G(VALMAR)'="^TMP(""TIUVIEW"",$J)" !
  1. ;If document is a clinical procedures (CP) title, and
  1. ;(P179 for P182) this is not an additional signature,
  1. ;check if CP fields are required. If required, prompt for them
  1. ;and don't let user sign unless fields are defined. (P109)
  1. I '$G(XTRASGNR),+$$ISA^TIULX(+TIU0,+$$CLASS^TIUCP),$$REQCPF^TIULP(+$P($G(^TIU(8925,+TIUDA,14)),U,5)) D Q:+TIUCPFLD'>0
  1. . I $G(^TIU(8925,+TIUDA,702)),$P(^(702),U)]"",$P(^(702),U,2)]"" S TIUCPFLD=1 Q
  1. . S TIUCPFLD=$$ASKCPF(TIUDA)
  1. . I +TIUCPFLD'>0 D
  1. . . W !!,"The Procedure Summary Code and Date/Time Performed MUST be entered before",!,"you may sign.",!
  1. . . I $$READ^TIUU("EA","Press RETURN to continue...") ;pause
  1. I $S(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,+SIGNER):1,+$P(TIU15,U,6):1,1:0),(+COSIGNER'>0) D Q:+COSIGNER'>0
  1. . S COSIGNER=$$ASKCSNR(TIUDA,SIGNER)
  1. . I +COSIGNER'>0 D
  1. . . W !!,"This ",TIUTYPE," MUST have a cosigner before you may sign.",!
  1. . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. I TIUSTAT=5,$G(DUZ)'=SIGNER D
  1. . S TIUMSG="Author hasn't signed, are you SURE you want to sign "_TIUTYPE
  1. W ! I $G(TIUMSG)]"",$$READ^TIUU("YO",TIUMSG,"NO","^D SIG^TIUDIRH")'>0 S VALMBCK="R" Q
  1. L +^TIU(8925,+TIUDA):1
  1. E W !?5,$C(7),"Another user is editing this entry.",! W:$$READ^TIUU("EA","Press RETURN to continue...") "" S TIUQUIT=2 Q
  1. ; TIU*1.0*274 DJH Do not allow notes without any text to be signed
  1. 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
  1. S TIUES=$$ASKSIG^TIULA1 L -^TIU(8925,+TIUDA) I '+TIUES Q
  1. I $D(VALMAR) D FULL^VALM1
  1. I +$G(XTRASGNR) D ADDSIG^TIURS1(TIUDA,XTRASGNR)
  1. I '+$G(XTRASGNR) D ES(TIUDA,TIUES)
  1. I $G(TIUACT)="COSIGNATURE",(+$$ISADDNDM^TIULC1(TIUDA)'>0) D Q:+TIUCOM
  1. . N TIUADDND S TIUCOM=0
  1. . S TIUADDND=$$READ^TIUU("YO","Do you wish to add your comments in an addendum","NO")
  1. . I +TIUADDND D ADD^TIUADD(TIUDA,.TIUCHNG) S TIUCOM=1
  1. I '+$G(TIUPASK) Q
  1. D DOCPRM^TIULC1(+TIU0,.TIUDPRM,TIUDA)
  1. I +$P($G(TIUDPRM(0)),U,8) D PRINT^TIUEPRNT(TIUDA)
  1. Q
  1. ;
  1. ASKCPF(DA) ;Ask required clinical procedure fields
  1. N DR,DIE,TIUY
  1. D FULL^VALM1
  1. AGNCP W !!,$C(7),"You must designate the Procedure Summary Code and Date/Time Performed...",!
  1. L +^TIU(8925,+DA):1
  1. E W !?5,$C(7),"Another user is editing this entry.",! W:$$READ^TIUU("EA","Press RETURN to continue...") "" G ASKCPFQ
  1. S DR="70201R;70202R"
  1. S DIE="^TIU(8925," D ^DIE
  1. ASKCPFQ L -^TIU(8925,+DA)
  1. I $G(^TIU(8925,+DA,702)),$P(^(702),U)]"",$P(^(702),U,2)]"" S TIUY=1
  1. Q +$G(TIUY)
  1. ;
  1. ASKCSNR(DA,SIGNER) ; Ask cosigner
  1. N DR,DIE,TIUY,TIUDCSNR,TIUPREF,TIUFLD
  1. S TIUPREF=$$PERSPRF^TIULE(SIGNER)
  1. S TIUDCSNR=$$PERSNAME^TIULC1($P(TIUPREF,U,9))
  1. I TIUDCSNR="UNKNOWN" S TIUDCSNR=""
  1. S TIUFLD=$S(+$$ISDS^TIULX(+$G(^TIU(8925,+DA,0))):"ATTENDING PHYSICIAN",1:"EXPECTED COSIGNER")
  1. D FULL^VALM1
  1. AGN W !!,$C(7),"You must designate an ",TIUFLD,"...",!
  1. L +^TIU(8925,+DA):1
  1. E W !?5,$C(7),"Another user is editing this entry.",! W:$$READ^TIUU("EA","Press RETURN to continue...") "" G ASKCOUT
  1. I $E(TIUFLD)="A" S DR="1209R//^S X=TIUDCSNR;1208////^S X=$P(^TIU(8925,DA,12),U,9);1506////1"
  1. E S DR="1208R//^S X=TIUDCSNR;1506////1"
  1. S DIE="^TIU(8925," D ^DIE
  1. ASKCOUT L -^TIU(8925,+DA)
  1. S TIUY=+$P($G(^TIU(8925,+DA,12)),U,8)
  1. Q TIUY
  1. ;
  1. ES(DA,TIUES,TIUI) ; ^DIE call for /es/
  1. N SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
  1. N CSNEED,TIUTTL,TIUPSIG,TIUDPRM,DAO,TIUSTWAS,TIUSTIS,DAORIG,TIUCSPRM,TIUCSPM2
  1. S TIUSTWAS=$P($G(^TIU(8925,DA,0)),U,5),TIUCSPRM=1,TIUCSPM2=0
  1. D DOCPRM^TIULC1(+$G(^TIU(8925,+DA,0)),.TIUDPRM,DA)
  1. S TIUSTAT=$P($G(^TIU(8925,+DA,0)),U,5),ESDT=$$NOW^TIULC
  1. S SVCHIEF=+$$ISA^USRLM(DUZ,"CLINICAL SERVICE CHIEF")
  1. S SIGNER=$P(^TIU(8925,+DA,12),U,4),COSIGNER=$P(^(12),U,8),CSREQ=0
  1. S CSNEED=+$P($G(^TIU(8925,+DA,15)),U,6)
  1. ; VMP/RJT - PATCH 227 ALLOW THIRD PARTY ONE-TIME SIGNING FOR SIGNATURE AND COSIGNATURE
  1. I +CSNEED,(DUZ=SIGNER),'+$G(SVCHIEF),(TIUSTAT'=6) S CSREQ=1
  1. I +CSNEED,(DUZ'=SIGNER),(DUZ'=COSIGNER) D
  1. . D THIRD I '+$G(SVCHIEF),(('+$G(TIUCSPRM))!(+$G(TIUCSPM2))),(TIUSTAT'=6) S CSREQ=1 Q
  1. I TIUSTAT=5 D
  1. . S DR=".05////"_$S(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+DUZ
  1. . I '+$G(CSREQ),+CSNEED D
  1. . . 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"
  1. I TIUSTAT=6 S DR=".05////7;1506////0;1507////"_ESDT_";1508////"_+DUZ
  1. Q:'$D(DR)
  1. S DIE=8925 D ^DIE W:'$D(XWBOS) "."
  1. I TIUSTAT=5 S DR="1503///^S X=$P(TIUES,U,2);1504///^S X=$P(TIUES,U,3);1505////E"
  1. I TIUSTAT=6 D
  1. . N TIUSBY S DR="",TIUSBY=$P($G(^TIU(8925,+DA,15)),U,2)
  1. . I +TIUSBY>0 S DR="1503///^S X=$$SIGNAME^TIULS("_TIUSBY_");1504///^S X=$$SIGTITL^TIULS("_TIUSBY_");"
  1. . S DR=$G(DR)_"1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
  1. S DIE=8925 D ^DIE W:'$D(XWBOS) "." S:'+$G(TIUCHNG) TIUCHNG=1
  1. D SEND^TIUALRT(DA),SIGNIRT^TIUDIRT(+DA)
  1. S DAORIG=DA
  1. I +$$ISADDNDM^TIULC1(DA) S DA=+$P($G(^TIU(8925,+DA,0)),U,6)
  1. I +$G(CSREQ)'>0 D MAIN^TIUPD(DA,"S") I 1
  1. ;If 'Credit Stop Code on Completion' is Yes
  1. I +$P(^TIU(8925,+DA,0),U,11) D
  1. . ;If workload does not exist, process using TIU's interview otherwise
  1. . ;process as an edit using PCE's interview
  1. . I '$$CHKVST^TIUPXAP2(+DA) D I 1
  1. . . N TIUCONT,TIUPRMT
  1. . . Q:$D(XWBOS)
  1. . . I $P(+$P(^TIU(8925,+DA,0),U,7),".")>DT D Q
  1. . . . W !!
  1. . . . D QUE^TIUPXAP1
  1. . . . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
  1. . . W !!
  1. . . ;Check if workload should be entered
  1. . . I $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM) D CREDIT^TIUVSIT(DA)
  1. . E D
  1. . . ;Check if workload should be entered
  1. . . I $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM) D EDTENC^TIUPXAP2(DA)
  1. . D REMFLAG^TIUVSIT(+DA)
  1. ;If document does not have a visit and docmt is associated with
  1. ;an event type visit or call is invoked by broker, check if
  1. ;docmt can be linked to an existing visit or try and create a new
  1. ;visit. (P179)
  1. I $D(^TIU(8925,+DA,0)),$P(^(0),U,3)'>0,($P(^(0),U,13)="E"!($$BROKER^XWBLIB)) D
  1. . N D0,DFN,TIU,TIUVSIT
  1. . ;Try to link docmt to an existing visit, quit if successful
  1. . I $$LNKVST^TIUPXAP3(DA,.TIUVSIT) Q
  1. . ;Otherwise set TIU array and DFN to use TIU API which calls PCE
  1. . ;to resolve multiple visits or creates a new visit
  1. . D GETTIU^TIULD(.TIU,DA)
  1. . S DFN=$P($G(^TIU(8925,+DA,0)),U,2)
  1. . D QUE^TIUPXAP1
  1. ; post-signature action
  1. S TIUTTL=+$G(^TIU(8925,+DA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
  1. ; determine if the note/note parent is a consult
  1. N TIUCONS S TIUCONS=-1
  1. D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,DA,0)))
  1. ; when: DA is a consult (this could be either when resulting or addending a consult)
  1. I TIUCONS D
  1. . ; when: DAORIG is addendum (meaning DA refers to parent) and parent DA is not complete ;MKN TIU*1*333
  1. . ; then: do not execute post action ;MKN TIU*1*333
  1. . I +$$ISADDNDM^TIULC1(DAORIG)&($P(^TIU(8925,+DA,0),U,5)'=7) S CSREQ=1 ;MKN TIU*1*333
  1. . I DA=DAORIG D ;MKN TIU*1*333 when I am signing the consult result check if I need to evaluate post signature for children
  1. .. ; when: parent status is completed (and wasn't in the past) note: this is when resulting a consult
  1. .. ; then: execute post-action for all children documents that are complete
  1. .. S TIUSTIS=$P($G(^TIU(8925,DA,0)),U,5)
  1. .. I TIUSTIS=7,TIUSTWAS<7,$$HASKIDS^TIUSRVLI(DA) D
  1. ... N SEQUENCE,TIUKIDS,TIUINT,TIUK
  1. ... S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
  1. ... D SETKIDS^TIUSRVLI(TIUKIDS,DA,TIUINT)
  1. ... F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
  1. . ; when: signing an addendum as long as parent doesn't need co-signature execute consult post action
  1. . ; when: signing a consult result as long as doesn't need co-signature execute consult post action
  1. ; elseif: for all other document classes behave as normal
  1. I +$L(TIUPSIG),'+$G(CSREQ) X TIUPSIG
  1. Q
  1. THIRD ;
  1. N TYPE
  1. S TIUCSPRM=+$$CANDO^TIULP(DA,"COSIGNATURE")
  1. S TYPE=$G(^TIU(8925,+TIUDA,0))
  1. S TIUCSPM2=$$REQCOSIG^TIULP(+TYPE,+DA,DUZ)
  1. Q