- TIURS ; SLC/JER - Electronic signature actions ; 25 Jun 2015 12:14 PM
- ;;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
- ;MILW/JMC 4/26/05-Inserted line "ES+68" execute post for text events.
- 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)
- 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
- . ;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
- S TIUTTL=+$G(^TIU(8925,+DA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
- ; determine if the note/note parent is a consult
- N TIUCONS S TIUCONS=-1
- D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,DA,0)))
- ; when: DA is a consult (this could be either when resulting or addending a consult)
- I TIUCONS D
- . ; when: DAORIG is addendum (meaning DA refers to parent) and parent DA is not complete ;MKN TIU*1*333
- . ; then: do not execute post action ;MKN TIU*1*333
- . I +$$ISADDNDM^TIULC1(DAORIG)&($P(^TIU(8925,+DA,0),U,5)'=7) S CSREQ=1 ;MKN TIU*1*333
- . 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
- .. ; when: parent status is completed (and wasn't in the past) note: this is when resulting a consult
- .. ; then: execute post-action for all children documents that are complete
- .. S TIUSTIS=$P($G(^TIU(8925,DA,0)),U,5)
- .. I 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 I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
- . ; when: signing an addendum as long as parent doesn't need co-signature execute consult post action
- . ; when: signing a consult result as long as doesn't need co-signature execute consult post action
- ; elseif: for all other document classes behave as normal
- I +$L(TIUPSIG),'+$G(CSREQ) 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURS 10124 printed Feb 19, 2025@00:12:01 Page 2
- 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
- +2 ;MILW/JMC 4/26/05-Inserted line "ES+68" execute post for text events.
- 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 IF +$PIECE($GET(TIUDPRM(0)),U,8)
- DO PRINT^TIUEPRNT(TIUDA)
- +57 QUIT
- +58 ;
- 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
- +3 ;
- 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 ;If workload does not exist, process using TIU's interview otherwise
- +33 ;process as an edit using PCE's interview
- +34 IF '$$CHKVST^TIUPXAP2(+DA)
- Begin DoDot:2
- +35 NEW TIUCONT,TIUPRMT
- +36 if $DATA(XWBOS)
- QUIT
- +37 IF $PIECE(+$PIECE(^TIU(8925,+DA,0),U,7),".")>DT
- Begin DoDot:3
- +38 WRITE !!
- +39 DO QUE^TIUPXAP1
- +40 if $$READ^TIUU("EA","Press RETURN to continue...")
- WRITE ""
- End DoDot:3
- QUIT
- +41 WRITE !!
- +42 ;Check if workload should be entered
- +43 IF $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM)
- DO CREDIT^TIUVSIT(DA)
- End DoDot:2
- IF 1
- +44 IF '$TEST
- Begin DoDot:2
- +45 ;Check if workload should be entered
- +46 IF $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM)
- DO EDTENC^TIUPXAP2(DA)
- End DoDot:2
- +47 DO REMFLAG^TIUVSIT(+DA)
- End DoDot:1
- +48 ;If document does not have a visit and docmt is associated with
- +49 ;an event type visit or call is invoked by broker, check if
- +50 ;docmt can be linked to an existing visit or try and create a new
- +51 ;visit. (P179)
- +52 IF $DATA(^TIU(8925,+DA,0))
- IF $PIECE(^(0),U,3)'>0
- IF ($PIECE(^(0),U,13)="E"!($$BROKER^XWBLIB))
- Begin DoDot:1
- +53 NEW D0,DFN,TIU,TIUVSIT
- +54 ;Try to link docmt to an existing visit, quit if successful
- +55 IF $$LNKVST^TIUPXAP3(DA,.TIUVSIT)
- QUIT
- +56 ;Otherwise set TIU array and DFN to use TIU API which calls PCE
- +57 ;to resolve multiple visits or creates a new visit
- +58 DO GETTIU^TIULD(.TIU,DA)
- +59 SET DFN=$PIECE($GET(^TIU(8925,+DA,0)),U,2)
- +60 DO QUE^TIUPXAP1
- End DoDot:1
- +61 ; post-signature action
- +62 SET TIUTTL=+$GET(^TIU(8925,+DA,0))
- SET TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
- +63 ; determine if the note/note parent is a consult
- +64 NEW TIUCONS
- SET TIUCONS=-1
- +65 DO ISCNSLT^TIUCNSLT(.TIUCONS,+$GET(^TIU(8925,DA,0)))
- +66 ; when: DA is a consult (this could be either when resulting or addending a consult)
- +67 IF TIUCONS
- Begin DoDot:1
- +68 ; when: DAORIG is addendum (meaning DA refers to parent) and parent DA is not complete ;MKN TIU*1*333
- +69 ; then: do not execute post action ;MKN TIU*1*333
- +70 ;MKN TIU*1*333
- IF +$$ISADDNDM^TIULC1(DAORIG)&($PIECE(^TIU(8925,+DA,0),U,5)'=7)
- SET CSREQ=1
- +71 ;MKN TIU*1*333 when I am signing the consult result check if I need to evaluate post signature for children
- IF DA=DAORIG
- Begin DoDot:2
- +72 ; when: parent status is completed (and wasn't in the past) note: this is when resulting a consult
- +73 ; then: execute post-action for all children documents that are complete
- +74 SET TIUSTIS=$PIECE($GET(^TIU(8925,DA,0)),U,5)
- +75 IF TIUSTIS=7
- IF TIUSTWAS<7
- IF $$HASKIDS^TIUSRVLI(DA)
- Begin DoDot:3
- +76 NEW SEQUENCE,TIUKIDS,TIUINT,TIUK
- +77 SET SEQUENCE="D"
- SET TIUKIDS="TIUKIDS"
- SET TIUINT=0
- SET TIUK=0
- +78 DO SETKIDS^TIUSRVLI(TIUKIDS,DA,TIUINT)
- +79 FOR
- SET TIUK=$ORDER(TIUKIDS(TIUK))
- if 'TIUK
- QUIT
- IF $PIECE(TIUKIDS(TIUK),U,7)="completed"
- XECUTE TIUPSIG
- End DoDot:3
- End DoDot:2
- +80 ; when: signing an addendum as long as parent doesn't need co-signature execute consult post action
- +81 ; when: signing a consult result as long as doesn't need co-signature execute consult post action
- End DoDot:1
- +82 ; elseif: for all other document classes behave as normal
- +83 IF +$LENGTH(TIUPSIG)
- IF '+$GET(CSREQ)
- XECUTE TIUPSIG
- +84 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